-- The OccEnv type
OccEnv, emptyOccEnv, unitOccEnv, extendOccEnv,
lookupOccEnv, mkOccEnv, extendOccEnvList, elemOccEnv,
- occEnvElts, foldOccEnv, plusOccEnv_C, extendOccEnv_C,
+ occEnvElts, foldOccEnv, plusOccEnv, plusOccEnv_C, extendOccEnv_C,
-- The OccSet type
unionOccSets, unionManyOccSets, minusOccSet, elemOccSet, occSetElts,
foldOccSet, isEmptyOccSet, intersectOccSet, intersectsOccSet,
- mkOccFS, mkSysOcc, mkSysOccFS, mkFCallOcc, mkKindOccFS,
- mkVarOcc, mkVarOccEncoded,
+ mkOccName, mkOccFS, mkSysOcc, mkSysOccFS, mkFCallOcc, mkKindOccFS,
+ mkVarOcc, mkVarOccEncoded, mkTyVarOcc,
mkSuperDictSelOcc, mkDFunOcc, mkForeignExportOcc,
mkDictOcc, mkIPOcc, mkWorkerOcc, mkMethodOcc, mkDefaultMethodOcc,
mkDerivedTyConOcc, mkClassTyConOcc, mkClassDataConOcc, mkSpecOcc,
mkGenOcc1, mkGenOcc2, mkLocalOcc, mkDataTOcc, mkDataCOcc,
mkDataConWrapperOcc, mkDataConWorkerOcc,
- isTvOcc, isTcOcc, isDataOcc, isDataSymOcc, isSymOcc, isValOcc,
- reportIfUnused,
+ isVarOcc, isTvOcc, isTcOcc, isDataOcc, isDataSymOcc, isSymOcc, isValOcc,
+ parenSymOcc, reportIfUnused, isTcClsName, isVarName,
occNameFS, occNameString, occNameUserString, occNameSpace,
occNameFlavour, briefOccNameFlavour,
-- The basic form of names
isLexCon, isLexVar, isLexId, isLexSym,
isLexConId, isLexConSym, isLexVarId, isLexVarSym,
- isLowerISO, isUpperISO
-
+ isLowerISO, isUpperISO,
+ startsVarSym, startsVarId, startsConSym, startsConId
) where
#include "HsVersions.h"
import Util ( thenCmp )
import Unique ( Unique, mkUnique, Uniquable(..) )
import BasicTypes ( Boxity(..), Arity )
+import StaticFlags ( opt_PprStyle_Debug )
import UniqFM
import UniqSet
import FastString
pprEncodedFS :: EncodedFS -> SDoc
pprEncodedFS fs
= getPprStyle $ \ sty ->
- if userStyle sty
+ if userStyle sty || dumpStyle sty
-- ftext (decodeFS fs) would needlessly pack the string again
then text (decode (unpackFS fs))
else ftext fs
tvName = TvName
varName = VarName
+isTcClsName :: NameSpace -> Bool
+isTcClsName TcClsName = True
+isTcClsName _ = False
+
+isVarName :: NameSpace -> Bool -- Variables or type variables, but not constructors
+isVarName TvName = True
+isVarName VarName = True
+isVarName other = False
+
+
nameSpaceString :: NameSpace -> String
-nameSpaceString DataName = "Data constructor"
-nameSpaceString VarName = "Variable"
-nameSpaceString TvName = "Type variable"
-nameSpaceString TcClsName = "Type constructor or class"
+nameSpaceString DataName = "data constructor"
+nameSpaceString VarName = "variable"
+nameSpaceString TvName = "type variable"
+nameSpaceString TcClsName = "type constructor or class"
\end{code}
\begin{code}
data OccName = OccName
- NameSpace
- EncodedFS
- {-! derive : Binary !-}
+ { occNameSpace :: !NameSpace
+ , occNameFS :: !EncodedFS
+ }
\end{code}
%* *
\subsection{Construction}
%* *
-%************************************************************************
+%*****p*******************************************************************
*Sys* things do no encoding; the caller should ensure that the thing is
already encoded
mkOccFS :: NameSpace -> UserFS -> OccName
mkOccFS occ_sp fs = mkSysOccFS occ_sp (encodeFS fs)
+mkOccName :: NameSpace -> String -> OccName
+mkOccName ns s = mkSysOcc ns (encode s)
+
mkVarOcc :: UserFS -> OccName
mkVarOcc fs = mkSysOccFS varName (encodeFS fs)
+mkTyVarOcc :: UserFS -> OccName
+mkTyVarOcc fs = mkSysOccFS tvName (encodeFS fs)
+
mkVarOccEncoded :: EncodedFS -> OccName
mkVarOccEncoded fs = mkSysOccFS varName fs
\end{code}
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
elemOccEnv = elemUFM
foldOccEnv = foldUFM
occEnvElts = eltsUFM
+plusOccEnv = plusUFM
plusOccEnv_C = plusUFM_C
extendOccEnv_C = addToUFM_C
%************************************************************************
\begin{code}
-occNameFS :: OccName -> EncodedFS
-occNameFS (OccName _ s) = s
-
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
-- occNameFlavour is used only to generate good error messages
-occNameFlavour :: OccName -> String
-occNameFlavour (OccName DataName _) = "Data constructor"
-occNameFlavour (OccName TvName _) = "Type variable"
-occNameFlavour (OccName TcClsName _) = "Type constructor or class"
-occNameFlavour (OccName VarName s) = "Variable"
+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
-- briefOccNameFlavour is used in debug-printing of names
briefOccNameFlavour :: OccName -> String
\end{code}
\begin{code}
-isTvOcc, isDataSymOcc, isSymOcc, isTcOcc :: OccName -> Bool
+isVarOcc, isTvOcc, isDataSymOcc, isSymOcc, isTcOcc :: OccName -> Bool
+
+isVarOcc (OccName VarName _) = True
+isVarOcc other = False
isTvOcc (OccName TvName _) = True
isTvOcc other = False
-- Any operator (data constructor or variable)
-- Pretty inefficient!
-isSymOcc (OccName DataName s) = isLexConSym (decodeFS s)
-isSymOcc (OccName VarName s) = isLexSym (decodeFS s)
-isSymOcc other = False
+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}
-- Data constructor workers are made by setting the name space
-- of the data constructor OccName (which should be a DataName)
--- to DataName
+-- to VarName
mkDataConWorkerOcc datacon_occ = setOccNameSpace varName datacon_occ
\end{code}
\begin{code}
mkDFunOcc :: EncodedString -- Typically the class and type glommed together e.g. "OrdMaybe"
- -> OccName -- "$fOrdMaybe"
+ -- Only used in debug mode, for extra clarity
+ -> Bool -- True <=> hs-boot instance dfun
+ -> Int -- Unique index
+ -> OccName -- "$f3OrdMaybe"
-mkDFunOcc string = mk_deriv VarName "$f" string
+-- In hs-boot files we make dict funs like $fx7ClsTy, which get bound to the real
+-- thing when we compile the mother module. Reason: we don't know exactly
+-- what the mother module will call it.
+
+mkDFunOcc info_str is_boot index
+ = mk_deriv VarName prefix string
+ where
+ prefix | is_boot = "$fx"
+ | otherwise = "$f"
+ string | opt_PprStyle_Debug = show index ++ info_str
+ | otherwise = show index
\end{code}
We used to add a '$m' to indicate a method, but that gives rise to bad
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}
\end{code}
\begin{code}
-decode_tuple :: Char -> EncodedString -> UserString
-decode_tuple d rest
- = go (digitToInt d) rest
- where
- go n (c : rest) | isDigit c = go (10*n + digitToInt c) rest
- go 0 ['T'] = "()"
- go n ['T'] = '(' : replicate (n-1) ',' ++ ")"
- go 1 ['H'] = "(# #)"
- go n ['H'] = '(' : '#' : replicate (n-1) ',' ++ "#)"
- go n other = pprPanic "decode_tuple" (ppr n <+> text other)
-
mkTupleOcc :: NameSpace -> Boxity -> Arity -> OccName
mkTupleOcc ns bx ar
= OccName ns (mkFastString ('Z' : (show ar ++ bx_char)))
projects / ghc-hetmet.git / blobdiff