foldOccSet, isEmptyOccSet, intersectOccSet, intersectsOccSet,
mkOccName, mkOccFS, mkSysOcc, mkSysOccFS, mkFCallOcc, mkKindOccFS,
- mkVarOcc, mkVarOccEncoded,
+ mkVarOcc, mkVarOccEncoded, mkTyVarOcc,
mkSuperDictSelOcc, mkDFunOcc, mkForeignExportOcc,
mkDictOcc, mkIPOcc, mkWorkerOcc, mkMethodOcc, mkDefaultMethodOcc,
mkDerivedTyConOcc, mkClassTyConOcc, mkClassDataConOcc, mkSpecOcc,
mkDataConWrapperOcc, mkDataConWorkerOcc,
isVarOcc, isTvOcc, isTcOcc, isDataOcc, isDataSymOcc, isSymOcc, isValOcc,
- reportIfUnused,
+ parenSymOcc, reportIfUnused,
occNameFS, occNameString, occNameUserString, occNameSpace,
occNameFlavour, briefOccNameFlavour,
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
\begin{code}
data OccName = OccName
- NameSpace
- EncodedFS
- {-! derive : Binary !-}
+ { occNameSpace :: NameSpace
+ , occNameFS :: EncodedFS
+ }
\end{code}
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}
%************************************************************************
\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) = ""
+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
-- 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