[project @ 2002-03-18 15:23:05 by simonpj]

[ghc-hetmet.git] / ghc / compiler / coreSyn / CoreTidy.lhs

diff --git a/ghc/compiler/coreSyn/CoreTidy.lhs b/ghc/compiler/coreSyn/CoreTidy.lhs
index d22cc00..acc2c77 100644 (file)
--- a/ghc/compiler/coreSyn/CoreTidy.lhs
+++ b/ghc/compiler/coreSyn/CoreTidy.lhs
@@ -5,7 +5,7 @@
 
 \begin{code}
 module CoreTidy (
 
 \begin{code}
 module CoreTidy (

-       tidyCorePgm, tidyExpr, tidyCoreExpr,
+       tidyCorePgm, tidyExpr, tidyCoreExpr, tidyIdRules,

        tidyBndr, tidyBndrs
     ) where
 
        tidyBndr, tidyBndrs
     ) where
 

@@ -14,38 +14,42 @@ module CoreTidy (
 import CmdLineOpts     ( DynFlags, DynFlag(..), opt_OmitInterfacePragmas )
 import CoreSyn
 import CoreUnfold      ( noUnfolding, mkTopUnfolding, okToUnfoldInHiFile )
 import CmdLineOpts     ( DynFlags, DynFlag(..), opt_OmitInterfacePragmas )
 import CoreSyn
 import CoreUnfold      ( noUnfolding, mkTopUnfolding, okToUnfoldInHiFile )

-import CoreFVs         ( ruleSomeFreeVars, exprSomeFreeVars, 
-                         ruleSomeLhsFreeVars )
+import CoreFVs         ( ruleLhsFreeIds, ruleRhsFreeVars, exprSomeFreeVars )
+import PprCore         ( pprIdRules )

 import CoreLint                ( showPass, endPass )
 import CoreLint                ( showPass, endPass )

+import CoreUtils       ( exprArity )

 import VarEnv
 import VarSet
 import VarEnv
 import VarSet

-import Var             ( Id, Var, varName )
-import Id              ( idType, idInfo, idName, isExportedId, 
-                         idSpecialisation, idUnique, 
-                         mkVanillaGlobal, isLocalId, isImplicitId,
-                         hasNoBinding, mkUserLocal
+import Var             ( Id, Var )
+import Id              ( idType, idInfo, idName, idCoreRules, 
+                         isExportedId, idUnique, mkVanillaGlobal, isLocalId, 
+                         isImplicitId, mkUserLocal, setIdInfo

                        ) 
 import IdInfo          {- loads of stuff -}
                        ) 
 import IdInfo          {- loads of stuff -}

-import Name            ( getOccName, nameOccName, globaliseName, setNameOcc, 
-                         localiseName, isGlobalName, isLocalName
+import NewDemand       ( isBottomingSig, topSig )
+import BasicTypes      ( isNeverActive )
+import Name            ( getOccName, nameOccName, mkInternalName, mkExternalName, 
+                         localiseName, isExternalName, nameSrcLoc

                        )
 import NameEnv         ( filterNameEnv )
 import OccName         ( TidyOccEnv, initTidyOccEnv, tidyOccName )
                        )
 import NameEnv         ( filterNameEnv )
 import OccName         ( TidyOccEnv, initTidyOccEnv, tidyOccName )

-import Type            ( tidyTopType, tidyType, tidyTyVar )
+import Type            ( tidyTopType, tidyType, tidyTyVarBndr )

 import Module          ( Module, moduleName )
 import HscTypes                ( PersistentCompilerState( pcs_PRS ), 
                          PersistentRenamerState( prsOrig ),
 import Module          ( Module, moduleName )
 import HscTypes                ( PersistentCompilerState( pcs_PRS ), 
                          PersistentRenamerState( prsOrig ),

-                         NameSupply( nsNames ), OrigNameCache,
-                         TypeEnv, extendTypeEnvList, 
+                         NameSupply( nsNames, nsUniqs ),
+                         TypeEnv, extendTypeEnvList, typeEnvIds,

                          ModDetails(..), TyThing(..)
                        )
 import FiniteMap       ( lookupFM, addToFM )
                          ModDetails(..), TyThing(..)
                        )
 import FiniteMap       ( lookupFM, addToFM )

-import Maybes          ( maybeToBool, orElse )
-import ErrUtils                ( showPass )
+import Maybes          ( orElse )
+import ErrUtils                ( showPass, dumpIfSet_core )

 import SrcLoc          ( noSrcLoc )
 import UniqFM          ( mapUFM )
 import SrcLoc          ( noSrcLoc )
 import UniqFM          ( mapUFM )

+import UniqSupply      ( splitUniqSupply, uniqFromSupply )

 import List            ( partition )
 import Util            ( mapAccumL )
 import List            ( partition )
 import Util            ( mapAccumL )

+import Maybe           ( isJust )

 import Outputable
 \end{code}
 
 import Outputable
 \end{code}
 

@@ -77,21 +81,32 @@ IdEnv Bool
 
 Step 2: Tidy the program
 ~~~~~~~~~~~~~~~~~~~~~~~~
 
 Step 2: Tidy the program
 ~~~~~~~~~~~~~~~~~~~~~~~~

-Next we traverse the bindings top to bottom.  For each top-level
+Next we traverse the bindings top to bottom.  For each *top-level*

 binder
 
 binder
 

-  - Make all external Ids have Global names and vice versa
+ 1. Make it into a GlobalId
+
+ 2. Give it a system-wide Unique.
+    [Even non-exported things need system-wide Uniques because the
+    byte-code generator builds a single Name->BCO symbol table.]
+
+    We use the NameSupply kept in the PersistentRenamerState as the
+    source of such system-wide uniques.
+
+    For external Ids, use the original-name cache in the NameSupply 
+    to ensure that the unique assigned is the same as the Id had 
+    in any previous compilation run.
+  
+ 3. If it's an external Id, make it have a global Name, otherwise
+    make it have a local Name.

     This is used by the code generator to decide whether
     to make the label externally visible
 
     This is used by the code generator to decide whether
     to make the label externally visible
 

-  - Give external ids a "tidy" occurrence name.  This means
+ 4. Give external Ids a "tidy" occurrence name.  This means

     we can print them in interface files without confusing 
     "x" (unique 5) with "x" (unique 10).
   
     we can print them in interface files without confusing 
     "x" (unique 5) with "x" (unique 10).
   

-  - Give external Ids the same Unique as they had before
-    if the name is in the renamer's name cache
-  
-  - Give the Id its UTTERLY FINAL IdInfo; in ptic, 
+ 5. Give it its UTTERLY FINAL IdInfo; in ptic, 

        * Its IdDetails becomes VanillaGlobal, reflecting the fact that
          from now on we regard it as a global, not local, Id
 
        * Its IdDetails becomes VanillaGlobal, reflecting the fact that
          from now on we regard it as a global, not local, Id
 

@@ -121,19 +136,47 @@ tidyCorePgm dflags mod pcs cg_info_env
 
        ; let ext_ids   = findExternalSet   binds_in orphans_in
        ; let ext_rules = findExternalRules binds_in orphans_in ext_ids
 
        ; let ext_ids   = findExternalSet   binds_in orphans_in
        ; let ext_rules = findExternalRules binds_in orphans_in ext_ids

+               -- findExternalRules filters ext_rules to avoid binders that 
+               -- aren't externally visible; but the externally-visible binders 
+               -- are computed (by findExternalSet) assuming that all orphan
+               -- rules are exported.  So in fact we may export more than we
+               -- need.  (It's a sort of mutual recursion.)

 
 

-       ; let ((orig_env', occ_env, subst_env), tidy_binds) 
+       -- We also make sure to avoid any exported binders.  Consider
+       --      f{-u1-} = 1     -- Local decl
+       --      ...
+       --      f{-u2-} = 2     -- Exported decl
+       --
+       -- The second exported decl must 'get' the name 'f', so we
+       -- have to put 'f' in the avoids list before we get to the first
+       -- decl.  tidyTopId then does a no-op on exported binders.
+       ; let   prs           = pcs_PRS pcs
+               orig_ns       = prsOrig prs
+
+               init_tidy_env = (orig_ns, initTidyOccEnv avoids, emptyVarEnv)
+               avoids        = [getOccName name | bndr <- typeEnvIds env_tc,
+                                                  let name = idName bndr,
+                                                  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.
+
+       ; let ((orig_ns', occ_env, subst_env), tidy_binds) 

                        = mapAccumL (tidyTopBind mod ext_ids cg_info_env) 
                                    init_tidy_env binds_in
 
                        = mapAccumL (tidyTopBind mod ext_ids cg_info_env) 
                                    init_tidy_env binds_in
 

-       ; let tidy_rules = tidyIdRules (occ_env,subst_env) ext_rules
+       ; let tidy_rules = tidyIdCoreRules (occ_env,subst_env) ext_rules

 
 

-       ; let prs' = prs { prsOrig = orig { nsNames = orig_env' } }
+       ; let prs' = prs { prsOrig = orig_ns' }

              pcs' = pcs { pcs_PRS = prs' }
 
              pcs' = pcs { pcs_PRS = prs' }
 

-       ; let final_ids  = [ id | bind <- tidy_binds
+       ; let final_ids  = [ id 
+                          | bind <- tidy_binds

                           , id <- bindersOf bind
                           , id <- bindersOf bind

-                          , isGlobalName (idName id)]
+                          , isExternalName (idName id)]

 
                -- Dfuns are local Ids that might have
                -- changed their unique during tidying
 
                -- Dfuns are local Ids that might have
                -- changed their unique during tidying

@@ -150,25 +193,12 @@ tidyCorePgm dflags mod pcs cg_info_env
                                          md_binds = tidy_binds }
 
        ; endPass dflags "Tidy Core" Opt_D_dump_simpl tidy_binds
                                          md_binds = tidy_binds }
 
        ; endPass dflags "Tidy Core" Opt_D_dump_simpl tidy_binds

