Bug fix in the new HscMain code.

[ghc-hetmet.git] / ghc / compiler / coreSyn / PprExternalCore.lhs

diff --git a/ghc/compiler/coreSyn/PprExternalCore.lhs b/ghc/compiler/coreSyn/PprExternalCore.lhs
index dbcc86d..26c89cc 100644 (file)
--- a/ghc/compiler/coreSyn/PprExternalCore.lhs
+++ b/ghc/compiler/coreSyn/PprExternalCore.lhs
@@ -125,7 +125,6 @@ pappexp e as = fsep (paexp e : map pa as)
 
 pexp (Lam b e) = char '\\' <+> plamexp [b] e
 pexp (Let vd e) = (text "%let" <+> pvdefg vd) $$ (text "%in" <+> pexp e)
--- gaw 2004
 pexp (Case e vb ty alts) = sep [text "%case" <+> parens (paty ty) <+> paexp e,
                             text "%of" <+> pvbind vb]
                        $$ (indent (braces (vcat (punctuate (char ';') (map palt alts)))))
@@ -158,11 +157,17 @@ pstring s = doubleQuotes(text (escape s))
 
 escape s = foldr f [] (map ord s)
     where 
-     f cv rest | (cv < 0x20 || cv > 0x7e || cv == 0x22 || cv == 0x27 || cv == 0x5c) = 
+     f cv rest
+       | cv > 0xFF = '\\':'x':hs ++ rest
+       | (cv < 0x20 || cv > 0x7e || cv == 0x22 || cv == 0x27 || cv == 0x5c) = 
         '\\':'x':h1:h0:rest
            where (q1,r1) = quotRem cv 16
                 h1 = intToDigit q1
                  h0 = intToDigit r1
+                hs = dropWhile (=='0') $ reverse $ mkHex cv
+                mkHex 0 = ""
+                mkHex cv = intToDigit r : mkHex q
+                   where (q,r) = quotRem cv 16
      f cv rest = (chr cv):rest
 
 \end{code}