[project @ 2000-09-06 10:23:52 by simonmar]

[ghc-hetmet.git] / ghc / compiler / basicTypes / OccName.lhs

diff --git a/ghc/compiler/basicTypes/OccName.lhs b/ghc/compiler/basicTypes/OccName.lhs
index 98eb7c1..5eb623b 100644 (file)
--- a/ghc/compiler/basicTypes/OccName.lhs
+++ b/ghc/compiler/basicTypes/OccName.lhs
@@ -1,4 +1,4 @@
-
+%
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
 
@@ -39,7 +39,7 @@ module OccName (
 
 #include "HsVersions.h"
 
-import Char    ( isDigit, isAlpha, isUpper, isLower, ISALPHANUM, ord, chr, digitToInt, intToDigit )
+import Char    ( isDigit, isAlpha, isUpper, isLower, ISALPHANUM, ord, chr, digitToInt )
 import Util    ( thenCmp )
 import FiniteMap ( FiniteMap, emptyFM, lookupFM, addToFM, elemFM )
 import Outputable
@@ -68,17 +68,10 @@ type EncodedString = String -- Encoded form
 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}
 
 %************************************************************************
@@ -445,8 +438,8 @@ The basic encoding scheme is this.
 * 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
        --------------------------
@@ -470,10 +463,11 @@ The basic encoding scheme is this.
 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
@@ -538,9 +532,7 @@ encode_ch '/'  = "zs"
 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.
@@ -583,14 +575,15 @@ decode_escape ('s' : rest) = '/' : decode rest
 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)