Add builtin rule to eliminate unnecessary casts in seq

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

diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs
index ebe196b..2918875 100644 (file)
--- a/compiler/main/TidyPgm.lhs
+++ b/compiler/main/TidyPgm.lhs
@@ -16,8 +16,7 @@ import CoreSyn
 import CoreUnfold
 import CoreFVs
 import CoreTidy
 import CoreUnfold
 import CoreFVs
 import CoreTidy

-import PprCore
-import CoreLint
+import CoreMonad

 import CoreUtils
 import CoreArity       ( exprArity )
 import Class           ( classSelIds )
 import CoreUtils
 import CoreArity       ( exprArity )
 import Class           ( classSelIds )

@@ -29,7 +28,7 @@ import IdInfo
 import InstEnv
 import NewDemand
 import BasicTypes
 import InstEnv
 import NewDemand
 import BasicTypes

-import Name
+import Name hiding (varName)

 import NameSet
 import IfaceEnv
 import NameEnv
 import NameSet
 import IfaceEnv
 import NameEnv

@@ -50,8 +49,9 @@ import Data.IORef     ( IORef, readIORef, writeIORef )
 \end{code}
 
 
 \end{code}
 
 

-Constructing the TypeEnv, Instances, Rules from which the ModIface is
-constructed, and which goes on to subsequent modules in --make mode.
+Constructing the TypeEnv, Instances, Rules, VectInfo from which the
+ModIface is constructed, and which goes on to subsequent modules in
+--make mode.

 
 Most of the interface file is obtained simply by serialising the
 TypeEnv.  One important consequence is that if the *interface file*
 
 Most of the interface file is obtained simply by serialising the
 TypeEnv.  One important consequence is that if the *interface file*

@@ -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

@@ -292,26 +296,19 @@ tidyProgram hsc_env  (ModGuts { mg_module = mod, mg_exports = exports,
                                mg_hpc_info = hpc_info,
                                 mg_modBreaks = modBreaks })
 
                                mg_hpc_info = hpc_info,
                                 mg_modBreaks = modBreaks })
 

