TiNames.hs

Since the type of identifiers is not hardwired in the type checker, this module defines some type classes that capture what the type checker needs to do with identifiers.

module TiNames where
import Char(isAlphaNum)
import HsIdent
import HsName(ModuleName)
import HsConstants(mod_Prelude)
import SrcLoc(SrcLoc,srcFile,srcLoc)
import SrcLocPretty(shLineCol)
import PrettyPrint(Printable,pp)
import SpecialNames
import TypedIds(IdTy(..),HasIdTy(..))
import UniqueNames(PN)

type SrcName = String

class ValueId i where
  topName   :: Maybe SrcLoc -> ModuleName -> SrcName -> IdTy (PN String) -> i
  localVal' :: SrcName -> Maybe SrcLoc -> i
--instName  :: ModuleName -> SrcLoc -> i
  dictName' :: Int -> Maybe SrcLoc -> i
  superName :: i -> Int -> i
  defaultName :: i -> i

class HasIdTy n i => TypedId n i | i->n where
  idName :: i -> n

isCon i = 
  case idTy i of
    ConstrOf {} -> True
    _ -> False

dictName i = dictName' i Nothing
conName' s m n t ty = topName s m n (ConstrOf t ty)
conName m = conName' Nothing m
prelCon c = conName mod_Prelude c
localVal n = localVal' n Nothing
topVal' m n s = topName s m n Value
topVal m n = topVal' m n Nothing
prelVal' n = topVal' mod_Prelude n
prelVal n = prelVal' n Nothing

instName generates context-independent, unique names for instance declarations. The module name is included so that the instance names remain unique when mutually recursive groups of modules are combined into one module.

instName m s inst =
    --topName (Just s) m ("inst__"++pp m++"_"++shLineCol s) Value
    topName (Just s) m ("inst__"++dots2uscore (pp m)++"_"++mangle (pp inst)) Value
  where
    -- A quick hack: !!!
    mangle = concatMap mangle1
    mangle1 c =
      case c of
        ' ' -> "_"
	'(' -> "_l_"
	')' -> "_r_"
	_ -> if isAlphaNum c then [c] else "_"++show (fromEnum c)

instName' modmap s = instName (modmap (srcFile s)) s

derivedInstName' modmap cl = derivedInstName m cl
  where
    s = srcLoc cl
    m = modmap (srcFile s)

derivedInstName m cl tn =
    topName (Just s) m ("derived__"++dots2uscore (pp m)++"_"++pp cl++"_"++n) Value
  where
    s = srcLoc cl
    ts = pp tn
    n = if all isAlphaNum' ts
	then ts
	else shLineCol s
    isAlphaNum' c = c `elem` "_'" || isAlphaNum c

-- For the annoying 'hierarchical' module name extension:
dots2uscore = map dot2uscore
dot2uscore '.' = '_'
dot2uscore c = c

class (HasSpecialNames i,IsSpecialName i) => TypeCon i where
  topType :: ModuleName -> SrcName -> i

prelType n = topType mod_Prelude n

class (Ord i,Printable i) => TypeVar i where
  tvar :: Int -> i
  ltvar :: SrcName -> i

class (TypeCon i,TypeVar i) => TypeId i

-- Prelude values and constructors
pv n = HsVar (prelVal n)
pc n = HsCon (prelVal n)