Make -dynamic a proper way, so we read the .dyn_hi files

[ghc-hetmet.git] / compiler / main / TidyPgm.lhs

diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs
index ebe196b..d198a3f 100644 (file)
--- a/compiler/main/TidyPgm.lhs
+++ b/compiler/main/TidyPgm.lhs
@@ -207,6 +207,10 @@ Step 1: Figure out external Ids
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Note [choosing external names]
 
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Note [choosing external names]
 

+See also the section "Interface stability" in the
+RecompilationAvoidance commentary:
+  http://hackage.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance
+

 First we figure out which Ids are "external" Ids.  An
 "external" Id is one that is visible from outside the compilation
 unit.  These are
 First we figure out which Ids are "external" Ids.  An
 "external" Id is one that is visible from outside the compilation
 unit.  These are

@@ -300,7 +304,7 @@ tidyProgram hsc_env  (ModGuts { mg_module = mod, mg_exports = exports,
               }
 
         ; (unfold_env, tidy_occ_env)
               }
 
         ; (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 = []
 
         ; let { ext_rules 
                   | omit_prags = []

@@ -545,14 +549,13 @@ type UnfoldEnv  = IdEnv (Name{-new name-}, Bool {-show unfolding-})
   -- Bool => expose unfolding or not.
 
 chooseExternalIds :: HscEnv
   -- Bool => expose unfolding or not.
 
 chooseExternalIds :: HscEnv

-                  -> TypeEnv

                   -> Module
                   -> Bool
                  -> [CoreBind]
                   -> IO (UnfoldEnv, TidyOccEnv)
        -- Step 1 from the notes above
 
                   -> 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
   = do
     (unfold_env1,occ_env1) 
         <- search (zip sorted_exports sorted_exports) emptyVarEnv init_occ_env

@@ -577,9 +580,9 @@ chooseExternalIds hsc_env type_env mod omit_prags binds
   bind_env :: IdEnv CoreExpr
   bind_env = mkVarEnv (flattenBinds 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,
                                 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
                -- In computing our "avoids" list, we must include
                --      all implicit Ids
                --      all things with global names (assigned once and for

@@ -610,7 +613,7 @@ chooseExternalIds hsc_env type_env mod omit_prags binds
     | otherwise = do
       (occ_env', name') <- tidyTopName mod nc_var (Just referrer) occ_env id
       let 
     | otherwise = do
       (occ_env', name') <- tidyTopName mod nc_var (Just referrer) occ_env id
       let 

-          rhs = expectJust "chooseExternalIds" $ lookupVarEnv bind_env id
+          rhs = expectJust (showSDoc (text "chooseExternalIds: " <> ppr id)) $ lookupVarEnv bind_env id

           (new_ids, show_unfold)
                 | omit_prags = ([], False)
                 | otherwise  = addExternal id rhs
           (new_ids, show_unfold)
                 | omit_prags = ([], False)
                 | otherwise  = addExternal id rhs

@@ -632,7 +635,8 @@ addExternal :: Id -> CoreExpr -> ([Id],Bool)
 addExternal id rhs = (new_needed_ids, show_unfold)
   where
     new_needed_ids = unfold_ids ++
 addExternal id rhs = (new_needed_ids, show_unfold)
   where
     new_needed_ids = unfold_ids ++

-                     filter (not . (`elemVarSet` unfold_set)) 
+                     filter (\id -> isLocalId id &&
+                                    not (id `elemVarSet` unfold_set))

                        (varSetElems worker_ids ++ 
                         varSetElems spec_ids) -- XXX non-det ordering
 
                        (varSetElems worker_ids ++ 
                         varSetElems spec_ids) -- XXX non-det ordering
 

@@ -764,7 +768,21 @@ tidyTopName mod nc_var maybe_ref occ_env id
     new_occ
       | Just ref <- maybe_ref, ref /= id = 
           mkOccName (occNameSpace old_occ) $
     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
       | otherwise = old_occ
 
     (occ_env', occ') = tidyOccName occ_env new_occ