Naming changes in External Core

Two changes:
- Top-level bindings in a given module are now printed as a
  single %rec group. I found that in External Core generated from
  optimized code, nonrec bindings weren't being printed in
  dependency order. Rather than fixing that, I decided to not
  even pretend to preserve dependency order (since there's
  recursion between modules anyway.)

- Internal names are now printed with their uniques attached
  (otherwise, GHC was printing out code with shadowed bindings,
  and this isn't supposed to happen in External Core.)

diff --git a/compiler/coreSyn/MkExternalCore.lhs b/compiler/coreSyn/MkExternalCore.lhs
index 5ca4345..ba0c198 100644 (file)
--- a/compiler/coreSyn/MkExternalCore.lhs
+++ b/compiler/coreSyn/MkExternalCore.lhs
@@ -63,9 +63,18 @@ mkExternalCore :: CgGuts -> C.Module
 -- not been injected, so we have to add them manually here
 -- We don't include the strange data-con *workers* because they are
 -- implicit in the data type declaration itself
-mkExternalCore (CgGuts {cg_module=this_mod, cg_tycons = tycons, cg_binds = binds})
-  = (C.Module mname tdefs (runCoreM (mapM (make_vdef True) binds) 
-                            this_mod))
+mkExternalCore (CgGuts {cg_module=this_mod, cg_tycons = tycons, 
+                        cg_binds = binds})
+ -- Note that we flatten binds at the top level:
+ -- every module is just a single recursive bag of declarations.
+ -- Rationale: since modules can be mutually recursive, 
+ -- there's not much reason to preserve dependency info within a module.
+  = C.Module mname tdefs (case flattenBinds binds of
+                          -- check for empty list so we don't create an
+                          -- empty Rec group
+                            [] -> []
+                            bs  -> [(runCoreM (make_vdef True
+                                      (Rec bs)) this_mod)])
   where
     mname  = make_mid this_mod
     tdefs  = foldr collect_tdefs [] tycons
@@ -261,7 +270,9 @@ make_kind _ = error "MkExternalCore died: make_kind"
 {- Id generation. -}
 
 make_id :: Bool -> Name -> C.Id
-make_id _is_var nm = (occNameString . nameOccName) nm
+-- include uniques for internal names in order to avoid name shadowing
+make_id _is_var nm = ((occNameString . nameOccName) nm)
+  ++ (if isInternalName nm then (show . nameUnique) nm else "")
 
 make_var_id :: Name -> C.Id
 make_var_id = make_id True

diff --git a/compiler/coreSyn/PprExternalCore.lhs b/compiler/coreSyn/PprExternalCore.lhs
index ffa4675..fb4fc45 100644 (file)
--- a/compiler/coreSyn/PprExternalCore.lhs
+++ b/compiler/coreSyn/PprExternalCore.lhs
@@ -55,6 +55,7 @@ ptdef (Data tcon tbinds cdefs) =
   $$ indent (braces ((vcat (punctuate (char ';') (map pcdef cdefs)))))
 
 ptdef (Newtype tcon tbinds (coercion,tbs,k) rep) =
+-- TODO: I think this is kind of redundant now.
 -- Here we take apart the newtype tycon in order to get the newtype coercion,
 -- which needs to be represented in the External Core file because it's not
 -- straightforward to derive its definition from the newtype declaration alone.
@@ -107,7 +108,7 @@ paty (Tcon c) = pqname c
 paty t = parens (pty t)
 
 pbty (Tapp(Tapp(Tcon tc) t1) t2) | tc == tcArrow = parens(fsep [pbty t1, text "->",pty t2])
-pbty (Tapp t1 t2) = pappty t1 [t2] 
+pbty (Tapp t1 t2) = parens $ pappty t1 [t2] 
 pbty t = paty t
 
 pty (Tapp(Tapp(Tcon tc) t1) t2) | tc == tcArrow = fsep [pbty t1, text "->",pty t2]