Initial checkin of HetMet / -XModalTypes modifications

[ghc-hetmet.git] / compiler / basicTypes / OccName.lhs

diff --git a/compiler/basicTypes/OccName.lhs b/compiler/basicTypes/OccName.lhs
index f02ae8d..c528acb 100644 (file)
--- 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,
@@ -114,7 +114,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
@@ -144,6 +144,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
@@ -155,8 +156,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
@@ -172,27 +188,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!
 
@@ -639,7 +655,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"
@@ -678,7 +694,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}
 
@@ -814,21 +830,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