+       ; dumpIfSet_core dflags Opt_D_dump_simpl
+               "Tidy Core Rules"
+               (pprIdRules tidy_rules)

 
        ; return (pcs', tidy_details)
        }
 
        ; return (pcs', tidy_details)
        }

-  where
-       -- We also make sure to avoid any exported binders.  Consider
-       --      f{-u1-} = 1     -- Local decl
-       --      ...
-       --      f{-u2-} = 2     -- Exported decl
-       --
-       -- The second exported decl must 'get' the name 'f', so we
-       -- have to put 'f' in the avoids list before we get to the first
-       -- decl.  tidyTopId then does a no-op on exported binders.
-    prs                     = pcs_PRS pcs
-    orig            = prsOrig prs
-    orig_env        = nsNames orig
-
-    init_tidy_env    = (orig_env, initTidyOccEnv avoids, emptyVarEnv)
-    avoids          = [getOccName bndr | bndr <- bindersOfBinds binds_in,
-                                         isGlobalName (idName bndr)]

 
 tidyCoreExpr :: CoreExpr -> IO CoreExpr
 tidyCoreExpr expr = return (tidyExpr emptyTidyEnv expr)
 
 tidyCoreExpr :: CoreExpr -> IO CoreExpr
 tidyCoreExpr expr = return (tidyExpr emptyTidyEnv expr)

