-
+{-% DrIFT (Automatic class derivations for Haskell) v1.1 %-}
+%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
\begin{code}
module OccName (
- -- Modules
- Module, -- Abstract, instance of Outputable
- mkModule, mkModuleFS, moduleString, moduleCString, pprModule,
+ -- The NameSpace type; abstact
+ NameSpace, tcName, clsName, tcClsName, dataName, varName,
+ tvName, srcDataName, nameSpaceString,
-- The OccName type
OccName, -- Abstract, instance of Outputable
- varOcc, tcOcc, tvOcc, -- Occ constructors
- srcVarOcc, srcTCOcc, srcTvOcc, -- For Occs arising from source code
-
- mkSuperDictSelOcc, mkDFunOcc,
- mkDictOcc, mkWorkerOcc, mkDefaultMethodOcc,
- mkClassTyConOcc, mkClassDataConOcc,
+ pprOccName,
+
+ -- The OccEnv type
+ OccEnv, emptyOccEnv, unitOccEnv, extendOccEnv,
+ lookupOccEnv, mkOccEnv, extendOccEnvList, elemOccEnv,
+ occEnvElts, foldOccEnv, plusOccEnv, plusOccEnv_C, extendOccEnv_C,
+
+
+ -- The OccSet type
+ OccSet, emptyOccSet, unitOccSet, mkOccSet, extendOccSet, extendOccSetList,
+ unionOccSets, unionManyOccSets, minusOccSet, elemOccSet, occSetElts,
+ foldOccSet, isEmptyOccSet, intersectOccSet, intersectsOccSet,
+
+ mkOccName, mkOccFS, mkSysOcc, mkSysOccFS, mkFCallOcc, mkKindOccFS,
+ mkVarOcc, mkVarOccEncoded,
+ mkSuperDictSelOcc, mkDFunOcc, mkForeignExportOcc,
+ mkDictOcc, mkIPOcc, mkWorkerOcc, mkMethodOcc, mkDefaultMethodOcc,
+ mkDerivedTyConOcc, mkClassTyConOcc, mkClassDataConOcc, mkSpecOcc,
+ mkGenOcc1, mkGenOcc2, mkLocalOcc, mkDataTOcc, mkDataCOcc,
+ mkDataConWrapperOcc, mkDataConWorkerOcc,
- isTvOcc, isTCOcc, isVarOcc, isConSymOcc, isConOcc, isSymOcc,
- isWildCardOcc, isAnonOcc,
- pprOccName, occNameString, occNameFlavour,
+ isVarOcc, isTvOcc, isTcOcc, isDataOcc, isDataSymOcc, isSymOcc, isValOcc,
+ parenSymOcc, reportIfUnused,
+
+ occNameFS, occNameString, occNameUserString, occNameSpace,
+ occNameFlavour, briefOccNameFlavour,
+ setOccNameSpace,
+
+ mkTupleOcc, isTupleOcc_maybe,
- -- The basic form of names
- isLexCon, isLexVar, isLexId, isLexSym,
- isLexConId, isLexConSym, isLexVarId, isLexVarSym,
- isLowerISO, isUpperISO,
-
-- Tidying up
TidyOccEnv, emptyTidyOccEnv, tidyOccName, initTidyOccEnv,
- -- Junk
- identToC
+ -- Encoding
+ EncodedString, EncodedFS, UserString, UserFS, encode, encodeFS, decode, pprEncodedFS,
+
+ -- The basic form of names
+ isLexCon, isLexVar, isLexId, isLexSym,
+ isLexConId, isLexConSym, isLexVarId, isLexVarSym,
+ isLowerISO, isUpperISO
) where
#include "HsVersions.h"
-#if __HASKELL1__ > 4
-import Char ( isAlpha, isUpper, isLower, isAlphaNum{-sigh-}, ord )
-#else
-import Char ( isAlpha, isUpper, isLower, isAlphanum, ord )
-#endif
+import Char ( isDigit, isUpper, isLower, isAlphaNum, ord, chr, digitToInt )
import Util ( thenCmp )
-import FiniteMap ( FiniteMap, emptyFM, lookupFM, addToFM, elemFM )
+import Unique ( Unique, mkUnique, Uniquable(..) )
+import BasicTypes ( Boxity(..), Arity )
+import UniqFM
+import UniqSet
+import FastString
import Outputable
-import GlaExts
+import Binary
+
+import GLAEXTS
\end{code}
+We hold both module names and identifier names in a 'Z-encoded' form
+that makes them acceptable both as a C identifier and as a Haskell
+(prefix) identifier.
+
+They can always be decoded again when printing error messages
+or anything else for the user, but it does make sense for it
+to be represented here in encoded form, so that when generating
+code the encoding operation is not performed on each occurrence.
+
+These type synonyms help documentation.
+
+\begin{code}
+type UserFS = FastString -- As the user typed it
+type EncodedFS = FastString -- Encoded form
+
+type UserString = String -- As the user typed it
+type EncodedString = String -- Encoded form
+
+
+pprEncodedFS :: EncodedFS -> SDoc
+pprEncodedFS fs
+ = getPprStyle $ \ sty ->
+ if userStyle sty
+ -- ftext (decodeFS fs) would needlessly pack the string again
+ then text (decode (unpackFS fs))
+ else ftext fs
+\end{code}
%************************************************************************
%* *
-\subsection[Module]{The name of a module}
+\subsection{Name space}
%* *
%************************************************************************
\begin{code}
-data Module = Module FAST_STRING -- User and interface files
- FAST_STRING -- Print this in C files
-
- -- The C version has quote chars Z-encoded
-
-instance Outputable Module where
- ppr = pprModule
-
-instance Eq Module where
- (Module m1 _) == (Module m2 _) = m1 == m2
+data NameSpace = VarName -- Variables, including "source" data constructors
+ | DataName -- "Real" data constructors
+ | TvName -- Type variables
+ | TcClsName -- Type constructors and classes; Haskell has them
+ -- in the same name space for now.
+ deriving( Eq, Ord )
+ {-! derive: Binary !-}
+
+-- Note [Data Constructors]
+-- see also: Note [Data Constructor Naming] in DataCon.lhs
+--
+-- "Source" data constructors are the data constructors mentioned
+-- in Haskell source code
+--
+-- "Real" data constructors are the data constructors of the
+-- representation type, which may not be the same as the source
+-- type
-instance Ord Module where
- (Module m1 _) `compare` (Module m2 _) = m1 `compare` m2
+-- Example:
+-- data T = T !(Int,Int)
+--
+-- The source datacon has type (Int,Int) -> T
+-- The real datacon has type Int -> Int -> T
+-- GHC chooses a representation based on the strictness etc.
-pprModule :: Module -> SDoc
-pprModule (Module real code)
- = getPprStyle $ \ sty ->
- if codeStyle sty then
- ptext code
- else
- ptext real
-mkModule :: String -> Module
-mkModule s = Module (_PK_ s) (identToC s)
+-- Though type constructors and classes are in the same name space now,
+-- the NameSpace type is abstract, so we can easily separate them later
+tcName = TcClsName -- Type constructors
+clsName = TcClsName -- Classes
+tcClsName = TcClsName -- Not sure which!
-mkModuleFS :: FAST_STRING -> Module
-mkModuleFS s = Module s (identFsToC s)
+dataName = DataName
+srcDataName = DataName -- Haskell-source data constructors should be
+ -- in the Data name space
-moduleString :: Module -> String
-moduleString (Module mod _) = _UNPK_ mod
+tvName = TvName
+varName = VarName
-moduleCString :: Module -> String
-moduleCString (Module _ code) = _UNPK_ code
+nameSpaceString :: NameSpace -> String
+nameSpaceString DataName = "Data constructor"
+nameSpaceString VarName = "Variable"
+nameSpaceString TvName = "Type variable"
+nameSpaceString TcClsName = "Type constructor or class"
\end{code}
%************************************************************************
\begin{code}
-data OccName = OccName
- OccSpace
- FAST_STRING -- The 'real name'
- FAST_STRING -- Print this in interface files
- FAST_STRING -- Print this in C/asm code
-
--- The OccSpace/real-name pair define the OccName
--- The iface and c/asm versions are simply derived from the
--- other two. They are cached here simply to avoid recomputing
--- them repeatedly when printing
-
--- The latter two are irrelevant in RdrNames; on the other hand,
--- the OccSpace field is irrelevant after RdrNames.
--- So the OccName type might be refined a bit.
--- It is now abstract so that's easier than before
-
-
--- Why three print-names?
--- Real Iface C
--- ---------------------
--- foo foo foo
---
--- + + Zp Operators OK in interface files;
--- 'Z' is the escape char for C names
---
--- x# x# xZh Trailing # lexed ok by GHC -fglasgow-exts
---
--- _foo _ufoo _ufoo Leading '_' is the escape char in interface files
---
--- _vfoo _vfoo _vfoo Worker for foo
---
--- _wp _wp _wp Worker for +
+data OccName = OccName
+ NameSpace
+ EncodedFS
+ {-! derive : Binary !-}
+\end{code}
-data OccSpace = VarOcc -- Variables and data constructors
- | TvOcc -- Type variables
- | TCOcc -- Type constructors and classes
- deriving( Eq, Ord )
+\begin{code}
+instance Eq OccName where
+ (OccName sp1 s1) == (OccName sp2 s2) = s1 == s2 && sp1 == sp2
+
+instance Ord OccName where
+ compare (OccName sp1 s1) (OccName sp2 s2) = (s1 `compare` s2) `thenCmp`
+ (sp1 `compare` sp2)
\end{code}
\begin{code}
instance Outputable OccName where
- ppr = pprOccName
+ ppr = pprOccName
pprOccName :: OccName -> SDoc
-pprOccName (OccName space real iface code)
+pprOccName (OccName sp occ)
= getPprStyle $ \ sty ->
- if codeStyle sty then
- ptext code
- else if ifaceStyle sty then
- ptext iface
- else
- ptext real
+ pprEncodedFS occ <> if debugStyle sty then
+ braces (text (briefNameSpaceFlavour sp))
+ else empty
\end{code}
%* *
\subsection{Construction}
%* *
-%************************************************************************
-
-*Source-code* things beginning with '_' are zapped to begin with '_u'
-
-\begin{code}
-mkSrcOcc :: OccSpace -> FAST_STRING -> OccName
-mkSrcOcc occ_sp real
- = case _UNPK_ real of
-
- '_' : rest -> OccName occ_sp real (_PK_ zapped_str) (identToC zapped_str)
- where
- zapped_str = '_' : 'u' : rest
+%*****p*******************************************************************
- other -> OccName occ_sp real real (identFsToC real)
+*Sys* things do no encoding; the caller should ensure that the thing is
+already encoded
-srcVarOcc, srcTCOcc, srcTvOcc :: FAST_STRING -> OccName
-srcVarOcc = mkSrcOcc VarOcc
-srcTCOcc = mkSrcOcc TCOcc
-srcTvOcc = mkSrcOcc TvOcc
+\begin{code}
+mkSysOcc :: NameSpace -> EncodedString -> OccName
+mkSysOcc occ_sp str = ASSERT2( alreadyEncoded str, text str )
+ OccName occ_sp (mkFastString str)
+
+mkSysOccFS :: NameSpace -> EncodedFS -> OccName
+mkSysOccFS occ_sp fs = ASSERT2( alreadyEncodedFS fs, ppr fs )
+ OccName occ_sp fs
+
+mkFCallOcc :: EncodedString -> OccName
+-- This version of mkSysOcc doesn't check that the string is already encoded,
+-- because it will be something like "{__ccall f dyn Int# -> Int#}"
+-- This encodes a lot into something that then parses like an Id.
+-- But then alreadyEncoded complains about the braces!
+mkFCallOcc str = OccName varName (mkFastString str)
+
+-- Kind constructors get a special function. Uniquely, they are not encoded,
+-- so that they have names like '*'. This means that *even in interface files*
+-- we'll get kinds like (* -> (* -> *)). We can't use mkSysOcc because it
+-- has an ASSERT that doesn't hold.
+mkKindOccFS :: NameSpace -> EncodedFS -> OccName
+mkKindOccFS occ_sp fs = OccName occ_sp fs
\end{code}
-However, things that don't come from Haskell source code aren't
-treated specially.
+*Source-code* things are encoded.
\begin{code}
-mkOcc :: OccSpace -> String -> OccName
-mkOcc occ_sp str = OccName occ_sp fs fs (identToC str)
- where
- fs = _PK_ str
+mkOccFS :: NameSpace -> UserFS -> OccName
+mkOccFS occ_sp fs = mkSysOccFS occ_sp (encodeFS fs)
-mkFsOcc :: OccSpace -> FAST_STRING -> OccName
-mkFsOcc occ_sp real = OccName occ_sp real real (identFsToC real)
+mkOccName :: NameSpace -> String -> OccName
+mkOccName ns s = mkSysOcc ns (encode s)
-varOcc, tcOcc, tvOcc :: FAST_STRING -> OccName
-varOcc = mkFsOcc VarOcc
-tcOcc = mkFsOcc TCOcc
-tvOcc = mkFsOcc TvOcc
+mkVarOcc :: UserFS -> OccName
+mkVarOcc fs = mkSysOccFS varName (encodeFS fs)
+
+mkVarOccEncoded :: EncodedFS -> OccName
+mkVarOccEncoded fs = mkSysOccFS varName fs
\end{code}
+
%************************************************************************
%* *
-\subsection{Making system names}
+ Environments
%* *
%************************************************************************
-Here's our convention for splitting up the interface file name space:
-
- _d... dictionary identifiers
-
- _f... dict-fun identifiers (from inst decls)
- _g... ditto, when the tycon has symbols
-
- _t... externally visible (non-user visible) names
+OccEnvs are used mainly for the envts in ModIfaces.
- _m... default methods
- _n... default methods (encoded symbols, eg. <= becomes _nle)
+They are efficient, because FastStrings have unique Int# keys. We assume
+this key is less than 2^24, so we can make a Unique using
+ mkUnique ns key :: Unique
+where 'ns' is a Char reprsenting the name space. This in turn makes it
+easy to build an OccEnv.
- _p... superclass selectors
-
- _v... workers
- _w... workers (encoded symbols)
-
- _x... local variables
+\begin{code}
+instance Uniquable OccName where
+ getUnique (OccName ns fs)
+ = mkUnique char (I# (uniqueOfFS fs))
+ where -- See notes above about this getUnique function
+ char = case ns of
+ VarName -> 'i'
+ DataName -> 'd'
+ TvName -> 'v'
+ TcClsName -> 't'
+
+type OccEnv a = UniqFM a
+
+emptyOccEnv :: OccEnv a
+unitOccEnv :: OccName -> a -> OccEnv a
+extendOccEnv :: OccEnv a -> OccName -> a -> OccEnv a
+extendOccEnvList :: OccEnv a -> [(OccName, a)] -> OccEnv a
+lookupOccEnv :: OccEnv a -> OccName -> Maybe a
+mkOccEnv :: [(OccName,a)] -> OccEnv a
+elemOccEnv :: OccName -> OccEnv a -> Bool
+foldOccEnv :: (a -> b -> b) -> b -> OccEnv a -> b
+occEnvElts :: OccEnv a -> [a]
+extendOccEnv_C :: (a->a->a) -> OccEnv a -> OccName -> a -> OccEnv a
+plusOccEnv :: OccEnv a -> OccEnv a -> OccEnv a
+plusOccEnv_C :: (a->a->a) -> OccEnv a -> OccEnv a -> OccEnv a
+
+emptyOccEnv = emptyUFM
+unitOccEnv = unitUFM
+extendOccEnv = addToUFM
+extendOccEnvList = addListToUFM
+lookupOccEnv = lookupUFM
+mkOccEnv = listToUFM
+elemOccEnv = elemUFM
+foldOccEnv = foldUFM
+occEnvElts = eltsUFM
+plusOccEnv = plusUFM
+plusOccEnv_C = plusUFM_C
+extendOccEnv_C = addToUFM_C
+
+
+type OccSet = UniqFM OccName
+
+emptyOccSet :: OccSet
+unitOccSet :: OccName -> OccSet
+mkOccSet :: [OccName] -> OccSet
+extendOccSet :: OccSet -> OccName -> OccSet
+extendOccSetList :: OccSet -> [OccName] -> OccSet
+unionOccSets :: OccSet -> OccSet -> OccSet
+unionManyOccSets :: [OccSet] -> OccSet
+minusOccSet :: OccSet -> OccSet -> OccSet
+elemOccSet :: OccName -> OccSet -> Bool
+occSetElts :: OccSet -> [OccName]
+foldOccSet :: (OccName -> b -> b) -> b -> OccSet -> b
+isEmptyOccSet :: OccSet -> Bool
+intersectOccSet :: OccSet -> OccSet -> OccSet
+intersectsOccSet :: OccSet -> OccSet -> Bool
+
+emptyOccSet = emptyUniqSet
+unitOccSet = unitUniqSet
+mkOccSet = mkUniqSet
+extendOccSet = addOneToUniqSet
+extendOccSetList = addListToUniqSet
+unionOccSets = unionUniqSets
+unionManyOccSets = unionManyUniqSets
+minusOccSet = minusUniqSet
+elemOccSet = elementOfUniqSet
+occSetElts = uniqSetToList
+foldOccSet = foldUniqSet
+isEmptyOccSet = isEmptyUniqSet
+intersectOccSet = intersectUniqSets
+intersectsOccSet s1 s2 = not (isEmptyOccSet (s1 `intersectOccSet` s2))
+\end{code}
- _u... user-defined names that previously began with '_'
- _T... compiler-generated tycons for dictionaries
- _D.. ...ditto data cons
+%************************************************************************
+%* *
+\subsection{Predicates and taking them apart}
+%* *
+%************************************************************************
- __.... keywords (__export, __letrec etc.)
+\begin{code}
+occNameFS :: OccName -> EncodedFS
+occNameFS (OccName _ s) = s
-This knowledge is encoded in the following functions.
+occNameString :: OccName -> EncodedString
+occNameString (OccName _ s) = unpackFS s
+occNameUserString :: OccName -> UserString
+occNameUserString occ = decode (occNameString occ)
+occNameSpace :: OccName -> NameSpace
+occNameSpace (OccName sp _) = sp
+setOccNameSpace :: NameSpace -> OccName -> OccName
+setOccNameSpace sp (OccName _ occ) = OccName sp occ
-@mkDerivedOcc@ generates an @OccName@ from an existing @OccName@;
- eg: workers, derived methods
+-- occNameFlavour is used only to generate good error messages
+occNameFlavour :: OccName -> SDoc
+occNameFlavour (OccName DataName _) = ptext SLIT("data constructor")
+occNameFlavour (OccName TvName _) = ptext SLIT("type variable")
+occNameFlavour (OccName TcClsName _) = ptext SLIT("type constructor or class")
+occNameFlavour (OccName VarName s) = empty
-We pass a character to use as the prefix. So, for example,
- "f" gets derived to "_vf", if the prefix char is 'v'
+-- briefOccNameFlavour is used in debug-printing of names
+briefOccNameFlavour :: OccName -> String
+briefOccNameFlavour (OccName sp _) = briefNameSpaceFlavour sp
-\begin{code}
-mk_deriv :: OccSpace -> Char -> String -> OccName
-mk_deriv occ_sp sys_ch str = mkOcc occ_sp ('_' : sys_ch : str)
+briefNameSpaceFlavour DataName = "d"
+briefNameSpaceFlavour VarName = "v"
+briefNameSpaceFlavour TvName = "tv"
+briefNameSpaceFlavour TcClsName = "tc"
\end{code}
-Things are a bit more complicated if the thing is an operator; then
-we must encode it into a normal identifier first. We do this in
-a simple way, and use a different character prefix (one after the one
-suggested). For example
- "<" gets derived to "_wl", if the prefix char is 'v'
-
\begin{code}
-mk_enc_deriv :: OccSpace
- -> Char -- The system-name-space character (see list above)
- -> OccName -- The OccName from which we are deriving
- -> OccName
-
-mk_enc_deriv occ_sp sys_ch occ
- | needs_encoding real_str = mk_deriv occ_sp sys_op_ch (encode_operator real_str)
- | otherwise = mk_deriv occ_sp sys_ch real_str
- where
- real_str = occNameString occ
- sys_op_ch = succ sys_ch
-
-
-mkDictOcc, mkWorkerOcc, mkDefaultMethodOcc,
- mkClassTyConOcc, mkClassDataConOcc
- :: OccName -> OccName
-
-mkWorkerOcc = mk_enc_deriv VarOcc 'v' -- v,w
-mkDefaultMethodOcc = mk_enc_deriv VarOcc 'm' -- m,n
-mkClassTyConOcc = mk_enc_deriv TCOcc 'T' -- not U
-mkClassDataConOcc = mk_enc_deriv VarOcc 'D' -- not E
-mkDictOcc = mk_enc_deriv VarOcc 'd' -- not e
-\end{code}
-
-\begin{code}
-mkSuperDictSelOcc :: Int -- Index of superclass, eg 3
- -> OccName -- Class, eg "Ord"
- -> OccName -- eg "p3Ord"
-mkSuperDictSelOcc index cls_occ
- = mk_deriv VarOcc 'p' (show index ++ occNameString cls_occ)
+isVarOcc, isTvOcc, isDataSymOcc, isSymOcc, isTcOcc :: OccName -> Bool
+
+isVarOcc (OccName VarName _) = True
+isVarOcc other = False
+
+isTvOcc (OccName TvName _) = True
+isTvOcc other = False
+
+isTcOcc (OccName TcClsName _) = True
+isTcOcc other = False
+
+isValOcc (OccName VarName _) = True
+isValOcc (OccName DataName _) = True
+isValOcc other = False
+
+-- Data constructor operator (starts with ':', or '[]')
+-- Pretty inefficient!
+isDataSymOcc (OccName DataName s) = isLexConSym (decodeFS s)
+isDataSymOcc (OccName VarName s) = isLexConSym (decodeFS s)
+isDataSymOcc other = False
+
+isDataOcc (OccName DataName _) = True
+isDataOcc (OccName VarName s) = isLexCon (decodeFS s)
+isDataOcc other = False
+
+-- Any operator (data constructor or variable)
+-- Pretty inefficient!
+isSymOcc (OccName DataName s) = isLexConSym (decodeFS s)
+isSymOcc (OccName TcClsName s) = isLexConSym (decodeFS s)
+isSymOcc (OccName VarName s) = isLexSym (decodeFS s)
+isSymOcc other = False
+
+parenSymOcc :: OccName -> SDoc -> SDoc
+-- Wrap parens around an operator
+parenSymOcc occ doc | isSymOcc occ = parens doc
+ | otherwise = doc
\end{code}
\begin{code}
-mkDFunOcc :: OccName -- class, eg "Ord"
- -> OccName -- tycon (or something convenient from the instance type)
- -- eg "Maybe"
- -> Int -- Unique to distinguish dfuns which share the previous two
- -- eg 3
- -> OccName -- "dOrdMaybe3"
-
-mkDFunOcc cls_occ tycon_occ index
- | needs_encoding tycon_str -- Drat! Have to encode the tycon
- = mk_deriv VarOcc 'g' (show_index ++ cls_str ++ encode_operator tycon_str)
- | otherwise -- Normal case
- = mk_deriv VarOcc 'f' (show_index ++ cls_str ++ tycon_str)
- where
- cls_str = occNameString cls_occ
- tycon_str = occNameString tycon_occ
- -- NB: if a non-operator the tycon has a trailing # we don't encode.
- show_index | index == 0 = ""
- | otherwise = show index
+reportIfUnused :: OccName -> Bool
+ -- Haskell 98 encourages compilers to suppress warnings about
+ -- unused names in a pattern if they start with "_".
+reportIfUnused occ = case occNameUserString occ of
+ ('_' : _) -> False
+ zz_other -> True
\end{code}
+
%************************************************************************
%* *
-\subsection{Lexical categories}
+\subsection{Making system names}
%* *
%************************************************************************
-These functions test strings to see if they fit the lexical categories
-defined in the Haskell report.
+Here's our convention for splitting up the interface file name space:
-\begin{code}
-isLexCon, isLexVar, isLexId, isLexSym :: FAST_STRING -> Bool
-isLexConId, isLexConSym, isLexVarId, isLexVarSym :: FAST_STRING -> Bool
+ d... dictionary identifiers
+ (local variables, so no name-clash worries)
-isLexCon cs = isLexConId cs || isLexConSym cs
-isLexVar cs = isLexVarId cs || isLexVarSym cs
+ $f... dict-fun identifiers (from inst decls)
+ $dm... default methods
+ $p... superclass selectors
+ $w... workers
+ :T... compiler-generated tycons for dictionaries
+ :D... ...ditto data cons
+ $sf.. specialised version of f
-isLexId cs = isLexConId cs || isLexVarId cs
-isLexSym cs = isLexConSym cs || isLexVarSym cs
+ in encoded form these appear as Zdfxxx etc
--------------
+ :... keywords (export:, letrec: etc.)
+--- I THINK THIS IS WRONG!
-isLexConId cs -- Prefix type or data constructors
- | _NULL_ cs = False -- e.g. "Foo", "[]", "(,)"
- | cs == SLIT("[]") = True
- | c == '(' = True -- (), (,), (,,), ...
- | otherwise = isUpper c || isUpperISO c
- where
- c = _HEAD_ cs
+This knowledge is encoded in the following functions.
-isLexVarId cs -- Ordinary prefix identifiers
- | _NULL_ cs = False -- e.g. "x", "_x"
- | otherwise = isLower c || isLowerISO c || c == '_'
- where
- c = _HEAD_ cs
-isLexConSym cs -- Infix type or data constructors
- | _NULL_ cs = False -- e.g. ":-:", ":", "->"
- | otherwise = c == ':'
- || cs == SLIT("->")
- where
- c = _HEAD_ cs
+@mk_deriv@ generates an @OccName@ from the prefix and a string.
+NB: The string must already be encoded!
-isLexVarSym cs -- Infix identifiers
- | _NULL_ cs = False -- e.g. "+"
- | otherwise = isSymbolASCII c
- || isSymbolISO c
- where
- c = _HEAD_ cs
+\begin{code}
+mk_deriv :: NameSpace
+ -> String -- Distinguishes one sort of derived name from another
+ -> EncodedString -- Must be already encoded!! We don't want to encode it a
+ -- second time because encoding isn't idempotent
+ -> OccName
--------------
-isSymbolASCII c = c `elem` "!#$%&*+./<=>?@\\^|~-"
-isSymbolISO c = ord c `elem` (0xd7 : 0xf7 : [0xa1 .. 0xbf])
-isUpperISO (C# c#) = c# `geChar#` '\xc0'# && c# `leChar#` '\xde'# && c# `neChar#` '\xd7'#
- --0xc0 <= oc && oc <= 0xde && oc /= 0xd7 where oc = ord c
-isLowerISO (C# c#) = c# `geChar#` '\xdf'# && c# `leChar#` '\xff'# && c# `neChar#` '\xf7'#
- --0xdf <= oc && oc <= 0xff && oc /= 0xf7 where oc = ord c
+mk_deriv occ_sp sys_prefix str = mkSysOcc occ_sp (encode sys_prefix ++ str)
\end{code}
-%************************************************************************
-%* *
-\subsection{Predicates and taking them apart}
-%* *
-%************************************************************************
-
-\begin{code}
-occNameString :: OccName -> String
-occNameString (OccName _ s _ _) = _UNPK_ s
-
--- occNameFlavour is used only to generate good error messages, so it doesn't matter
--- that the VarOcc case isn't mega-efficient. We could have different Occ constructors for
--- data constructors and values, but that makes everything else a bit more complicated.
-occNameFlavour :: OccName -> String
-occNameFlavour (OccName VarOcc s _ _) | isLexConId s = "Data constructor"
- | otherwise = "Value"
-occNameFlavour (OccName TvOcc _ _ _) = "Type variable"
-occNameFlavour (OccName TCOcc s _ _) = "Type constructor or class"
-
-isVarOcc, isTCOcc, isTvOcc,
- isConSymOcc, isSymOcc, isWildCardOcc :: OccName -> Bool
+\begin{code}
+mkDictOcc, mkIPOcc, mkWorkerOcc, mkDefaultMethodOcc,
+ mkClassTyConOcc, mkClassDataConOcc, mkSpecOcc
+ :: OccName -> OccName
-isVarOcc (OccName VarOcc _ _ _) = True
-isVarOcc other = False
+-- These derived variables have a prefix that no Haskell value could have
+mkDataConWrapperOcc = mk_simple_deriv varName "$W"
+mkWorkerOcc = mk_simple_deriv varName "$w"
+mkDefaultMethodOcc = mk_simple_deriv varName "$dm"
+mkDerivedTyConOcc = mk_simple_deriv tcName ":" -- The : prefix makes sure it classifies
+mkClassTyConOcc = mk_simple_deriv tcName ":T" -- as a tycon/datacon
+mkClassDataConOcc = mk_simple_deriv dataName ":D" -- We go straight to the "real" data con
+ -- for datacons from classes
+mkDictOcc = mk_simple_deriv varName "$d"
+mkIPOcc = mk_simple_deriv varName "$i"
+mkSpecOcc = mk_simple_deriv varName "$s"
+mkForeignExportOcc = mk_simple_deriv varName "$f"
+
+-- Generic derivable classes
+mkGenOcc1 = mk_simple_deriv varName "$gfrom"
+mkGenOcc2 = mk_simple_deriv varName "$gto"
+
+-- data T = MkT ... deriving( Data ) needs defintions for
+-- $tT :: Data.Generics.Basics.DataType
+-- $cMkT :: Data.Generics.Basics.Constr
+mkDataTOcc = mk_simple_deriv varName "$t"
+mkDataCOcc = mk_simple_deriv varName "$c"
+
+mk_simple_deriv sp px occ = mk_deriv sp px (occNameString occ)
+
+
+-- Data constructor workers are made by setting the name space
+-- of the data constructor OccName (which should be a DataName)
+-- to DataName
+mkDataConWorkerOcc datacon_occ = setOccNameSpace varName datacon_occ
+\end{code}
-isTvOcc (OccName TvOcc _ _ _) = True
-isTvOcc other = False
+\begin{code}
+mkSuperDictSelOcc :: Int -- Index of superclass, eg 3
+ -> OccName -- Class, eg "Ord"
+ -> OccName -- eg "$p3Ord"
+mkSuperDictSelOcc index cls_occ
+ = mk_deriv varName "$p" (show index ++ occNameString cls_occ)
+
+mkLocalOcc :: Unique -- Unique
+ -> OccName -- Local name (e.g. "sat")
+ -> OccName -- Nice unique version ("$L23sat")
+mkLocalOcc uniq occ
+ = mk_deriv varName ("$L" ++ show uniq) (occNameString occ)
+ -- The Unique might print with characters
+ -- that need encoding (e.g. 'z'!)
+\end{code}
-isTCOcc (OccName TCOcc _ _ _) = True
-isTCOcc other = False
-isConSymOcc (OccName _ s _ _) = isLexConSym s
+\begin{code}
+mkDFunOcc :: EncodedString -- Typically the class and type glommed together e.g. "OrdMaybe"
+ -> OccName -- "$fOrdMaybe"
-isSymOcc (OccName _ s _ _) = isLexSym s
+mkDFunOcc string = mk_deriv VarName "$f" string
+\end{code}
-isConOcc (OccName _ s _ _) = isLexCon s
+We used to add a '$m' to indicate a method, but that gives rise to bad
+error messages from the type checker when we print the function name or pattern
+of an instance-decl binding. Why? Because the binding is zapped
+to use the method name in place of the selector name.
+(See TcClassDcl.tcMethodBind)
-isWildCardOcc (OccName _ s _ _) = (_HEAD_ s) == '_' && _LENGTH_ s == 1
+The way it is now, -ddump-xx output may look confusing, but
+you can always say -dppr-debug to get the uniques.
-isAnonOcc (OccName _ s _ _) = (_HEAD_ s) == '_'
-\end{code}
+However, we *do* have to zap the first character to be lower case,
+because overloaded constructors (blarg) generate methods too.
+And convert to VarName space
+e.g. a call to constructor MkFoo where
+ data (Ord a) => Foo a = MkFoo a
-%************************************************************************
-%* *
-\subsection{Comparison}
-%* *
-%************************************************************************
-
-Comparison is done by space and 'real' name
+If this is necessary, we do it by prefixing '$m'. These
+guys never show up in error messages. What a hack.
\begin{code}
-instance Eq OccName where
- a == b = case (a `compare` b) of { EQ -> True; _ -> False }
- a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
-
-instance Ord OccName where
- a <= b = case (a `compare` b) of { LT -> True; EQ -> True; GT -> False }
- a < b = case (a `compare` b) of { LT -> True; EQ -> False; GT -> False }
- a >= b = case (a `compare` b) of { LT -> False; EQ -> True; GT -> True }
- a > b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True }
-
- compare (OccName sp1 r1 _ _) (OccName sp2 r2 _ _)
- = (sp1 `compare` sp2) `thenCmp` (r1 `compare` r2)
+mkMethodOcc :: OccName -> OccName
+mkMethodOcc occ@(OccName VarName fs) = occ
+mkMethodOcc occ = mk_simple_deriv varName "$m" occ
\end{code}
tack on the '1', if necessary.
\begin{code}
-type TidyOccEnv = FiniteMap FAST_STRING Int -- The in-scope OccNames
-emptyTidyOccEnv = emptyFM
+type TidyOccEnv = OccEnv Int -- The in-scope OccNames
+ -- Range gives a plausible starting point for new guesses
+
+emptyTidyOccEnv = emptyOccEnv
initTidyOccEnv :: [OccName] -> TidyOccEnv -- Initialise with names to avoid!
-initTidyOccEnv = foldl (\env (OccName _ fs _ _) -> addToFM env fs 1) emptyTidyOccEnv
+initTidyOccEnv = foldl (\env occ -> extendOccEnv env occ 1) emptyTidyOccEnv
tidyOccName :: TidyOccEnv -> OccName -> (TidyOccEnv, OccName)
-tidyOccName in_scope occ@(OccName occ_sp real _ _)
- | not (real `elemFM` in_scope) &&
- not (isLexCon real) -- Hack alert! Specialised versions of overloaded
- -- constructors end up as ordinary Ids, but we don't
- -- want them as ConIds in interface files.
+tidyOccName in_scope occ@(OccName occ_sp fs)
+ = case lookupOccEnv in_scope occ of
+ Nothing -> -- Not already used: make it used
+ (extendOccEnv in_scope occ 1, occ)
- = (addToFM in_scope real 1, occ) -- First occurrence
+ Just n -> -- Already used: make a new guess,
+ -- change the guess base, and try again
+ tidyOccName (extendOccEnv in_scope occ (n+1))
+ (mkSysOcc occ_sp (unpackFS fs ++ show n))
+\end{code}
- | otherwise -- Already occurs
- = -- First encode, to deal with
- -- a) operators, and
- -- b) trailing # signs
- -- so that we can then append '1', '2', etc
- go in_scope (encode_operator (_UNPK_ real))
- where
- go in_scope str = case lookupFM in_scope pk_str of
- Just n -> go (addToFM in_scope pk_str (n+1)) (str ++ show n)
- -- Need to go round again, just in case "t3" (say)
- -- clashes with a "t3" that's already in scope
+%************************************************************************
+%* *
+\subsection{The 'Z' encoding}
+%* *
+%************************************************************************
+
+This is the main name-encoding and decoding function. It encodes any
+string into a string that is acceptable as a C name. This is the name
+by which things are known right through the compiler.
+
+The basic encoding scheme is this.
+
+* Tuples (,,,) are coded as Z3T
+
+* Alphabetic characters (upper and lower) and digits
+ all translate to themselves;
+ except 'Z', which translates to 'ZZ'
+ and 'z', which translates to 'zz'
+ We need both so that we can preserve the variable/tycon distinction
+
+* Most other printable characters translate to 'zx' or 'Zx' for some
+ alphabetic character x
+
+* The others translate as 'znnnU' where 'nnn' is the decimal number
+ of the character
+
+ Before After
+ --------------------------
+ Trak Trak
+ foo_wib foozuwib
+ > zg
+ >1 zg1
+ foo# foozh
+ foo## foozhzh
+ foo##1 foozhzh1
+ fooZ fooZZ
+ :+ ZCzp
+ () Z0T 0-tuple
+ (,,,,) Z5T 5-tuple
+ (# #) Z1H unboxed 1-tuple (note the space)
+ (#,,,,#) Z5H unboxed 5-tuple
+ (NB: There is no Z1T nor Z0H.)
+
+\begin{code}
+-- alreadyEncoded is used in ASSERTs to check for encoded
+-- strings. It isn't fail-safe, of course, because, say 'zh' might
+-- be encoded or not.
+alreadyEncoded :: String -> Bool
+alreadyEncoded s = all ok s
+ where
+ ok ' ' = True
+ -- This is a bit of a lie; if we really wanted spaces
+ -- in names we'd have to encode them. But we do put
+ -- spaces in ccall "occurrences", and we don't want to
+ -- reject them here
+ ok ch = isAlphaNum ch
+
+alreadyEncodedFS :: FastString -> Bool
+alreadyEncodedFS fs = alreadyEncoded (unpackFS fs)
+
+encode :: UserString -> EncodedString
+encode cs = case maybe_tuple cs of
+ Just n -> n -- Tuples go to Z2T etc
+ Nothing -> go cs
+ where
+ go [] = []
+ go (c:cs) = encode_ch c ++ go cs
+
+encodeFS :: UserFS -> EncodedFS
+encodeFS fast_str | all unencodedChar str = fast_str
+ | otherwise = mkFastString (encode str)
+ where
+ str = unpackFS fast_str
+
+unencodedChar :: Char -> Bool -- True for chars that don't need encoding
+unencodedChar 'Z' = False
+unencodedChar 'z' = False
+unencodedChar c = c >= 'a' && c <= 'z'
+ || c >= 'A' && c <= 'Z'
+ || c >= '0' && c <= '9'
+
+encode_ch :: Char -> EncodedString
+encode_ch c | unencodedChar c = [c] -- Common case first
+
+-- Constructors
+encode_ch '(' = "ZL" -- Needed for things like (,), and (->)
+encode_ch ')' = "ZR" -- For symmetry with (
+encode_ch '[' = "ZM"
+encode_ch ']' = "ZN"
+encode_ch ':' = "ZC"
+encode_ch 'Z' = "ZZ"
+
+-- Variables
+encode_ch 'z' = "zz"
+encode_ch '&' = "za"
+encode_ch '|' = "zb"
+encode_ch '^' = "zc"
+encode_ch '$' = "zd"
+encode_ch '=' = "ze"
+encode_ch '>' = "zg"
+encode_ch '#' = "zh"
+encode_ch '.' = "zi"
+encode_ch '<' = "zl"
+encode_ch '-' = "zm"
+encode_ch '!' = "zn"
+encode_ch '+' = "zp"
+encode_ch '\'' = "zq"
+encode_ch '\\' = "zr"
+encode_ch '/' = "zs"
+encode_ch '*' = "zt"
+encode_ch '_' = "zu"
+encode_ch '%' = "zv"
+encode_ch c = 'z' : shows (ord c) "U"
+\end{code}
- Nothing -> (addToFM in_scope pk_str 1, mkFsOcc occ_sp pk_str)
- -- str is now unique
- where
- pk_str = _PK_ str
+Decode is used for user printing.
+
+\begin{code}
+decodeFS :: FastString -> FastString
+decodeFS fs = mkFastString (decode (unpackFS fs))
+
+decode :: EncodedString -> UserString
+decode [] = []
+decode ('Z' : d : rest) | isDigit d = decode_tuple d rest
+ | otherwise = decode_upper d : decode rest
+decode ('z' : d : rest) | isDigit d = decode_num_esc d rest
+ | otherwise = decode_lower d : decode rest
+decode (c : rest) = c : decode rest
+
+decode_upper, decode_lower :: Char -> Char
+
+decode_upper 'L' = '('
+decode_upper 'R' = ')'
+decode_upper 'M' = '['
+decode_upper 'N' = ']'
+decode_upper 'C' = ':'
+decode_upper 'Z' = 'Z'
+decode_upper ch = pprTrace "decode_upper" (char ch) ch
+
+decode_lower 'z' = 'z'
+decode_lower 'a' = '&'
+decode_lower 'b' = '|'
+decode_lower 'c' = '^'
+decode_lower 'd' = '$'
+decode_lower 'e' = '='
+decode_lower 'g' = '>'
+decode_lower 'h' = '#'
+decode_lower 'i' = '.'
+decode_lower 'l' = '<'
+decode_lower 'm' = '-'
+decode_lower 'n' = '!'
+decode_lower 'p' = '+'
+decode_lower 'q' = '\''
+decode_lower 'r' = '\\'
+decode_lower 's' = '/'
+decode_lower 't' = '*'
+decode_lower 'u' = '_'
+decode_lower 'v' = '%'
+decode_lower ch = pprTrace "decode_lower" (char ch) ch
+
+-- Characters not having a specific code are coded as z224U
+decode_num_esc d rest
+ = go (digitToInt d) rest
+ where
+ go n (c : rest) | isDigit c = go (10*n + digitToInt c) rest
+ go n ('U' : rest) = chr n : decode rest
+ go n other = pprPanic "decode_num_esc" (ppr n <+> text other)
+
+decode_tuple :: Char -> EncodedString -> UserString
+decode_tuple d rest
+ = go (digitToInt d) rest
+ where
+ -- NB. recurse back to decode after decoding the tuple, because
+ -- the tuple might be embedded in a longer name.
+ go n (c : rest) | isDigit c = go (10*n + digitToInt c) rest
+ go 0 ('T':rest) = "()" ++ decode rest
+ go n ('T':rest) = '(' : replicate (n-1) ',' ++ ")" ++ decode rest
+ go 1 ('H':rest) = "(# #)" ++ decode rest
+ go n ('H':rest) = '(' : '#' : replicate (n-1) ',' ++ "#)" ++ decode rest
+ go n other = pprPanic "decode_tuple" (ppr n <+> text other)
\end{code}
%************************************************************************
%* *
-\subsection{Encoding for operators in derived names}
+ Stuff for dealing with tuples
%* *
%************************************************************************
-See comments with mk_enc_deriv
+Tuples are encoded as
+ Z3T or Z3H
+for 3-tuples or unboxed 3-tuples respectively. No other encoding starts
+ Z<digit>
+
+* "(# #)" is the tycon for an unboxed 1-tuple (not 0-tuple)
+ There are no unboxed 0-tuples.
+
+* "()" is the tycon for a boxed 0-tuple.
+ There are no boxed 1-tuples.
+
\begin{code}
-needs_encoding :: String -> Bool -- Needs encoding when embedded in a derived name
- -- Just look at the first character
-needs_encoding (c:cs) = not (isAlpha c || c == '_')
-
-encode_operator :: String -> String
-encode_operator nm = foldr tran "" nm
- where
- tran c cs = case trChar c of
- '\0' -> '_' : show (ord c) ++ cs -- No translation
- tr_c -> tr_c : cs
-
- trChar '&' = 'a'
- trChar '|' = 'b'
- trChar ':' = 'c'
- trChar '/' = 'd'
- trChar '=' = 'e'
- trChar '>' = 'g'
- trChar '#' = 'h'
- trChar '@' = 'i'
- trChar '<' = 'l'
- trChar '-' = 'm'
- trChar '!' = 'n'
- trChar '+' = 'p'
- trChar '\'' = 'q'
- trChar '$' = 'r'
- trChar '?' = 's'
- trChar '*' = 't'
- trChar '_' = 'u'
- trChar '.' = 'v'
- trChar '\\' = 'w'
- trChar '%' = 'x'
- trChar '~' = 'y'
- trChar '^' = 'z'
- trChar _ = '\0' -- No translation
+maybe_tuple :: UserString -> Maybe EncodedString
+
+maybe_tuple "(# #)" = Just("Z1H")
+maybe_tuple ('(' : '#' : cs) = case count_commas (0::Int) cs of
+ (n, '#' : ')' : cs) -> Just ('Z' : shows (n+1) "H")
+ other -> Nothing
+maybe_tuple "()" = Just("Z0T")
+maybe_tuple ('(' : cs) = case count_commas (0::Int) cs of
+ (n, ')' : cs) -> Just ('Z' : shows (n+1) "T")
+ other -> Nothing
+maybe_tuple other = Nothing
+
+count_commas :: Int -> String -> (Int, String)
+count_commas n (',' : cs) = count_commas (n+1) cs
+count_commas n cs = (n,cs)
\end{code}
+\begin{code}
+mkTupleOcc :: NameSpace -> Boxity -> Arity -> OccName
+mkTupleOcc ns bx ar
+ = OccName ns (mkFastString ('Z' : (show ar ++ bx_char)))
+ where
+ bx_char = case bx of
+ Boxed -> "T"
+ Unboxed -> "H"
+
+isTupleOcc_maybe :: OccName -> Maybe (NameSpace, Boxity, Arity)
+-- Tuples are special, because there are so many of them!
+isTupleOcc_maybe (OccName ns fs)
+ = case unpackFS fs of
+ ('Z':d:rest) | isDigit d -> Just (decode_tup (digitToInt d) rest)
+ other -> Nothing
+ where
+ decode_tup n "H" = (ns, Unboxed, n)
+ decode_tup n "T" = (ns, Boxed, n)
+ decode_tup n (d:rest) = decode_tup (n*10 + digitToInt d) rest
+\end{code}
%************************************************************************
%* *
-\subsection{The 'Z' encoding}
+\subsection{Lexical categories}
%* *
%************************************************************************
-We provide two interfaces for efficiency.
+These functions test strings to see if they fit the lexical categories
+defined in the Haskell report.
\begin{code}
-identToC :: String -> FAST_STRING
-identToC str
- | all isAlphanum str && not std = _PK_ str
- | std = _PK_ ("Zs" ++ encode str)
- | otherwise = _PK_ (encode str)
- where
- std = has_std_prefix str
+isLexCon, isLexVar, isLexId, isLexSym :: FastString -> Bool
+isLexConId, isLexConSym, isLexVarId, isLexVarSym :: FastString -> Bool
-identFsToC :: FAST_STRING -> FAST_STRING
-identFsToC fast_str
- | all isAlphanum str && not std = fast_str
- | std = _PK_ ("Zs" ++ encode str)
- | otherwise = _PK_ (encode str)
- where
- std = has_std_prefix str
- str = _UNPK_ fast_str
+isLexCon cs = isLexConId cs || isLexConSym cs
+isLexVar cs = isLexVarId cs || isLexVarSym cs
--- avoid "stdin", "stdout", and "stderr"...
-has_std_prefix ('s':'t':'d':_) = True
-has_std_prefix _ = False
+isLexId cs = isLexConId cs || isLexVarId cs
+isLexSym cs = isLexConSym cs || isLexVarSym cs
-encode :: String -> String
-encode [] = []
-encode (c:cs) = encode_ch c ++ encode cs
+-------------
-encode_ch :: Char -> String
-encode_ch c | isAlphanum c = [c]
- -- Common case first
-encode_ch 'Z' = "ZZ"
-encode_ch '&' = "Za"
-encode_ch '|' = "Zb"
-encode_ch ':' = "Zc"
-encode_ch '/' = "Zd"
-encode_ch '=' = "Ze"
-encode_ch '>' = "Zg"
-encode_ch '#' = "Zh"
-encode_ch '<' = "Zl"
-encode_ch '-' = "Zm"
-encode_ch '!' = "Zn"
-encode_ch '.' = "Zs"
-encode_ch '\'' = "Zq"
-encode_ch '*' = "Zt"
-encode_ch '+' = "Zp"
-encode_ch '_' = "_"
-encode_ch c = 'Z':show (ord c)
+isLexConId cs -- Prefix type or data constructors
+ | nullFastString cs = False -- e.g. "Foo", "[]", "(,)"
+ | cs == FSLIT("[]") = True
+ | otherwise = startsConId (headFS cs)
+
+isLexVarId cs -- Ordinary prefix identifiers
+ | nullFastString cs = False -- e.g. "x", "_x"
+ | otherwise = startsVarId (headFS cs)
+
+isLexConSym cs -- Infix type or data constructors
+ | nullFastString cs = False -- e.g. ":-:", ":", "->"
+ | cs == FSLIT("->") = True
+ | otherwise = startsConSym (headFS cs)
+
+isLexVarSym cs -- Infix identifiers
+ | nullFastString cs = False -- e.g. "+"
+ | otherwise = startsVarSym (headFS cs)
+
+-------------
+startsVarSym, startsVarId, startsConSym, startsConId :: Char -> Bool
+startsVarSym c = isSymbolASCII c || isSymbolISO c -- Infix Ids
+startsConSym c = c == ':' -- Infix data constructors
+startsVarId c = isLower c || isLowerISO c || c == '_' -- Ordinary Ids
+startsConId c = isUpper c || isUpperISO c || c == '(' -- Ordinary type constructors and data constructors
+
+
+isSymbolASCII c = c `elem` "!#$%&*+./<=>?@\\^|~-"
+isSymbolISO c = ord c `elem` (0xd7 : 0xf7 : [0xa1 .. 0xbf])
+isUpperISO (C# c#) = c# `geChar#` '\xc0'# && c# `leChar#` '\xde'# && c# `neChar#` '\xd7'#
+ --0xc0 <= oc && oc <= 0xde && oc /= 0xd7 where oc = ord c
+isLowerISO (C# c#) = c# `geChar#` '\xdf'# && c# `leChar#` '\xff'# && c# `neChar#` '\xf7'#
+ --0xdf <= oc && oc <= 0xff && oc /= 0xf7 where oc = ord c
\end{code}
-For \tr{modnameToC}, we really only have to worry about \tr{'}s
-(quote chars) in the name. Rare.
+%************************************************************************
+%* *
+ Binary instance
+ Here rather than BinIface because OccName is abstract
+%* *
+%************************************************************************
\begin{code}
-modnameToC :: FAST_STRING -> FAST_STRING
-modnameToC fast_str = identFsToC fast_str
+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)
\end{code}
projects / ghc-hetmet.git / blobdiff