{-+ 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)