@@ -205,9 +235,9 @@ mkFinalTypeEnv type_env final_ids
        -- in interface files, because they are needed by importing modules when
        -- using the compilation manager
 
        -- in interface files, because they are needed by importing modules when
        -- using the compilation manager
 

-       -- We keep constructor workers, because they won't appear
+       -- We keep implicit Ids, because they won't appear 

        -- in the bindings from which final_ids are derived!
        -- in the bindings from which final_ids are derived!

-    keep_it (AnId id) = hasNoBinding id        -- Remove all Ids except constructor workers
+    keep_it (AnId id) = isImplicitId id        -- Remove all Ids except implicit ones

     keep_it other     = True           -- Keep all TyCons and Classes
 \end{code}
 
     keep_it other     = True           -- Keep all TyCons and Classes
 \end{code}
 

@@ -222,29 +252,25 @@ findExternalRules :: [CoreBind]
 findExternalRules binds orphan_rules ext_ids
   | opt_OmitInterfacePragmas = []
   | otherwise
 findExternalRules binds orphan_rules ext_ids
   | opt_OmitInterfacePragmas = []
   | otherwise

-  = orphan_rules ++ local_rules
+  = filter needed_rule (orphan_rules ++ local_rules)

   where
   where

-    local_rules  = [ (id, rule)
+    local_rules  = [ rule

                   | id <- bindersOfBinds binds,
                     id `elemVarEnv` ext_ids,
                   | id <- bindersOfBinds binds,
                     id `elemVarEnv` ext_ids,

-                    rule <- rulesRules (idSpecialisation id),
-                    not (isBuiltinRule rule),
-                       -- We can't print builtin rules in interface files
-                       -- Since they are built in, an importing module
-                       -- will have access to them anyway
-
-                       -- Sept 00: I've disabled this test.  It doesn't stop 
-                       -- many, if any, rules from coming out, and to make it
-                       -- work properly we need to add ????
-                       --      (put it back in for now)
-                    isEmptyVarSet (ruleSomeLhsFreeVars (isLocalName . varName) rule)
-
-                               -- Spit out a rule only if none of its LHS free
-                               -- vars are LocalName things i.e. things that
-                               -- aren't visible to importing modules This is a
-                               -- good reason not to do it when we emit the Id
-                               -- itself
-                ]
+                    rule <- idCoreRules id
+                  ]
+    needed_rule (id, rule)
+       =  not (isBuiltinRule rule)
+               -- We can't print builtin rules in interface files
+               -- Since they are built in, an importing module
+               -- will have access to them anyway
+
+       && not (any internal_id (varSetElems (ruleLhsFreeIds rule)))
+               -- Don't export a rule whose LHS mentions an Id that
+               -- is completely internal (i.e. not visible to an
+               -- importing module)
+
+    internal_id id = isLocalId id && not (id `elemVarEnv` ext_ids)

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

