X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FbasicTypes%2FOccName.lhs;h=b6181fb87da26e3398359987bef54fa6a5c6a808;hb=08652e67c4d5d9a40687f93c286021a867c1bca0;hp=8298f5965d69dcd6df7821df7115a1a54b1d7ff2;hpb=206b4dec78250efef3cd927d64dc6cbc54a16c3d;p=ghc-hetmet.git diff --git a/compiler/basicTypes/OccName.lhs b/compiler/basicTypes/OccName.lhs index 8298f59..b6181fb 100644 --- a/compiler/basicTypes/OccName.lhs +++ b/compiler/basicTypes/OccName.lhs @@ -4,13 +4,6 @@ % \begin{code} -{-# OPTIONS -w #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and fix --- any warnings in the module. See --- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings --- for details - module OccName ( -- * The NameSpace type; abstact NameSpace, tcName, clsName, tcClsName, dataName, varName, @@ -32,8 +25,10 @@ module OccName ( setOccNameSpace, -- ** Derived OccNames + isDerivedOccName, mkDataConWrapperOcc, mkWorkerOcc, mkDefaultMethodOcc, - mkDerivedTyConOcc, mkNewTyCoOcc, + mkDerivedTyConOcc, mkNewTyCoOcc, + mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc, mkClassTyConOcc, mkClassDataConOcc, mkDictOcc, mkIPOcc, mkSpecOcc, mkForeignExportOcc, mkGenOcc1, mkGenOcc2, mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc, @@ -73,8 +68,6 @@ module OccName ( startsVarSym, startsVarId, startsConSym, startsConId ) where -#include "HsVersions.h" - import Util import Unique import BasicTypes @@ -92,6 +85,7 @@ import Data.Char -- Unicode TODO: put isSymbol in libcompat #if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ > 604 #else +isSymbol :: a -> Bool isSymbol = const False #endif @@ -129,6 +123,9 @@ data NameSpace = VarName -- Variables, including "real" data constructors -- The real datacon has type Int -> Int -> T -- GHC chooses a representation based on the strictness etc. +tcName, clsName, tcClsName :: NameSpace +dataName, srcDataName :: NameSpace +tvName, varName :: NameSpace -- Though type constructors and classes are in the same name space now, -- the NameSpace type is abstract, so we can easily separate them later @@ -150,22 +147,23 @@ isTcClsName _ = False isVarName :: NameSpace -> Bool -- Variables or type variables, but not constructors isVarName TvName = True isVarName VarName = True -isVarName other = False +isVarName _ = False pprNameSpace :: NameSpace -> SDoc -pprNameSpace DataName = ptext SLIT("data constructor") -pprNameSpace VarName = ptext SLIT("variable") -pprNameSpace TvName = ptext SLIT("type variable") -pprNameSpace TcClsName = ptext SLIT("type constructor or class") +pprNameSpace DataName = ptext (sLit "data constructor") +pprNameSpace VarName = ptext (sLit "variable") +pprNameSpace TvName = ptext (sLit "type variable") +pprNameSpace TcClsName = ptext (sLit "type constructor or class") pprNonVarNameSpace :: NameSpace -> SDoc pprNonVarNameSpace VarName = empty pprNonVarNameSpace ns = pprNameSpace ns +pprNameSpaceBrief :: NameSpace -> SDoc pprNameSpaceBrief DataName = char 'd' pprNameSpaceBrief VarName = char 'v' -pprNameSpaceBrief TvName = ptext SLIT("tv") -pprNameSpaceBrief TcClsName = ptext SLIT("tc") +pprNameSpaceBrief TvName = ptext (sLit "tv") +pprNameSpaceBrief TcClsName = ptext (sLit "tc") \end{code} @@ -305,7 +303,7 @@ filterOccEnv x (A y) = A $ filterUFM x y instance Outputable a => Outputable (OccEnv a) where ppr (A x) = ppr x -type OccSet = UniqFM OccName +type OccSet = UniqSet OccName emptyOccSet :: OccSet unitOccSet :: OccName -> OccSet @@ -352,20 +350,20 @@ occNameString (OccName _ s) = unpackFS s setOccNameSpace :: NameSpace -> OccName -> OccName setOccNameSpace sp (OccName _ occ) = OccName sp occ -isVarOcc, isTvOcc, isDataSymOcc, isSymOcc, isTcOcc :: OccName -> Bool +isVarOcc, isTvOcc, isDataSymOcc, isSymOcc, isTcOcc, isValOcc, isDataOcc :: OccName -> Bool isVarOcc (OccName VarName _) = True -isVarOcc other = False +isVarOcc _ = False isTvOcc (OccName TvName _) = True -isTvOcc other = False +isTvOcc _ = False isTcOcc (OccName TcClsName _) = True -isTcOcc other = False +isTcOcc _ = False isValOcc (OccName VarName _) = True isValOcc (OccName DataName _) = True -isValOcc other = False +isValOcc _ = False -- Data constructor operator (starts with ':', or '[]') -- Pretty inefficient! @@ -373,13 +371,13 @@ isDataSymOcc (OccName DataName s) = isLexConSym s isDataSymOcc (OccName VarName s) | isLexConSym s = pprPanic "isDataSymOcc: check me" (ppr s) -- Jan06: I don't think this should happen -isDataSymOcc other = False +isDataSymOcc _ = False isDataOcc (OccName DataName _) = True isDataOcc (OccName VarName s) | isLexCon s = pprPanic "isDataOcc: check me" (ppr s) -- Jan06: I don't think this should happen -isDataOcc other = False +isDataOcc _ = False -- Any operator (data constructor or variable) -- Pretty inefficient! @@ -432,7 +430,6 @@ Here's our convention for splitting up the interface file name space: This knowledge is encoded in the following functions. - @mk_deriv@ generates an @OccName@ from the prefix and a string. NB: The string must already be encoded! @@ -443,13 +440,24 @@ mk_deriv :: NameSpace -> OccName mk_deriv occ_sp sys_prefix str = mkOccName occ_sp (sys_prefix ++ str) + +isDerivedOccName :: OccName -> Bool +isDerivedOccName occ = + case occNameString occ of + '$':c:_ | isAlphaNum c -> True + ':':c:_ | isAlphaNum c -> True + _other -> False \end{code} \begin{code} mkDataConWrapperOcc, mkWorkerOcc, mkDefaultMethodOcc, mkDerivedTyConOcc, mkClassTyConOcc, mkClassDataConOcc, mkDictOcc, mkIPOcc, mkSpecOcc, mkForeignExportOcc, mkGenOcc1, mkGenOcc2, - mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc, mkNewTyCoOcc + mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc, mkNewTyCoOcc, + mkInstTyCoOcc, mkEqPredCoOcc, + mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc, + mkVectOcc, mkVectTyConOcc, mkVectDataConOcc, mkVectIsoOcc, + mkPArrayTyConOcc, mkPArrayDataConOcc, mkPReprTyConOcc, mkPADFunOcc :: OccName -> OccName -- These derived variables have a prefix that no Haskell value could have @@ -468,6 +476,11 @@ mkNewTyCoOcc = mk_simple_deriv tcName ":Co" mkInstTyCoOcc = mk_simple_deriv tcName ":CoF" -- derived from rep ty mkEqPredCoOcc = mk_simple_deriv tcName "$co" +-- used in derived instances +mkCon2TagOcc = mk_simple_deriv varName "$con2tag_" +mkTag2ConOcc = mk_simple_deriv varName "$tag2con_" +mkMaxTagOcc = mk_simple_deriv varName "$maxtag_" + -- Generic derivable classes mkGenOcc1 = mk_simple_deriv varName "$gfrom" mkGenOcc2 = mk_simple_deriv varName "$gto" @@ -488,6 +501,7 @@ mkPArrayDataConOcc = mk_simple_deriv dataName ":VPD_" mkPReprTyConOcc = mk_simple_deriv tcName ":VR_" mkPADFunOcc = mk_simple_deriv varName "$PA_" +mk_simple_deriv :: NameSpace -> String -> OccName -> OccName mk_simple_deriv sp px occ = mk_deriv sp px (occNameString occ) -- Data constructor workers are made by setting the name space @@ -564,8 +578,8 @@ guys never show up in error messages. What a hack. \begin{code} mkMethodOcc :: OccName -> OccName -mkMethodOcc occ@(OccName VarName fs) = occ -mkMethodOcc occ = mk_simple_deriv varName "$m" occ +mkMethodOcc occ@(OccName VarName _) = occ +mkMethodOcc occ = mk_simple_deriv varName "$m" occ \end{code} @@ -590,6 +604,7 @@ tack on the '1', if necessary. type TidyOccEnv = OccEnv Int -- The in-scope OccNames -- Range gives a plausible starting point for new guesses +emptyTidyOccEnv :: TidyOccEnv emptyTidyOccEnv = emptyOccEnv initTidyOccEnv :: [OccName] -> TidyOccEnv -- Initialise with names to avoid! @@ -660,18 +675,18 @@ isLexSym cs = isLexConSym cs || isLexVarSym cs ------------- isLexConId cs -- Prefix type or data constructors - | nullFS cs = False -- e.g. "Foo", "[]", "(,)" - | cs == FSLIT("[]") = True - | otherwise = startsConId (headFS cs) + | nullFS cs = False -- e.g. "Foo", "[]", "(,)" + | cs == (fsLit "[]") = True + | otherwise = startsConId (headFS cs) isLexVarId cs -- Ordinary prefix identifiers | nullFS cs = False -- e.g. "x", "_x" | otherwise = startsVarId (headFS cs) isLexConSym cs -- Infix type or data constructors - | nullFS cs = False -- e.g. ":-:", ":", "->" - | cs == FSLIT("->") = True - | otherwise = startsConSym (headFS cs) + | nullFS cs = False -- e.g. ":-:", ":", "->" + | cs == (fsLit "->") = True + | otherwise = startsConSym (headFS cs) isLexVarSym cs -- Infix identifiers | nullFS cs = False -- e.g. "+" @@ -684,6 +699,7 @@ startsConSym c = c == ':' -- Infix data constructors startsVarId c = isLower c || c == '_' -- Ordinary Ids startsConId c = isUpper c || c == '(' -- Ordinary type constructors and data constructors +isSymbolASCII :: Char -> Bool isSymbolASCII c = c `elem` "!#$%&*+./<=>?@\\^|~-" \end{code}