-  = do { let dflags = hsc_dflags hsc_env
-       ; showPass dflags "Tidy Core"
-
-       ; let { omit_prags = dopt Opt_OmitInterfacePragmas dflags
+  = do { let { dflags     = hsc_dflags hsc_env
+             ; omit_prags = dopt Opt_OmitInterfacePragmas dflags

              ; th         = dopt Opt_TemplateHaskell      dflags
               }
              ; th         = dopt Opt_TemplateHaskell      dflags
               }

+       ; showPass dflags "Tidy Core"
+
+       ; let { implicit_binds = getImplicitBinds type_env }

 
         ; (unfold_env, tidy_occ_env)
 
         ; (unfold_env, tidy_occ_env)

-              <- chooseExternalIds hsc_env type_env mod omit_prags binds
-
-        ; let { ext_rules 
-                  | omit_prags = []
-                  | otherwise  = findExternalRules binds imp_rules unfold_env
-               -- findExternalRules filters imp_rules to avoid binders that 
-               -- aren't externally visible; but the externally-visible binders 
-               -- are computed (by findExternalIds) assuming that all orphan
-               -- rules are exported (they get their Exported flag set in the desugarer)
-               -- So in fact we may export more than we need. 
-               -- (It's a sort of mutual recursion.)
-       }
+              <- chooseExternalIds hsc_env mod omit_prags binds implicit_binds imp_rules
+
+        ; let { ext_rules = findExternalRules omit_prags binds imp_rules unfold_env }
+               -- See Note [Which rules to expose]

 
        ; let { (tidy_env, tidy_binds)
                  = tidyTopBinds hsc_env unfold_env tidy_occ_env binds }
 
        ; let { (tidy_env, tidy_binds)
                  = tidyTopBinds hsc_env unfold_env tidy_occ_env binds }

@@ -333,18 +330,15 @@ tidyProgram hsc_env  (ModGuts { mg_module = mod, mg_exports = exports,
                -- and indeed it does, but if omit_prags is on, ext_rules is
                -- empty
 
                -- and indeed it does, but if omit_prags is on, ext_rules is
                -- empty
 

+              ; tidy_vect_info = tidyVectInfo tidy_env vect_info
+

              -- See Note [Injecting implicit bindings]
              -- See Note [Injecting implicit bindings]

-             ; implicit_binds = getImplicitBinds type_env

              ; all_tidy_binds = implicit_binds ++ tidy_binds
 
              ; alg_tycons = filter isAlgTyCon (typeEnvTyCons type_env)
              }
 
              ; all_tidy_binds = implicit_binds ++ tidy_binds
 
              ; alg_tycons = filter isAlgTyCon (typeEnvTyCons type_env)
              }
 

-       ; endPass dflags "Tidy Core" Opt_D_dump_simpl all_tidy_binds
-       ; dumpIfSet_core dflags Opt_D_dump_simpl
-               "Tidy Core Rules"
-               (pprRules tidy_rules)
-
+       ; endPass dflags "Tidy Core" Opt_D_dump_simpl all_tidy_binds tidy_rules

         ; let dir_imp_mods = moduleEnvKeys dir_imps
 
        ; return (CgGuts { cg_module   = mod, 
         ; let dir_imp_mods = moduleEnvKeys dir_imps
 
        ; return (CgGuts { cg_module   = mod, 

@@ -359,10 +353,9 @@ tidyProgram hsc_env  (ModGuts { mg_module = mod, mg_exports = exports,
                   ModDetails { md_types     = tidy_type_env,
                                md_rules     = tidy_rules,
                                md_insts     = tidy_insts,
                   ModDetails { md_types     = tidy_type_env,
                                md_rules     = tidy_rules,
                                md_insts     = tidy_insts,

-                               md_fam_insts = fam_insts,
+                                md_vect_info = tidy_vect_info,                                                  md_fam_insts = fam_insts,

                                md_exports   = exports,
                                md_exports   = exports,

-                               md_anns      = anns,     -- are already tidy
-                                md_vect_info = vect_info --
+                               md_anns      = anns      -- are already tidy

                               })
        }
 
                               })
        }
 

@@ -471,6 +464,29 @@ tidyInstances tidy_dfun ispecs
                 tidy_dfun (instanceDFunId ispec)
 \end{code}
 
                 tidy_dfun (instanceDFunId ispec)
 \end{code}
 

+\begin{code}
+tidyVectInfo :: TidyEnv -> VectInfo -> VectInfo
+tidyVectInfo (_, var_env) info@(VectInfo { vectInfoVar     = vars
+                                         , vectInfoPADFun  = pas
+                                         , vectInfoIso     = isos })
+  = info { vectInfoVar    = tidy_vars
+         , vectInfoPADFun = tidy_pas
+         , vectInfoIso    = tidy_isos }
+  where
+    tidy_vars = mkVarEnv
+              $ map tidy_var_mapping
+              $ varEnvElts vars
+
+    tidy_pas = mapNameEnv tidy_snd_var pas
+    tidy_isos = mapNameEnv tidy_snd_var isos
+
+    tidy_var_mapping (from, to) = (from', (from', lookup_var to))
+      where from' = lookup_var from
+    tidy_snd_var (x, var) = (x, lookup_var var)
+      
+    lookup_var var = lookupWithDefaultVarEnv var_env var var
+\end{code}
+

 
 %************************************************************************
 %*                                                                     *
 
 %************************************************************************
 %*                                                                     *

@@ -491,6 +507,11 @@ why CoreUnfold.mkImplicitUnfolding uses simleExprOpt to do a bit of
 optimisation first.  (Only matters when the selector is used curried;
 eg map x ys.)  See Trac #2070.
 
 optimisation first.  (Only matters when the selector is used curried;
 eg map x ys.)  See Trac #2070.
 

+[Oct 09: in fact, record selectors are no longer implicit Ids at all,
+because we really do want to optimise them properly. They are treated
+much like any other Id.  But doing "light" optimisation on an implicit
+Id still makes sense.]
+

 At one time I tried injecting the implicit bindings *early*, at the
 beginning of SimplCore.  But that gave rise to real difficulty,
 becuase GlobalIds are supposed to have *fixed* IdInfo, but the
 At one time I tried injecting the implicit bindings *early*, at the
 beginning of SimplCore.  But that gave rise to real difficulty,
 becuase GlobalIds are supposed to have *fixed* IdInfo, but the

@@ -501,18 +522,23 @@ importing modules were expecting it to have arity 1 (Trac #2844).
 It's much safer just to inject them right at the end, after tidying.
 
 Oh: two other reasons for injecting them late:
 It's much safer just to inject them right at the end, after tidying.
 
 Oh: two other reasons for injecting them late:

+

   - If implicit Ids are already in the bindings when we start TidyPgm,
     we'd have to be careful not to treat them as external Ids (in
     the sense of findExternalIds); else the Ids mentioned in *their*
     RHSs will be treated as external and you get an interface file 
     saying      a18 = <blah>
     but nothing refererring to a18 (because the implicit Id is the 
   - If implicit Ids are already in the bindings when we start TidyPgm,
     we'd have to be careful not to treat them as external Ids (in
     the sense of findExternalIds); else the Ids mentioned in *their*
     RHSs will be treated as external and you get an interface file 
     saying      a18 = <blah>
     but nothing refererring to a18 (because the implicit Id is the 

-    one that does).
+    one that does, and implicit Ids don't appear in interface files).

 
   - More seriously, the tidied type-envt will include the implicit
     Id replete with a18 in its unfolding; but we won't take account
     of a18 when computing a fingerprint for the class; result chaos.
     
 
   - More seriously, the tidied type-envt will include the implicit
     Id replete with a18 in its unfolding; but we won't take account
     of a18 when computing a fingerprint for the class; result chaos.
     

+There is one sort of implicit binding that is injected still later,
+namely those for data constructor workers. Reason (I think): it's
+really just a code generation trick.... binding itself makes no sense.
+See CorePrep Note [Data constructor workers].

 
 \begin{code}
 getImplicitBinds :: TypeEnv -> [CoreBind]
 
 \begin{code}
 getImplicitBinds :: TypeEnv -> [CoreBind]

@@ -538,54 +564,61 @@ Sete Note [choosing external names].
 
 \begin{code}
 type UnfoldEnv  = IdEnv (Name{-new name-}, Bool {-show unfolding-})
 
 \begin{code}
 type UnfoldEnv  = IdEnv (Name{-new name-}, Bool {-show unfolding-})

-  -- maps each top-level Id to its new Name (the Id is tidied in step 2)
-  -- The Unique is unchanged.  If the new Id is external, it will be
+  -- Maps each top-level Id to its new Name (the Id is tidied in step 2)
+  -- The Unique is unchanged.  If the new Name is external, it will be

   -- visible in the interface file.  
   --
   -- Bool => expose unfolding or not.
 
 chooseExternalIds :: HscEnv
   -- visible in the interface file.  
   --
   -- Bool => expose unfolding or not.
 
 chooseExternalIds :: HscEnv

-                  -> TypeEnv

                   -> Module
                   -> Bool
                  -> [CoreBind]
                   -> Module
                   -> Bool
                  -> [CoreBind]

+                  -> [CoreBind]
+                 -> [CoreRule]

                   -> IO (UnfoldEnv, TidyOccEnv)
        -- Step 1 from the notes above
 
                   -> IO (UnfoldEnv, TidyOccEnv)
        -- Step 1 from the notes above
 

-chooseExternalIds hsc_env type_env mod omit_prags binds 
-  = do
-    (unfold_env1,occ_env1) 
-        <- search (zip sorted_exports sorted_exports) emptyVarEnv init_occ_env
-    let internal_ids = filter (not . (`elemVarEnv` unfold_env1)) binders
-    tidy_internal internal_ids unfold_env1 occ_env1
+chooseExternalIds hsc_env mod omit_prags binds implicit_binds imp_id_rules
+  = do { (unfold_env1,occ_env1) <- search init_work_list emptyVarEnv init_occ_env
+       ; let internal_ids = filter (not . (`elemVarEnv` unfold_env1)) binders
+       ; tidy_internal internal_ids unfold_env1 occ_env1 }

  where
   nc_var = hsc_NC hsc_env 
 
  where
   nc_var = hsc_NC hsc_env 
 

-  -- the exports, sorted by OccName.  This is a deterministic list of
-  -- Ids (i.e. it's the same list every time this module is compiled),
-  -- in contrast to the bindings, which are ordered
-  -- non-deterministically.
-  --
-  -- This list will serve as a starting point for finding a
+  -- init_ext_ids is the intial list of Ids that should be
+  -- externalised.  It serves as the starting point for finding a

   -- deterministic, tidy, renaming for all external Ids in this
   -- module.
   -- deterministic, tidy, renaming for all external Ids in this
   -- module.

-  sorted_exports = sortBy (compare `on` getOccName) $
-                     filter isExportedId binders
-
-  binders = bindersOfBinds binds
-
-  bind_env :: IdEnv CoreExpr
-  bind_env = mkVarEnv (flattenBinds binds)
-
-  avoids   = [getOccName name | bndr <- typeEnvIds type_env,
+  -- 
+  -- It is sorted, so that it has adeterministic order (i.e. it's the
+  -- same list every time this module is compiled), in contrast to the
+  -- bindings, which are ordered non-deterministically.
+  init_work_list = zip init_ext_ids init_ext_ids
+  init_ext_ids   = sortBy (compare `on` getOccName) $
+                   filter is_external binders
+
+  -- An Id should be external if either (a) it is exported or
+  -- (b) it appears in the RHS of a local rule for an imported Id.   
+  -- See Note [Which rules to expose]
+  is_external id = isExportedId id || id `elemVarSet` rule_rhs_vars
+  rule_rhs_vars = foldr (unionVarSet . ruleRhsFreeVars) emptyVarSet imp_id_rules
+
+  binders          = bindersOfBinds binds
+  implicit_binders = bindersOfBinds implicit_binds
+  binder_set       = mkVarSet binders
+
+  avoids   = [getOccName name | bndr <- binders ++ implicit_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
                --                                      all by the renamer)
                -- since their names are "taken".
                -- The type environment is a convenient source of such things.
                -- In computing our "avoids" list, we must include
                --      all implicit Ids
                --      all things with global names (assigned once and for
                --                                      all by the renamer)
                -- since their names are "taken".
                -- The type environment is a convenient source of such things.

+                -- In particular, the set of binders doesn't include
+                -- implicit Ids at this stage.

 
        -- We also make sure to avoid any exported binders.  Consider
        --      f{-u1-} = 1     -- Local decl
 
        -- We also make sure to avoid any exported binders.  Consider
        --      f{-u1-} = 1     -- Local decl

@@ -598,25 +631,36 @@ chooseExternalIds hsc_env type_env mod omit_prags binds
   init_occ_env = initTidyOccEnv avoids
 
 
   init_occ_env = initTidyOccEnv avoids
 
 

-  search :: [(Id,Id)]    -- (external id, referrring id)
+  search :: [(Id,Id)]    -- The work-list: (external id, referrring id)
+                        -- Make a tidy, external Name for the external id,
+                         --   add it to the UnfoldEnv, and do the same for the
+                         --   transitive closure of Ids it refers to
+                        -- The referring id is used to generate a tidy
+                        ---  name for the external id

          -> UnfoldEnv    -- id -> (new Name, show_unfold)
          -> TidyOccEnv   -- occ env for choosing new Names
          -> IO (UnfoldEnv, TidyOccEnv)
 
   search [] unfold_env occ_env = return (unfold_env, occ_env)
 
          -> UnfoldEnv    -- id -> (new Name, show_unfold)
          -> TidyOccEnv   -- occ env for choosing new Names
          -> IO (UnfoldEnv, TidyOccEnv)
 
   search [] unfold_env occ_env = return (unfold_env, occ_env)
 

-  search ((id,referrer) : rest) unfold_env occ_env
-    | id `elemVarEnv` unfold_env = search rest unfold_env occ_env
+  search ((idocc,referrer) : rest) unfold_env occ_env
+    | idocc `elemVarEnv` unfold_env = search rest unfold_env occ_env

     | otherwise = do
     | otherwise = do

-      (occ_env', name') <- tidyTopName mod nc_var (Just referrer) occ_env id
+      (occ_env', name') <- tidyTopName mod nc_var (Just referrer) occ_env idocc

       let 
       let 

-          rhs = expectJust "chooseExternalIds" $ lookupVarEnv bind_env id

           (new_ids, show_unfold)
                 | omit_prags = ([], False)
           (new_ids, show_unfold)
                 | omit_prags = ([], False)

-                | otherwise  = addExternal id rhs
-          unfold_env' = extendVarEnv unfold_env id (name',show_unfold)
-          referrer' | isExportedId id = id
-                    | otherwise       = referrer
+                | otherwise  = addExternal refined_id
+
+               -- 'idocc' is an *occurrence*, but we need to see the
+               -- unfolding in the *definition*; so look up in binder_set
+          refined_id = case lookupVarSet binder_set idocc of
+                         Just id -> id
+                         Nothing -> WARN( True, ppr idocc ) idocc
+
+          unfold_env' = extendVarEnv unfold_env idocc (name',show_unfold)
+          referrer' | isExportedId refined_id = refined_id
+                    | otherwise               = referrer

       --
       search (zip new_ids (repeat referrer') ++ rest) unfold_env' occ_env'
 
       --
       search (zip new_ids (repeat referrer') ++ rest) unfold_env' occ_env'
 

@@ -628,44 +672,36 @@ chooseExternalIds hsc_env type_env mod omit_prags binds
       let unfold_env' = extendVarEnv unfold_env id (name',False)
       tidy_internal ids unfold_env' occ_env'
 
       let unfold_env' = extendVarEnv unfold_env id (name',False)
       tidy_internal ids unfold_env' occ_env'
 

-addExternal :: Id -> CoreExpr -> ([Id],Bool)
-addExternal id rhs = (new_needed_ids, show_unfold)
+addExternal :: Id -> ([Id],Bool)
+addExternal id = (new_needed_ids, show_unfold)

   where
     new_needed_ids = unfold_ids ++
   where
     new_needed_ids = unfold_ids ++

-                     filter (not . (`elemVarSet` unfold_set)) 
-                       (varSetElems worker_ids ++ 
-                        varSetElems spec_ids) -- XXX non-det ordering
+                     filter (\id -> isLocalId id &&
+                                    not (id `elemVarSet` unfold_set))
+                       (varSetElems spec_ids) -- XXX non-det ordering

 
     idinfo        = idInfo id
     dont_inline           = isNeverActive (inlinePragmaActivation (inlinePragInfo idinfo))
     loop_breaker   = isNonRuleLoopBreaker (occInfo idinfo)
     bottoming_fn   = isBottomingSig (newStrictnessInfo idinfo `orElse` topSig)
     spec_ids      = specInfoFreeVars (specInfo idinfo)
 
     idinfo        = idInfo id
     dont_inline           = isNeverActive (inlinePragmaActivation (inlinePragInfo idinfo))
     loop_breaker   = isNonRuleLoopBreaker (occInfo idinfo)
     bottoming_fn   = isBottomingSig (newStrictnessInfo idinfo `orElse` topSig)
     spec_ids      = specInfoFreeVars (specInfo idinfo)

-    worker_info           = workerInfo idinfo

 
        -- Stuff to do with the Id's unfolding
 
        -- Stuff to do with the Id's unfolding

-       -- The simplifier has put an up-to-date unfolding
-       -- in the IdInfo, but the RHS will do just as well
-    unfolding   = unfoldingInfo idinfo
-    rhs_is_small = not (neverUnfold unfolding)
-

        -- We leave the unfolding there even if there is a worker
        -- In GHCI the unfolding is used by importers
        -- We leave the unfolding there even if there is a worker
        -- In GHCI the unfolding is used by importers

-       -- When writing an interface file, we omit the unfolding 
-       -- if there is a worker
-    show_unfold = not bottoming_fn      &&     -- Not necessary
-                 not dont_inline        &&
-                 not loop_breaker       &&
-                 rhs_is_small                  -- Small enough
-
-    (unfold_set, unfold_ids)
-               | show_unfold = freeVarsInDepthFirstOrder rhs
-              | otherwise   = (emptyVarSet, [])
-
-    worker_ids = case worker_info of
-                  HasWorker work_id _ -> unitVarSet work_id
-                  _otherwise          -> emptyVarSet
-
+    show_unfold = isJust mb_unfold_ids
+    (unfold_set, unfold_ids) = mb_unfold_ids `orElse` (emptyVarSet, [])
+
+    mb_unfold_ids :: Maybe (IdSet, [Id])       -- Nothing => don't unfold
+    mb_unfold_ids = case unfoldingInfo idinfo of
+                     CoreUnfolding { uf_tmpl = unf_rhs, uf_guidance = guide } 
+                       | not bottoming_fn              -- Not necessary
+                       , not dont_inline        
+                       , not loop_breaker       
+                       , not (neverUnfoldGuidance guide)
+                       -> Just (exprFvsInOrder unf_rhs)
+                     DFunUnfolding _ ops -> Just (exprsFvsInOrder ops)
+                     _ -> Nothing

 
 -- We want a deterministic free-variable list.  exprFreeVars gives us
 -- a VarSet, which is in a non-deterministic order when converted to a
 
 -- We want a deterministic free-variable list.  exprFreeVars gives us
 -- a VarSet, which is in a non-deterministic order when converted to a

@@ -674,11 +710,15 @@ addExternal id rhs = (new_needed_ids, show_unfold)
 --
 -- Note [choosing external names]
 
 --
 -- Note [choosing external names]
 

-freeVarsInDepthFirstOrder :: CoreExpr -> (VarSet, [Id])
-freeVarsInDepthFirstOrder e = 
-  case dffvExpr e of
-    DFFV m -> case m emptyVarSet [] of
-                (set,ids,_) -> (set,ids)
+exprFvsInOrder :: CoreExpr -> (VarSet, [Id])
+exprFvsInOrder e = run (dffvExpr e)
+
+exprsFvsInOrder :: [CoreExpr] -> (VarSet, [Id])
+exprsFvsInOrder es = run (mapM_ dffvExpr es)
+
+run :: DFFV () -> (VarSet, [Id])
+run (DFFV m) = case m emptyVarSet [] of
+                 (set,ids,_) -> (set,ids)

 
 newtype DFFV a = DFFV (VarSet -> [Var] -> (VarSet,[Var],a))
 
 
 newtype DFFV a = DFFV (VarSet -> [Var] -> (VarSet,[Var],a))
 

@@ -764,7 +804,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

@@ -784,15 +838,17 @@ tidyTopName mod nc_var maybe_ref occ_env id
 \end{code}
 
 \begin{code}
 \end{code}
 
 \begin{code}

-findExternalRules :: [CoreBind]
-                 -> [CoreRule] -- Non-local rules (i.e. ones for imported fns)
+findExternalRules :: Bool      -- Omit pragmas
+                  -> [CoreBind]
+                 -> [CoreRule] -- Local rules for imported fns

                  -> UnfoldEnv  -- Ids that are exported, so we need their rules
                  -> [CoreRule]
   -- The complete rules are gotten by combining
                  -> UnfoldEnv  -- Ids that are exported, so we need their rules
                  -> [CoreRule]
   -- The complete rules are gotten by combining

-  --   a) the non-local rules
+  --   a) local rules for imported Ids

   --   b) rules embedded in the top-level Ids
   --   b) rules embedded in the top-level Ids

-findExternalRules binds non_local_rules unfold_env
-  = filter (not . internal_rule) (non_local_rules ++ local_rules)
+findExternalRules omit_prags binds imp_id_rules unfold_env
+  | omit_prags = []
+  | otherwise  = filterOut internal_rule (imp_id_rules ++ local_rules)

   where
     local_rules  = [ rule
                   | id <- bindersOfBinds binds,
   where
     local_rules  = [ rule
                   | id <- bindersOfBinds binds,

@@ -811,7 +867,14 @@ findExternalRules binds non_local_rules unfold_env
       | otherwise = False
 \end{code}
 
       | otherwise = False
 \end{code}
 

-
+Note [Which rules to expose]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+findExternalRules filters imp_rules to avoid binders that 
+aren't externally visible; but the externally-visible binders 
+are computed (by findExternalIds) assuming that all orphan
+rules are externalised (see init_ext_ids in function 
+'search'). So in fact we may export more than we need. 
+(It's a sort of mutual recursion.)

 
 %************************************************************************
 %*                                                                     *
 
 %************************************************************************
 %*                                                                     *

@@ -914,12 +977,24 @@ tidyTopPair show_unfold rhs_tidy_env caf_info name' (bndr, rhs)
     rhs'    = tidyExpr rhs_tidy_env rhs
     idinfo  = idInfo bndr
     idinfo' = tidyTopIdInfo (isExternalName name')
     rhs'    = tidyExpr rhs_tidy_env rhs
     idinfo  = idInfo bndr
     idinfo' = tidyTopIdInfo (isExternalName name')

-                           idinfo unfold_info worker_info
+                           idinfo unfold_info

                            arity caf_info
 
                            arity caf_info
 

-    unfold_info | show_unfold = mkTopUnfolding rhs'
+    unfold_info | show_unfold = tidyUnfolding rhs_tidy_env rhs' (unfoldingInfo idinfo)

                | otherwise   = noUnfolding
                | otherwise   = noUnfolding

-    worker_info = tidyWorker rhs_tidy_env show_unfold (workerInfo idinfo)
+    -- NB: do *not* expose the worker if show_unfold is off,
+    --     because that means this thing is a loop breaker or
+    --     marked NOINLINE or something like that
+    -- This is important: if you expose the worker for a loop-breaker
+    -- then you can make the simplifier go into an infinite loop, because
+    -- in effect the unfolding is exposed.  See Trac #1709
+    -- 
+    -- You might think that if show_unfold is False, then the thing should
+    -- not be w/w'd in the first place.  But a legitimate reason is this:
+    --           the function returns bottom
+    -- In this case, show_unfold will be false (we don't expose unfoldings
+    -- for bottoming functions), but we might still have a worker/wrapper
+    -- split (see Note [Worker-wrapper for bottoming functions] in WorkWrap.lhs

 
     -- Usually the Id will have an accurate arity on it, because
     -- the simplifier has just run, but not always. 
 
     -- Usually the Id will have an accurate arity on it, because
     -- the simplifier has just run, but not always. 

@@ -943,9 +1018,9 @@ tidyTopPair show_unfold rhs_tidy_env caf_info name' (bndr, rhs)
 --     unfoldings, which are inside Ids imported by GHCi. Ditto RULES.
 --     CoreToStg makes use of this when constructing SRTs.
 tidyTopIdInfo :: Bool -> IdInfo -> Unfolding
 --     unfoldings, which are inside Ids imported by GHCi. Ditto RULES.
 --     CoreToStg makes use of this when constructing SRTs.
 tidyTopIdInfo :: Bool -> IdInfo -> Unfolding

-              -> WorkerInfo -> ArityInfo -> CafInfo
+              -> ArityInfo -> CafInfo

               -> IdInfo
               -> IdInfo

-tidyTopIdInfo is_external idinfo unfold_info worker_info arity caf_info
+tidyTopIdInfo is_external idinfo unfold_info arity caf_info

   | not is_external    -- For internal Ids (not externally visible)
   = vanillaIdInfo      -- we only need enough info for code generation
                        -- Arity and strictness info are enough;
   | not is_external    -- For internal Ids (not externally visible)
   = vanillaIdInfo      -- we only need enough info for code generation
                        -- Arity and strictness info are enough;

@@ -961,32 +1036,26 @@ tidyTopIdInfo is_external idinfo unfold_info worker_info arity caf_info
        `setAllStrictnessInfo` newStrictnessInfo idinfo
        `setInlinePragInfo`    inlinePragInfo idinfo
        `setUnfoldingInfo`     unfold_info
        `setAllStrictnessInfo` newStrictnessInfo idinfo
        `setInlinePragInfo`    inlinePragInfo idinfo
        `setUnfoldingInfo`     unfold_info

-       `setWorkerInfo`        worker_info

                -- NB: we throw away the Rules
                -- They have already been extracted by findExternalRules
 
 
 
                -- NB: we throw away the Rules
                -- They have already been extracted by findExternalRules
 
 
 

-------------  Worker  --------------
-tidyWorker :: TidyEnv -> Bool -> WorkerInfo -> WorkerInfo
-tidyWorker _tidy_env _show_unfold NoWorker
-  = NoWorker
-tidyWorker tidy_env show_unfold (HasWorker work_id wrap_arity) 
-  | show_unfold = HasWorker (tidyVarOcc tidy_env work_id) wrap_arity
-  | otherwise   = NoWorker
-    -- NB: do *not* expose the worker if show_unfold is off,
-    --     because that means this thing is a loop breaker or
-    --     marked NOINLINE or something like that
-    -- This is important: if you expose the worker for a loop-breaker
-    -- then you can make the simplifier go into an infinite loop, because
-    -- in effect the unfolding is exposed.  See Trac #1709
-    -- 
-    -- You might think that if show_unfold is False, then the thing should
-    -- not be w/w'd in the first place.  But a legitimate reason is this:
-    --           the function returns bottom
-    -- In this case, show_unfold will be false (we don't expose unfoldings
-    -- for bottoming functions), but we might still have a worker/wrapper
-    -- split (see Note [Worker-wrapper for bottoming functions] in WorkWrap.lhs
+------------ Unfolding  --------------
+tidyUnfolding :: TidyEnv -> CoreExpr -> Unfolding -> Unfolding
+tidyUnfolding tidy_env _ unf@(CoreUnfolding { uf_tmpl = rhs 
+                                           , uf_guidance = guide@(InlineRule {}) })
+  = unf { uf_tmpl     = tidyExpr tidy_env rhs,            -- Preserves OccInfo
+         uf_guidance = guide { ug_ir_info = tidyInl tidy_env (ug_ir_info guide) } }
+tidyUnfolding tidy_env _ (DFunUnfolding con ids)
+  = DFunUnfolding con (map (tidyExpr tidy_env) ids)
+tidyUnfolding _ tidy_rhs (CoreUnfolding {})
+  = mkTopUnfolding tidy_rhs
+tidyUnfolding _ _ unf = unf
+
+tidyInl :: TidyEnv -> InlineRuleInfo -> InlineRuleInfo
+tidyInl tidy_env (InlWrapper w) = InlWrapper (tidyVarOcc tidy_env w)
+tidyInl _        inl_info       = inl_info

 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************