From a3837710367a206fa63fe82ae0d269f424fd2dcf Mon Sep 17 00:00:00 2001
From: apt <unknown>
Date: Thu, 19 Jul 2001 15:33:17 +0000
Subject: [PATCH] [project @ 2001-07-19 15:33:17 by apt] external core: omit
 repn for recursive newtypes and fix char literals

---
 ghc/compiler/coreSyn/ExternalCore.lhs    |    2 +-
 ghc/compiler/coreSyn/MkExternalCore.lhs  |   25 +++++++++++++++----------
 ghc/compiler/coreSyn/PprExternalCore.lhs |   19 +++++++++----------
 3 files changed, 25 insertions(+), 21 deletions(-)

diff --git a/ghc/compiler/coreSyn/ExternalCore.lhs b/ghc/compiler/coreSyn/ExternalCore.lhs
index 4894deb..cadb639 100644
--- a/ghc/compiler/coreSyn/ExternalCore.lhs
+++ b/ghc/compiler/coreSyn/ExternalCore.lhs
@@ -12,7 +12,7 @@ data Module
 
 data Tdef 
   = Data Tcon [Tbind] [Cdef]
-  | Newtype Tcon [Tbind] Ty
+  | Newtype Tcon [Tbind] (Maybe Ty)
 
 data Cdef 
   = Constr Dcon [Tbind] [Ty]
diff --git a/ghc/compiler/coreSyn/MkExternalCore.lhs b/ghc/compiler/coreSyn/MkExternalCore.lhs
index b8e17cc..9b0a507 100644
--- a/ghc/compiler/coreSyn/MkExternalCore.lhs
+++ b/ghc/compiler/coreSyn/MkExternalCore.lhs
@@ -87,14 +87,16 @@ collect_exports tyenv (AvailTC n ns) (tcons,dcons,vars) =
 
 collect_tdefs :: TyCon -> [C.Tdef] -> [C.Tdef]
 collect_tdefs tcon tdefs 
-  | isAlgTyCon tcon = tdef : tdefs
+  | isAlgTyCon tcon = tdef: tdefs
   where
-    tdef | isNewTyCon tcon
-	 = C.Newtype (make_con_id (tyConName tcon)) (map make_tbind tyvars) (make_ty rep)
-	 | otherwise
-	 = C.Data (make_con_id (tyConName tcon)) (map make_tbind tyvars) (map make_cdef (tyConDataCons tcon)) 
-    (_, rep) = newTyConRep tcon
-    tyvars   = tyConTyVars tcon
+    tdef | isNewTyCon tcon = 
+                C.Newtype (make_con_id (tyConName tcon)) (map make_tbind tyvars) repclause 
+         | otherwise = 
+                C.Data (make_con_id (tyConName tcon)) (map make_tbind tyvars) (map make_cdef (tyConDataCons tcon)) 
+         where repclause | isRecursiveTyCon tcon = Nothing
+		         | otherwise = Just (make_ty rep)
+                                           where (_, rep) = newTyConRep tcon
+    tyvars = tyConTyVars tcon
 
 collect_tdefs _ tdefs = tdefs
 
@@ -151,7 +153,8 @@ make_alt (DEFAULT,[],e) = C.Adefault (make_exp e)
 make_lit :: Literal -> C.Lit
 make_lit l = 
   case l of
-    MachChar i -> C.Lchar (chr i) t
+    MachChar i | i <= 0xff -> C.Lchar (chr i) t
+    MachChar i | otherwise -> C.Lint (toEnum i) t
     MachStr s -> C.Lstring (_UNPK_ s) t
     MachAddr i -> C.Lint i t  
     MachInt i -> C.Lint i t
@@ -185,12 +188,14 @@ make_kind _ = error "MkExternalCore died: make_kind"
 
 {- Id generation. -}
 
-{- Use encoded strings, except restore non-leading '#'s.
+{- Use encoded strings, except restore '#'s.
    Also, adjust casing to work around some badly-chosen internal names. -}
 make_id :: Bool -> Name -> C.Id
 make_id is_var nm = 
   case n of
-    c:cs -> if isUpper c && is_var then (toLower c):(decode cs) else (decode n)
+    c:cs -> if isUpper c && is_var then (toLower c):(decode cs) 
+	    else if isLower c && (not is_var) then (toUpper c):(decode cs)
+            else decode n
   where n = (occNameString . nameOccName) nm
         decode ('z':'h':cs) = '#':(decode cs)
         decode (c:cs) = c:(decode cs)
diff --git a/ghc/compiler/coreSyn/PprExternalCore.lhs b/ghc/compiler/coreSyn/PprExternalCore.lhs
index 8ed16c5..c7e51e3 100644
--- a/ghc/compiler/coreSyn/PprExternalCore.lhs
+++ b/ghc/compiler/coreSyn/PprExternalCore.lhs
@@ -55,8 +55,11 @@ ptdef (Data tcon tbinds cdefs) =
   (text "%data" <+> pname tcon <+> (hsep (map ptbind tbinds)) <+> char '=')
   $$ indent (braces ((vcat (punctuate (char ';') (map pcdef cdefs)))))
 
-ptdef (Newtype tcon tbinds ty ) =
-  text "%newtype" <+> pname tcon <+> (hsep (map ptbind tbinds)) <+> char '=' <+> pty ty 
+ptdef (Newtype tcon tbinds rep ) =
+  text "%newtype" <+> pname tcon <+> (hsep (map ptbind tbinds)) <+> repclause
+       where repclause = case rep of
+                           Just ty -> char '=' <+> pty ty 
+			   Nothing -> empty
 
 pcdef (Constr dcon tbinds tys)  =
   (pname dcon) <+> (sep [hsep (map pattbind tbinds),sep (map paty tys)])
@@ -160,14 +163,10 @@ 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) = 
-	 '\\':'u':h3:h2:h1:h0:rest
-           where (q3,r3) = quotRem cv (16*16*16) 
-		 h3 = toUpper(intToDigit q3)
-		 (q2,r2) = quotRem r3 (16*16)
-                 h2 = toUpper(intToDigit q2)
-		 (q1,r1) = quotRem r2 16
-		 h1 = toUpper(intToDigit q1)
-                 h0 = toUpper(intToDigit r1)
+	 '\\':'x':h1:h0:rest
+           where (q1,r1) = quotRem cv 16
+		 h1 = intToDigit q1
+                 h0 = intToDigit r1
      f cv rest = (chr cv):rest
 
 \end{code}
-- 
1.7.10.4