[project @ 2002-03-04 17:01:26 by simonmar]
[ghc-hetmet.git] / ghc / compiler / basicTypes / OccName.lhs
index faf7aa8..66e158c 100644 (file)
@@ -1,3 +1,4 @@
+{-% DrIFT (Automatic class derivations for Haskell) v1.1 %-}
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
@@ -14,7 +15,8 @@ module OccName (
        OccName,        -- Abstract, instance of Outputable
        pprOccName, 
 
-       mkOccFS, mkSysOcc, mkSysOccFS, mkFCallOcc, mkVarOcc, mkKindOccFS,
+       mkOccFS, mkSysOcc, mkSysOccFS, mkFCallOcc, mkKindOccFS,
+       mkVarOcc, mkVarOccEncoded,
        mkSuperDictSelOcc, mkDFunOcc, mkForeignExportOcc,
        mkDictOcc, mkIPOcc, mkWorkerOcc, mkMethodOcc, mkDefaultMethodOcc,
        mkDerivedTyConOcc, mkClassTyConOcc, mkClassDataConOcc, mkSpecOcc,
@@ -45,6 +47,8 @@ import Util   ( thenCmp )
 import Unique  ( Unique )
 import FiniteMap ( FiniteMap, emptyFM, lookupFM, addToFM, elemFM )
 import Outputable
+import Binary
+
 import GlaExts
 \end{code}
 
@@ -89,6 +93,7 @@ data NameSpace = VarName      -- Variables
               | TcClsName      -- Type constructors and classes; Haskell has them
                                -- in the same name space for now.
               deriving( Eq, Ord )
+   {-! derive: Binary !-}
 
 -- Though type constructors and classes are in the same name space now,
 -- the NameSpace type is abstract, so we can easily separate them later
@@ -119,6 +124,7 @@ nameSpaceString TcClsName = "Type constructor or class"
 data OccName = OccName 
                        NameSpace
                        EncodedFS
+   {-! derive : Binary !-}
 \end{code}
 
 
@@ -188,6 +194,9 @@ mkOccFS occ_sp fs = mkSysOccFS occ_sp (encodeFS fs)
 
 mkVarOcc :: UserFS -> OccName
 mkVarOcc fs = mkSysOccFS varName (encodeFS fs)
+
+mkVarOccEncoded :: EncodedFS -> OccName
+mkVarOccEncoded fs = mkSysOccFS varName fs
 \end{code}
 
 
@@ -613,9 +622,9 @@ isLexSym cs = isLexConSym cs || isLexVarSym cs
 -------------
 
 isLexConId cs                          -- Prefix type or data constructors
-  | _NULL_ cs       = False            --      e.g. "Foo", "[]", "(,)" 
-  | cs == SLIT("[]") = True
-  | otherwise       = startsConId (_HEAD_ cs)
+  | _NULL_ cs        = False           --      e.g. "Foo", "[]", "(,)" 
+  | cs == FSLIT("[]") = True
+  | otherwise        = startsConId (_HEAD_ cs)
 
 isLexVarId cs                          -- Ordinary prefix identifiers
   | _NULL_ cs   = False                --      e.g. "x", "_x"
@@ -623,7 +632,7 @@ isLexVarId cs                               -- Ordinary prefix identifiers
 
 isLexConSym cs                         -- Infix type or data constructors
   | _NULL_ cs  = False                 --      e.g. ":-:", ":", "->"
-  | cs == SLIT("->") = True
+  | cs == FSLIT("->") = True
   | otherwise  = startsConSym (_HEAD_ cs)
 
 isLexVarSym cs                         -- Infix identifiers
@@ -645,3 +654,34 @@ isUpperISO    (C# c#) = c# `geChar#` '\xc0'# && c# `leChar#` '\xde'# && c# `neCh
 isLowerISO    (C# c#) = c# `geChar#` '\xdf'# && c# `leChar#` '\xff'# && c# `neChar#` '\xf7'#
        --0xdf <= oc && oc <= 0xff && oc /= 0xf7 where oc = ord c
 \end{code}
+\begin{code}
+{-* Generated by DrIFT-v1.0 : Look, but Don't Touch. *-}
+instance Binary NameSpace where
+    put_ bh VarName = do
+           putByte bh 0
+    put_ bh DataName = do
+           putByte bh 1
+    put_ bh TvName = do
+           putByte bh 2
+    put_ bh TcClsName = do
+           putByte bh 3
+    get bh = do
+           h <- getByte bh
+           case h of
+             0 -> do return VarName
+             1 -> do return DataName
+             2 -> do return TvName
+             _ -> do return TcClsName
+
+instance Binary OccName where
+    put_ bh (OccName aa ab) = do
+           put_ bh aa
+           put_ bh ab
+    get bh = do
+         aa <- get bh
+         ab <- get bh
+         return (OccName aa ab)
+
+--  Imported from other files :-
+
+\end{code}