-- 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,
+ mkOccName, mkOccFS, mkSysOcc, mkSysOccFS, mkFCallOcc, mkKindOccFS,
mkVarOcc, mkVarOccEncoded,
mkSuperDictSelOcc, mkDFunOcc, mkForeignExportOcc,
mkDictOcc, mkIPOcc, mkWorkerOcc, mkMethodOcc, mkDefaultMethodOcc,
mkGenOcc1, mkGenOcc2, mkLocalOcc, mkDataTOcc, mkDataCOcc,
mkDataConWrapperOcc, mkDataConWorkerOcc,
- isTvOcc, isTcOcc, isDataOcc, isDataSymOcc, isSymOcc, isValOcc,
- reportIfUnused,
+ isVarOcc, isTvOcc, isTcOcc, isDataOcc, isDataSymOcc, isSymOcc, isValOcc,
+ parenSymOcc, reportIfUnused,
occNameFS, occNameString, occNameUserString, occNameSpace,
occNameFlavour, briefOccNameFlavour,
%* *
\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)
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
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}
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)))