@@ -262,7 +288,7 @@ findExternalSet binds orphan_rules
   = foldr find init_needed binds
   where
     orphan_rule_ids :: IdSet
   = foldr find init_needed binds
   where
     orphan_rule_ids :: IdSet

-    orphan_rule_ids = unionVarSets [ ruleSomeFreeVars isLocalId rule 
+    orphan_rule_ids = unionVarSets [ ruleRhsFreeVars rule 

                                   | (_, rule) <- orphan_rules]
     init_needed :: IdEnv Bool
     init_needed = mapUFM (\_ -> False) orphan_rule_ids
                                   | (_, rule) <- orphan_rules]
     init_needed :: IdEnv Bool
     init_needed = mapUFM (\_ -> False) orphan_rule_ids

@@ -307,9 +333,9 @@ addExternal (id,rhs) needed
                                                spec_ids
 
     idinfo        = idInfo id
                                                spec_ids
 
     idinfo        = idInfo id

-    dont_inline           = isNeverInlinePrag (inlinePragInfo idinfo)
+    dont_inline           = isNeverActive (inlinePragInfo idinfo)

     loop_breaker   = isLoopBreaker (occInfo idinfo)
     loop_breaker   = isLoopBreaker (occInfo idinfo)

-    bottoming_fn   = isBottomingStrictness (strictnessInfo idinfo)
+    bottoming_fn   = isBottomingSig (newStrictnessInfo idinfo `orElse` topSig)

     spec_ids      = rulesRhsFreeVars (specInfo idinfo)
     worker_info           = workerInfo idinfo
 
     spec_ids      = rulesRhsFreeVars (specInfo idinfo)
     worker_info           = workerInfo idinfo
 

@@ -346,10 +372,11 @@ addExternal (id,rhs) needed
 
 
 \begin{code}
 
 
 \begin{code}

-type TopTidyEnv = (OrigNameCache, TidyOccEnv, VarEnv Var)
+type TopTidyEnv = (NameSupply, TidyOccEnv, VarEnv Var)

 
 -- TopTidyEnv: when tidying we need to know
 
 -- TopTidyEnv: when tidying we need to know

---   * orig_env: Any pre-ordained Names.  These may have arisen because the
+--   * ns: The NameSupply, containing a unique supply and any pre-ordained Names.  
+--       These may have arisen because the

 --       renamer read in an interface file mentioning M.$wf, say,
 --       and assigned it unique r77.  If, on this compilation, we've
 --       invented an Id whose name is $wf (but with a different unique)
 --       renamer read in an interface file mentioning M.$wf, say,
 --       and assigned it unique r77.  If, on this compilation, we've
 --       invented an Id whose name is $wf (but with a different unique)

