-
+%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
module OccName (
-- The NameSpace type; abstact
NameSpace, tcName, clsName, tcClsName, dataName, varName, ipName,
- tvName, uvName, nameSpaceString,
+ tvName, nameSpaceString,
-- The OccName type
OccName, -- Abstract, instance of Outputable
pprOccName,
- mkSrcOccFS, mkSysOcc, mkSysOccFS, mkCCallOcc, mkSrcVarOcc, mkKindOccFS,
+ mkOccFS, mkSysOcc, mkSysOccFS, mkCCallOcc, mkVarOcc, mkKindOccFS,
mkSuperDictSelOcc, mkDFunOcc, mkForeignExportOcc,
mkDictOcc, mkIPOcc, mkWorkerOcc, mkMethodOcc, mkDefaultMethodOcc,
mkDerivedTyConOcc, mkClassTyConOcc, mkClassDataConOcc, mkSpecOcc,
+ mkGenOcc1, mkGenOcc2,
- isSysOcc, isTvOcc, isUvOcc, isDataOcc, isDataSymOcc, isSymOcc, isIPOcc, isValOcc,
+ isSysOcc, isTvOcc, isDataOcc, isDataSymOcc, isSymOcc, isIPOcc, isValOcc,
occNameFS, occNameString, occNameUserString, occNameSpace, occNameFlavour,
setOccNameSpace,
#include "HsVersions.h"
-import Char ( isDigit, isAlpha, isUpper, isLower, ISALPHANUM, ord, chr, digitToInt, intToDigit )
+import Char ( isDigit, isUpper, isLower, ISALPHANUM, ord, chr, digitToInt )
import Util ( thenCmp )
import FiniteMap ( FiniteMap, emptyFM, lookupFM, addToFM, elemFM )
import Outputable
pprEncodedFS :: EncodedFS -> SDoc
pprEncodedFS fs
= getPprStyle $ \ sty ->
- if userStyle sty then
- let
- s = decode (_UNPK_ fs)
- c = head s
- in
- if startsVarSym c || startsConSym c then
- parens (text s)
- else
- text s
- else
- ptext fs
+ if userStyle sty
+ -- ptext (decodeFS fs) would needlessly pack the string again
+ then text (decode (_UNPK_ fs))
+ else ptext fs
\end{code}
%************************************************************************
| IPName -- Implicit Parameters
| DataName -- Data constructors
| TvName -- Type variables
- | UvName -- Usage variables
| TcClsName -- Type constructors and classes; Haskell has them
-- in the same name space for now.
deriving( Eq, Ord )
dataName = DataName
tvName = TvName
-uvName = UvName
varName = VarName
ipName = IPName
nameSpaceString VarName = "Variable"
nameSpaceString IPName = "Implicit Param"
nameSpaceString TvName = "Type variable"
-nameSpaceString UvName = "Usage variable"
nameSpaceString TcClsName = "Type constructor or class"
\end{code}
-- But then alreadyEncoded complains about the braces!
mkCCallOcc str = OccName varName (_PK_ str)
--- Kind constructors get a speical function. Uniquely, they are not encoded,
+-- 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.
*Source-code* things are encoded.
\begin{code}
-mkSrcOccFS :: NameSpace -> UserFS -> OccName
-mkSrcOccFS occ_sp fs = mkSysOccFS occ_sp (encodeFS fs)
+mkOccFS :: NameSpace -> UserFS -> OccName
+mkOccFS occ_sp fs = mkSysOccFS occ_sp (encodeFS fs)
-mkSrcVarOcc :: UserFS -> OccName
-mkSrcVarOcc fs = mkSysOccFS varName (encodeFS fs)
+mkVarOcc :: UserFS -> OccName
+mkVarOcc fs = mkSysOccFS varName (encodeFS fs)
\end{code}
\end{code}
\begin{code}
-isTvOcc, isDataSymOcc, isSymOcc, isUvOcc :: OccName -> Bool
+isTvOcc, isDataSymOcc, isSymOcc :: OccName -> Bool
isTvOcc (OccName TvName _) = True
isTvOcc other = False
-isUvOcc (OccName UvName _) = True
-isUvOcc other = False
-
isValOcc (OccName VarName _) = True
isValOcc (OccName DataName _) = True
isValOcc other = False
mkIPOcc = mk_simple_deriv varName "$i"
mkSpecOcc = mk_simple_deriv varName "$s"
mkForeignExportOcc = mk_simple_deriv varName "$f"
-
+mkGenOcc1 = mk_simple_deriv varName "$gfrom" -- Generics
+mkGenOcc2 = mk_simple_deriv varName "$gto" -- Generics
mk_simple_deriv sp px occ = mk_deriv sp px (occNameString occ)
* Most other printable characters translate to 'zx' or 'Zx' for some
alphabetic character x
-* The others translate as 'zxdd' where 'dd' is exactly two hexadecimal
- digits for the ord of the character
+* The others translate as 'znnnU' where 'nnn' is the decimal number
+ of the character
Before After
--------------------------
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 ' ' = 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 :: FAST_STRING -> Bool
encode_ch '*' = "zt"
encode_ch '_' = "zu"
encode_ch '%' = "zv"
-encode_ch c = ['z', 'x', intToDigit hi, intToDigit lo]
- where
- (hi,lo) = ord c `quotRem` 16
+encode_ch c = 'z' : shows (ord c) "U"
\end{code}
Decode is used for user printing.
decode_escape ('t' : rest) = '*' : decode rest
decode_escape ('u' : rest) = '_' : decode rest
decode_escape ('v' : rest) = '%' : decode rest
-decode_escape ('x' : d1 : d2 : rest) = chr (digitToInt d1 * 16 + digitToInt d2) : decode rest
-- Tuples are coded as Z23T
+-- Characters not having a specific code are coded as z224U
decode_escape (c : rest)
| isDigit c = go (digitToInt c) rest
where
go n (c : rest) | isDigit c = go (10*n + digitToInt c) rest
go n ('T' : rest) = '(' : replicate n ',' ++ ')' : decode rest
+ go n ('U' : rest) = chr n : decode rest
go n other = pprPanic "decode_escape" (ppr n <+> text (c:rest))
decode_escape (c : rest) = pprTrace "decode_escape" (char c) (decode rest)