X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FbasicTypes%2FOccName.lhs;h=5b5f6206146c6fbd7902845084540a0721f587c4;hp=446d11a994b51db9201bf6c3d29ef2d017d2c77a;hb=b2524b3960999fffdb3767900f58825903f6560f;hpb=18691d440f90a3dff4ef538091c886af505e5cf5 diff --git a/compiler/basicTypes/OccName.lhs b/compiler/basicTypes/OccName.lhs index 446d11a..5b5f620 100644 --- a/compiler/basicTypes/OccName.lhs +++ b/compiler/basicTypes/OccName.lhs @@ -25,8 +25,8 @@ module OccName ( -- ** Construction -- $real_vs_source_data_constructors - tcName, clsName, tcClsName, dataName, varName, - tvName, srcDataName, + tcName, clsName, tcClsName, dataName, varName, varNameDepth, + tvName, srcDataName, setOccNameDepth, getOccNameDepth, -- ** Pretty Printing pprNameSpace, pprNonVarNameSpace, pprNameSpaceBrief, @@ -115,7 +115,7 @@ import Data.Data %************************************************************************ \begin{code} -data NameSpace = VarName -- Variables, including "real" data constructors +data NameSpace = VarName Int -- Variables, including "real" data constructors; Int is the syntactic HetMet bracket depth | DataName -- "Source" data constructors | TvName -- Type variables | TcClsName -- Type constructors and classes; Haskell has them @@ -145,6 +145,7 @@ data NameSpace = VarName -- Variables, including "real" data constructors tcName, clsName, tcClsName :: NameSpace dataName, srcDataName :: NameSpace tvName, varName :: NameSpace +varNameDepth :: Int -> 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 @@ -156,8 +157,23 @@ dataName = DataName srcDataName = DataName -- Haskell-source data constructors should be -- in the Data name space -tvName = TvName -varName = VarName +tvName = TvName + +varName = VarName 0 +varNameDepth = VarName + +getOccNameDepth :: OccName -> Int +getOccNameDepth name = + case occNameSpace name of + (VarName d) -> d + _ -> 0 +setOccNameDepth :: Int -> OccName -> OccName +setOccNameDepth depth name = + case occNameSpace name of + (VarName _) -> name{ occNameSpace = VarName depth } + ns -> if depth==0 + then name + else error ("tried to change the depth of a name in namespace " ++ (showSDoc $ ppr name)) isDataConNameSpace :: NameSpace -> Bool isDataConNameSpace DataName = True @@ -173,27 +189,27 @@ isTvNameSpace _ = False isVarNameSpace :: NameSpace -> Bool -- Variables or type variables, but not constructors isVarNameSpace TvName = True -isVarNameSpace VarName = True +isVarNameSpace (VarName _) = True isVarNameSpace _ = False isValNameSpace :: NameSpace -> Bool isValNameSpace DataName = True -isValNameSpace VarName = True +isValNameSpace (VarName _) = True isValNameSpace _ = False pprNameSpace :: NameSpace -> SDoc pprNameSpace DataName = ptext (sLit "data constructor") -pprNameSpace VarName = ptext (sLit "variable") +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 (VarName _) = empty pprNonVarNameSpace ns = pprNameSpace ns pprNameSpaceBrief :: NameSpace -> SDoc pprNameSpaceBrief DataName = char 'd' -pprNameSpaceBrief VarName = char 'v' +pprNameSpaceBrief (VarName _) = char 'v' pprNameSpaceBrief TvName = ptext (sLit "tv") pprNameSpaceBrief TcClsName = ptext (sLit "tc") \end{code} @@ -333,7 +349,7 @@ easy to build an OccEnv. \begin{code} instance Uniquable OccName where -- See Note [The Unique of an OccName] - getUnique (OccName VarName fs) = mkVarOccUnique fs + getUnique (OccName (VarName depth) fs) = mkVarOccUnique fs depth getUnique (OccName DataName fs) = mkDataOccUnique fs getUnique (OccName TvName fs) = mkTvOccUnique fs getUnique (OccName TcClsName fs) = mkTcOccUnique fs @@ -430,7 +446,7 @@ setOccNameSpace sp (OccName _ occ) = OccName sp occ isVarOcc, isTvOcc, isTcOcc, isDataOcc :: OccName -> Bool -isVarOcc (OccName VarName _) = True +isVarOcc (OccName (VarName _) _) = True isVarOcc _ = False isTvOcc (OccName TvName _) = True @@ -442,12 +458,12 @@ isTcOcc _ = False -- | /Value/ 'OccNames's are those that are either in -- the variable or data constructor namespaces isValOcc :: OccName -> Bool -isValOcc (OccName VarName _) = True +isValOcc (OccName (VarName _) _) = True isValOcc (OccName DataName _) = True isValOcc _ = False isDataOcc (OccName DataName _) = True -isDataOcc (OccName VarName s) +isDataOcc (OccName (VarName _) s) | isLexCon s = pprPanic "isDataOcc: check me" (ppr s) -- Jan06: I don't think this should happen isDataOcc _ = False @@ -456,7 +472,7 @@ isDataOcc _ = False -- a symbol (e.g. @:@, or @[]@) isDataSymOcc :: OccName -> Bool isDataSymOcc (OccName DataName s) = isLexConSym s -isDataSymOcc (OccName VarName s) +isDataSymOcc (OccName (VarName _) s) | isLexConSym s = pprPanic "isDataSymOcc: check me" (ppr s) -- Jan06: I don't think this should happen isDataSymOcc _ = False @@ -467,7 +483,7 @@ isDataSymOcc _ = False isSymOcc :: OccName -> Bool isSymOcc (OccName DataName s) = isLexConSym s isSymOcc (OccName TcClsName s) = isLexConSym s -isSymOcc (OccName VarName s) = isLexSym s +isSymOcc (OccName (VarName _) s) = isLexSym s isSymOcc (OccName TvName s) = isLexSym s -- Pretty inefficient! @@ -654,7 +670,7 @@ mkDFunOcc :: String -- ^ Typically the class and type glommed together e.g. @Or -- what the mother module will call it. mkDFunOcc info_str is_boot set - = chooseUniqueOcc VarName (prefix ++ info_str) set + = chooseUniqueOcc (VarName 0) (prefix ++ info_str) set where prefix | is_boot = "$fx" | otherwise = "$f" @@ -693,7 +709,7 @@ guys never show up in error messages. What a hack. \begin{code} mkMethodOcc :: OccName -> OccName -mkMethodOcc occ@(OccName VarName _) = occ +mkMethodOcc occ@(OccName (VarName _) _) = occ mkMethodOcc occ = mk_simple_deriv varName "$m" occ \end{code} @@ -829,21 +845,22 @@ isSymbolASCII c = c `elem` "!#$%&*+./<=>?@\\^|~-" \begin{code} instance Binary NameSpace where - put_ bh VarName = do - putByte bh 0 + put_ bh (VarName depth) = do if depth > 255-4 + then error "FIXME: no support for serializing VarNames at this syntactic depth" + else putByte bh ((fromIntegral ((depth+3) :: Int))) put_ bh DataName = do - putByte bh 1 + putByte bh 0 put_ bh TvName = do - putByte bh 2 + putByte bh 1 put_ bh TcClsName = do - putByte bh 3 + putByte bh 2 get bh = do h <- getByte bh case h of - 0 -> do return VarName - 1 -> do return DataName - 2 -> do return TvName - _ -> do return TcClsName + 0 -> do return DataName + 1 -> do return TvName + 2 -> do return TcClsName + n -> do return (VarName (fromIntegral (n-3))) instance Binary OccName where put_ bh (OccName aa ab) = do