@@ -375,7 +402,8 @@ tidyTopBind mod ext_ids cg_info_env top_tidy_env (NonRec bndr rhs)
   = ((orig,occ,subst) , NonRec bndr' rhs')
   where
     ((orig,occ,subst), bndr')
   = ((orig,occ,subst) , NonRec bndr' rhs')
   where
     ((orig,occ,subst), bndr')

-        = tidyTopBinder mod ext_ids cg_info_env rec_tidy_env rhs' top_tidy_env bndr
+        = tidyTopBinder mod ext_ids cg_info_env 
+                        rec_tidy_env rhs rhs' top_tidy_env bndr

     rec_tidy_env = (occ,subst)
     rhs' = tidyExpr rec_tidy_env rhs
 
     rec_tidy_env = (occ,subst)
     rhs' = tidyExpr rec_tidy_env rhs
 

@@ -389,35 +417,24 @@ tidyTopBind mod ext_ids cg_info_env top_tidy_env (Rec prs)
        = ((orig,occ,subst), (bndr',rhs'))
        where
        ((orig,occ,subst), bndr')
        = ((orig,occ,subst), (bndr',rhs'))
        where
        ((orig,occ,subst), bndr')

-          = tidyTopBinder mod ext_ids cg_info_env 
-               rec_tidy_env rhs' top_tidy_env bndr
+          = tidyTopBinder mod ext_ids cg_info_env
+               rec_tidy_env rhs rhs' top_tidy_env bndr

 
         rhs' = tidyExpr rec_tidy_env rhs
 
 
         rhs' = tidyExpr rec_tidy_env rhs
 

-       -- the CafInfo for a recursive group says whether *any* rhs in
-       -- the group may refer indirectly to a CAF (because then, they all do).
-    (bndrs, rhss) = unzip prs'
-    pred v = v `notElem` bndrs
-
-
-tidyTopBinder :: Module -> IdEnv Bool
-             -> CgInfoEnv
-             -> TidyEnv -> CoreExpr
-                       -- The TidyEnv is used to tidy the IdInfo
-                       -- The expr is the already-tided RHS
-                       -- Both are knot-tied: don't look at them!
+tidyTopBinder :: Module -> IdEnv Bool -> CgInfoEnv
+             -> TidyEnv        -- The TidyEnv is used to tidy the IdInfo
+             -> CoreExpr       -- RHS *before* tidying
+             -> CoreExpr       -- RHS *after* tidying
+                       -- The TidyEnv and the after-tidying RHS are
+                       -- both are knot-tied: don't look at them!

              -> TopTidyEnv -> Id -> (TopTidyEnv, Id)
   -- NB: tidyTopBinder doesn't affect the unique supply
 
              -> TopTidyEnv -> Id -> (TopTidyEnv, Id)
   -- NB: tidyTopBinder doesn't affect the unique supply
 

-tidyTopBinder mod ext_ids cg_info_env tidy_env rhs
-             env@(orig_env2, occ_env2, subst_env2) id
-
-  | isImplicitId id    -- Don't mess with constructors, 
-  = (env, id)          -- record selectors, and the like
-
-  | otherwise
+tidyTopBinder mod ext_ids cg_info_env rec_tidy_env rhs tidy_rhs
+             env@(ns2, occ_env2, subst_env2) id

        -- This function is the heart of Step 2
        -- This function is the heart of Step 2

-       -- The second env is the one to use for the IdInfo
+       -- The rec_tidy_env is the one to use for the IdInfo

        -- It's necessary because when we are dealing with a recursive
        -- group, a variable late in the group might be mentioned
        -- in the IdInfo of one early in the group
        -- It's necessary because when we are dealing with a recursive
        -- group, a variable late in the group might be mentioned
        -- in the IdInfo of one early in the group

@@ -426,77 +443,125 @@ tidyTopBinder mod ext_ids cg_info_env tidy_env rhs
        
   = ((orig_env', occ_env', subst_env'), id')
   where
        
   = ((orig_env', occ_env', subst_env'), id')
   where

-    (orig_env', occ_env', name') = tidyTopName mod orig_env2 occ_env2
+    (orig_env', occ_env', name') = tidyTopName mod ns2 occ_env2

                                               is_external
                                               (idName id)
                                               is_external
                                               (idName id)

-    ty'            = tidyTopType (idType id)
-    cg_info = lookupCgInfo cg_info_env name'
-    idinfo' = tidyIdInfo tidy_env is_external unfold_info cg_info id
+    ty'           = tidyTopType (idType id)
+    idinfo = tidyTopIdInfo rec_tidy_env is_external 
+                          (idInfo id) unfold_info arity
+                          (lookupCgInfo cg_info_env name')
+
+    id' = mkVanillaGlobal name' ty' idinfo

 
 

-    id'               = mkVanillaGlobal name' ty' idinfo'

     subst_env' = extendVarEnv subst_env2 id id'
 
     maybe_external = lookupVarEnv ext_ids id
     subst_env' = extendVarEnv subst_env2 id id'
 
     maybe_external = lookupVarEnv ext_ids id

-    is_external    = maybeToBool maybe_external
+    is_external    = isJust maybe_external

 
     -- Expose an unfolding if ext_ids tells us to
 
     -- Expose an unfolding if ext_ids tells us to

+    -- Remember that ext_ids maps an Id to a Bool: 
+    -- True to show the unfolding, False to hide it

     show_unfold = maybe_external `orElse` False
     show_unfold = maybe_external `orElse` False

-    unfold_info | show_unfold = mkTopUnfolding rhs
+    unfold_info | show_unfold = mkTopUnfolding tidy_rhs

                | otherwise   = noUnfolding
 
                | otherwise   = noUnfolding
 

+    -- Usually the Id will have an accurate arity on it, because
+    -- the simplifier has just run, but not always. 
+    -- One case I found was when the last thing the simplifier
+    -- did was to let-bind a non-atomic argument and then float
+    -- it to the top level. So it seems more robust just to
+    -- fix it here.
+    arity = exprArity rhs

 
 

-tidyIdInfo tidy_env is_external unfold_info cg_info id
-  | opt_OmitInterfacePragmas || not is_external
-       -- No IdInfo if the Id isn't external, or if we don't have -O
-  = vanillaIdInfo 
-       `setCgInfo`         cg_info
-       `setStrictnessInfo` strictnessInfo core_idinfo
-       -- Keep strictness; it's used by CorePrep

 
 

-  | otherwise
-  =  vanillaIdInfo 
-       `setCgInfo`         cg_info
-       `setCprInfo`        cprInfo core_idinfo
-       `setStrictnessInfo` strictnessInfo core_idinfo
-       `setInlinePragInfo` inlinePragInfo core_idinfo
-       `setUnfoldingInfo`  unfold_info
-       `setWorkerInfo`     tidyWorker tidy_env (workerInfo core_idinfo)
-       -- NB: we throw away the Rules
-       -- They have already been extracted by findExternalRules
-  where
-    core_idinfo = idInfo id

 
 

+-- tidyTopIdInfo creates the final IdInfo for top-level
+-- binders.  There are two delicate pieces:
+--
+--  * Arity.  After CoreTidy, this arity must not change any more.
+--     Indeed, CorePrep must eta expand where necessary to make
+--     the manifest arity equal to the claimed arity.
+--
+-- * CAF info, which comes from the CoreToStg pass via a knot.
+--     The CAF info will not be looked at by the downstream stuff:
+--     it *generates* it, and knot-ties it back.  It will only be
+--     looked at by (a) MkIface when generating an interface file
+--                  (b) In GHCi, importing modules
+--     Nevertheless, we add the info here so that it propagates to all
+--     occurrences of the binders in RHSs, and hence to occurrences in
+--     unfoldings, which are inside Ids imported by GHCi. Ditto RULES.
+--     
+--     An alterative would be to do a second pass over the unfoldings 
+--     of Ids, and rules, right at the top, but that would be a pain.
+
+tidyTopIdInfo tidy_env is_external idinfo unfold_info arity cg_info
+  | opt_OmitInterfacePragmas || not is_external
+       -- Only basic info if the Id isn't external, or if we don't have -O
+  = basic_info
+
+  | otherwise  -- Add extra optimisation info
+  = basic_info
+       `setInlinePragInfo`    inlinePragInfo idinfo
+       `setUnfoldingInfo`     unfold_info
+       `setWorkerInfo`        tidyWorker tidy_env (workerInfo idinfo)
+               -- NB: we throw away the Rules
+               -- They have already been extracted by findExternalRules
+  
+  where
+       -- baasic_info is attached to every top-level binder
+    basic_info = vanillaIdInfo 
+                       `setCgInfo`            cg_info
+                       `setArityInfo`         arity
+                       `setAllStrictnessInfo` newStrictnessInfo idinfo

 
 -- This is where we set names to local/global based on whether they really are 
 -- externally visible (see comment at the top of this module).  If the name
 -- was previously local, we have to give it a unique occurrence name if
 
 -- This is where we set names to local/global based on whether they really are 
 -- externally visible (see comment at the top of this module).  If the name
 -- was previously local, we have to give it a unique occurrence name if

--- we intend to globalise it.
-tidyTopName mod orig_env occ_env external name
-  | global && internal = (orig_env, occ_env, localiseName name)
-
-  | local  && internal = (orig_env, occ_env', setNameOcc name occ')
-       -- Even local, internal names must get a unique occurrence, because
-       -- if we do -split-objs we globalise the name later, n the code generator
+-- we intend to externalise it.
+tidyTopName mod ns occ_env external name
+  | global && internal = (ns, occ_env, localiseName name)

 
 

-  | global && external = (orig_env, occ_env, name)
+  | global && external = (ns, occ_env, name)

        -- Global names are assumed to have been allocated by the renamer,
        -- so they already have the "right" unique
        -- Global names are assumed to have been allocated by the renamer,
        -- so they already have the "right" unique

+       -- And it's a system-wide unique too
+
+  | local  && internal = (ns_w_local, occ_env', new_local_name)
+       -- Even local, internal names must get a unique occurrence, because
+       -- if we do -split-objs we externalise the name later, in the code generator
+       --
+       -- Similarly, we must make sure it has a system-wide Unique, because
+       -- the byte-code generator builds a system-wide Name->BCO symbol table

 
 

-  | local  && external = case lookupFM orig_env key of
-                          Just orig -> (orig_env,                         occ_env', orig)
-                          Nothing   -> (addToFM orig_env key global_name, occ_env', global_name)
-       -- If we want to globalise a currently-local name, check
+  | local  && external = case lookupFM ns_names key of
+                          Just orig -> (ns,          occ_env', orig)
+                          Nothing   -> (ns_w_global, occ_env', new_external_name)
+       -- If we want to externalise a currently-local name, check

        -- whether we have already assigned a unique for it.
        -- whether we have already assigned a unique for it.

-       -- If so, use it; if not, extend the table
+       -- If so, use it; if not, extend the table (ns_w_global).
+       -- This is needed when *re*-compiling a module in GHCi; we want to
+       -- use the same name for externally-visible things as we did before.

 
   where
 
   where

-    (occ_env', occ') = tidyOccName occ_env (nameOccName name)
-    key                     = (moduleName mod, occ')
-    global_name      = globaliseName (setNameOcc name occ') mod
-    global          = isGlobalName name
+    global          = isExternalName name

     local           = not global
     internal        = not external
 
     local           = not global
     internal        = not external
 

+    (occ_env', occ') = tidyOccName occ_env (nameOccName name)
+    key                     = (moduleName mod, occ')
+    ns_names        = nsNames ns
+    ns_uniqs        = nsUniqs ns
+    (us1, us2)      = splitUniqSupply ns_uniqs
+    uniq            = uniqFromSupply us1
+    loc                     = nameSrcLoc name
+
+    new_local_name     = mkInternalName  uniq     occ' loc
+    new_external_name  = mkExternalName uniq mod occ' loc  
+
+    ns_w_local      = ns { nsUniqs = us2 }
+    ns_w_global             = ns { nsUniqs = us2, nsNames = addToFM ns_names key new_external_name }
+
+

 ------------  Worker  --------------
 tidyWorker tidy_env (HasWorker work_id wrap_arity) 
   = HasWorker (tidyVarOcc tidy_env work_id) wrap_arity
 ------------  Worker  --------------
 tidyWorker tidy_env (HasWorker work_id wrap_arity) 
   = HasWorker (tidyVarOcc tidy_env work_id) wrap_arity

@@ -504,19 +569,22 @@ tidyWorker tidy_env other
   = NoWorker
 
 ------------  Rules  --------------
   = NoWorker
 
 ------------  Rules  --------------

-tidyIdRules :: TidyEnv -> [IdCoreRule] -> [IdCoreRule]
-tidyIdRules env [] = []
-tidyIdRules env ((fn,rule) : rules)
+tidyIdRules :: Id -> [IdCoreRule]
+tidyIdRules id = tidyIdCoreRules emptyTidyEnv (idCoreRules id)
+
+tidyIdCoreRules :: TidyEnv -> [IdCoreRule] -> [IdCoreRule]
+tidyIdCoreRules env [] = []
+tidyIdCoreRules env ((fn,rule) : rules)

   = tidyRule env rule                  =: \ rule ->
   = tidyRule env rule                  =: \ rule ->

-    tidyIdRules env rules      =: \ rules ->
+    tidyIdCoreRules env rules  =: \ rules ->

      ((tidyVarOcc env fn, rule) : rules)
 
 tidyRule :: TidyEnv -> CoreRule -> CoreRule
      ((tidyVarOcc env fn, rule) : rules)
 
 tidyRule :: TidyEnv -> CoreRule -> CoreRule

-tidyRule env rule@(BuiltinRule _) = rule
-tidyRule env (Rule name vars tpl_args rhs)
+tidyRule env rule@(BuiltinRule _ _) = rule
+tidyRule env (Rule name act vars tpl_args rhs)

   = tidyBndrs env vars                 =: \ (env', vars) ->
     map (tidyExpr env') tpl_args       =: \ tpl_args ->
   = tidyBndrs env vars                 =: \ (env', vars) ->
     map (tidyExpr env') tpl_args       =: \ tpl_args ->

-     (Rule name vars tpl_args (tidyExpr env' rhs))
+     (Rule name act vars tpl_args (tidyExpr env' rhs))

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

@@ -531,11 +599,11 @@ tidyBind :: TidyEnv
         ->  (TidyEnv, CoreBind)
 
 tidyBind env (NonRec bndr rhs)
         ->  (TidyEnv, CoreBind)
 
 tidyBind env (NonRec bndr rhs)

-  = tidyBndrWithRhs env (bndr,rhs) =: \ (env', bndr') ->
+  = tidyLetBndr env (bndr,rhs)         =: \ (env', bndr') ->

     (env', NonRec bndr' (tidyExpr env' rhs))
 
 tidyBind env (Rec prs)
     (env', NonRec bndr' (tidyExpr env' rhs))
 
 tidyBind env (Rec prs)

-  = mapAccumL tidyBndrWithRhs env prs  =: \ (env', bndrs') ->
+  = mapAccumL tidyLetBndr env prs      =: \ (env', bndrs') ->

     map (tidyExpr env') (map snd prs)  =: \ rhss' ->
     (env', Rec (zip bndrs' rhss'))
 
     map (tidyExpr env') (map snd prs)  =: \ rhss' ->
     (env', Rec (zip bndrs' rhss'))
 

@@ -582,32 +650,60 @@ tidyVarOcc (_, var_env) v = case lookupVarEnv var_env v of
 -- tidyBndr is used for lambda and case binders
 tidyBndr :: TidyEnv -> Var -> (TidyEnv, Var)
 tidyBndr env var
 -- tidyBndr is used for lambda and case binders
 tidyBndr :: TidyEnv -> Var -> (TidyEnv, Var)
 tidyBndr env var

-  | isTyVar var = tidyTyVar env var
-  | otherwise   = tidyId env var
+  | isTyVar var = tidyTyVarBndr env var
+  | otherwise   = tidyIdBndr env var

 
 tidyBndrs :: TidyEnv -> [Var] -> (TidyEnv, [Var])
 tidyBndrs env vars = mapAccumL tidyBndr env vars
 
 
 tidyBndrs :: TidyEnv -> [Var] -> (TidyEnv, [Var])
 tidyBndrs env vars = mapAccumL tidyBndr env vars
 

--- tidyBndrWithRhs is used for let binders
-tidyBndrWithRhs :: TidyEnv -> (Id, CoreExpr) -> (TidyEnv, Var)
-tidyBndrWithRhs env (id,rhs) = tidyId env id
-
-tidyId :: TidyEnv -> Id -> (TidyEnv, Id)
-tidyId env@(tidy_env, var_env) id
-  =    -- Non-top-level variables
+tidyLetBndr :: TidyEnv -> (Id, CoreExpr) -> (TidyEnv, Var)
+-- Used for local (non-top-level) let(rec)s
+tidyLetBndr env (id,rhs) 
+  = ((tidy_env,new_var_env), final_id)
+  where
+    ((tidy_env,var_env), new_id) = tidyIdBndr env id
+
+       -- We need to keep around any interesting strictness and demand info
+       -- because later on we may need to use it when converting to A-normal form.
+       -- eg.
+       --      f (g x),  where f is strict in its argument, will be converted
+       --      into  case (g x) of z -> f z  by CorePrep, but only if f still
+       --      has its strictness info.
+       --
+       -- Similarly for the demand info - on a let binder, this tells 
+       -- CorePrep to turn the let into a case.
+       --
+       -- Similarly arity info for eta expansion in CorePrep
+    final_id = new_id `setIdInfo` new_info
+    idinfo   = idInfo id
+    new_info = vanillaIdInfo 
+               `setArityInfo`          exprArity rhs
+               `setAllStrictnessInfo`  newStrictnessInfo idinfo
+               `setNewDemandInfo`      newDemandInfo idinfo
+
+    -- Override the env we get back from tidyId with the new IdInfo
+    -- so it gets propagated to the usage sites.
+    new_var_env = extendVarEnv var_env id final_id
+
+-- Non-top-level variables
+tidyIdBndr :: TidyEnv -> Id -> (TidyEnv, Id)
+tidyIdBndr env@(tidy_env, var_env) id
+  = -- do this pattern match strictly, otherwise we end up holding on to
+    -- stuff in the OccName.
+    case tidyOccName tidy_env (getOccName id) of { (tidy_env', occ') -> 

     let 
        -- Give the Id a fresh print-name, *and* rename its type
        -- The SrcLoc isn't important now, 
        -- though we could extract it from the Id
        -- 
     let 
        -- Give the Id a fresh print-name, *and* rename its type
        -- The SrcLoc isn't important now, 
        -- though we could extract it from the Id
        -- 

-       -- All local Ids now have the same IdInfo, which should save some
-       -- space.
-       (tidy_env', occ') = tidyOccName tidy_env (getOccName id)
-        ty'              = tidyType (tidy_env,var_env) (idType id)
+       -- All nested Ids now have the same IdInfo, namely none,
+       -- which should save some space.
+        ty'              = tidyType env (idType id)

        id'               = mkUserLocal occ' (idUnique id) ty' noSrcLoc
        var_env'          = extendVarEnv var_env id id'
     in
      ((tidy_env', var_env'), id')
        id'               = mkUserLocal occ' (idUnique id) ty' noSrcLoc
        var_env'          = extendVarEnv var_env id id'
     in
      ((tidy_env', var_env'), id')

+   }

 \end{code}
 
 \begin{code}
 \end{code}
 
 \begin{code}