From 4fa65a12c1e4c4bcfd92ff30440a9e75d298e0b7 Mon Sep 17 00:00:00 2001
From: Simon Marlow <marlowsd@gmail.com>
Date: Tue, 28 Jul 2009 10:04:34 +0000
Subject: [PATCH] Be a bit more sensible about choosing external OccNames

Instead of chr_$wchr, we now just get $wchr.  In general, when an
OccName is system-generated, we leave it out of the final external
name, preferring to use the name of the exported parent instead (which
is necessarily a user-written name).

Names should be no less deterministic, but should be shorter and more
readable.
---
 compiler/main/TidyPgm.lhs |   25 +++++++++++++++++++------
 1 file changed, 19 insertions(+), 6 deletions(-)

diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs
index 2a068d9..b0fb7d3 100644
--- a/compiler/main/TidyPgm.lhs
+++ b/compiler/main/TidyPgm.lhs
@@ -304,7 +304,7 @@ tidyProgram hsc_env  (ModGuts { mg_module = mod, mg_exports = exports,
               }
 
         ; (unfold_env, tidy_occ_env)
-              <- chooseExternalIds hsc_env type_env mod omit_prags binds
+              <- chooseExternalIds hsc_env mod omit_prags binds
 
         ; let { ext_rules 
 		   | omit_prags = []
@@ -549,14 +549,13 @@ type UnfoldEnv  = IdEnv (Name{-new name-}, Bool {-show unfolding-})
   -- Bool => expose unfolding or not.
 
 chooseExternalIds :: HscEnv
-                  -> TypeEnv
                   -> Module
                   -> Bool
 		  -> [CoreBind]
                   -> IO (UnfoldEnv, TidyOccEnv)
 	-- Step 1 from the notes above
 
-chooseExternalIds hsc_env type_env mod omit_prags binds 
+chooseExternalIds hsc_env mod omit_prags binds
   = do
     (unfold_env1,occ_env1) 
         <- search (zip sorted_exports sorted_exports) emptyVarEnv init_occ_env
@@ -581,9 +580,9 @@ chooseExternalIds hsc_env type_env mod omit_prags binds
   bind_env :: IdEnv CoreExpr
   bind_env = mkVarEnv (flattenBinds binds)
 
-  avoids   = [getOccName name | bndr <- typeEnvIds type_env,
+  avoids   = [getOccName name | bndr <- binders,
                                 let name = idName bndr,
-                                isExternalName name]
+                                isExternalName name ]
 		-- In computing our "avoids" list, we must include
 		--	all implicit Ids
 		--	all things with global names (assigned once and for
@@ -768,7 +767,21 @@ tidyTopName mod nc_var maybe_ref occ_env id
     new_occ
       | Just ref <- maybe_ref, ref /= id = 
           mkOccName (occNameSpace old_occ) $
-             occNameString (getOccName ref) ++ '_' : occNameString old_occ
+             let
+                 ref_str = occNameString (getOccName ref)
+                 occ_str = occNameString old_occ
+             in
+             case occ_str of
+               '$':'w':_ -> occ_str
+                  -- workers: the worker for a function already
+                  -- includes the occname for its parent, so there's
+                  -- no need to prepend the referrer.
+               _other | isSystemName name -> ref_str
+                      | otherwise         -> ref_str ++ '_' : occ_str
+                  -- If this name was system-generated, then don't bother
+                  -- to retain its OccName, just use the referrer.  These
+                  -- system-generated names will become "f1", "f2", etc. for
+                  -- a referrer "f".
       | otherwise = old_occ
 
     (occ_env', occ') = tidyOccName occ_env new_occ
-- 
1.7.10.4