-
+%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
pprEncodedFS :: EncodedFS -> SDoc
pprEncodedFS fs
= getPprStyle $ \ sty ->
- if userStyle sty then
- text (decode (_UNPK_ fs))
- 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}
%************************************************************************
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
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
+ | otherwise = startsConId (_HEAD_ cs)
isLexVarId cs -- Ordinary prefix identifiers
| _NULL_ cs = False -- e.g. "x", "_x"
- | otherwise = isLower c || isLowerISO c || c == '_'
- where
- c = _HEAD_ cs
+ | otherwise = startsVarId (_HEAD_ cs)
isLexConSym cs -- Infix type or data constructors
| _NULL_ cs = False -- e.g. ":-:", ":", "->"
- | otherwise = c == ':'
- || cs == SLIT("->")
- where
- c = _HEAD_ cs
+ | cs == SLIT("->") = True
+ | otherwise = startsConSym (_HEAD_ cs)
isLexVarSym cs -- Infix identifiers
| _NULL_ cs = False -- e.g. "+"
- | otherwise = isSymbolASCII c
- || isSymbolISO c
- where
- c = _HEAD_ cs
+ | otherwise = startsVarSym (_HEAD_ 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'#