[project @ 2001-10-24 14:17:29 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 2eb70e1..b3010f8 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, 
+       tidyCorePgm, tidyExpr, tidyCoreExpr,

        tidyBndr, tidyBndrs
     ) where
 
        tidyBndr, tidyBndrs
     ) where
 

@@ -14,41 +14,44 @@ 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 CoreUtils       ( exprArity )

 import CoreFVs         ( ruleSomeFreeVars, exprSomeFreeVars )
 import CoreFVs         ( ruleSomeFreeVars, exprSomeFreeVars )

+import PprCore         ( pprIdCoreRule )

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

+import CoreUtils       ( exprArity )

 import VarEnv
 import VarSet
 import Var             ( Id, Var )
 import VarEnv
 import VarSet
 import Var             ( Id, Var )

-import Id              ( idType, idInfo, idName, isExportedId,
-                         idCafInfo, mkId, isLocalId, isImplicitId,
-                         idFlavour, modifyIdInfo, idArity
+import Id              ( idType, idInfo, idName, isExportedId, 
+                         idSpecialisation, idUnique, 
+                         mkVanillaGlobal, isLocalId, 
+                         isImplicitId, mkUserLocal, setIdInfo

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

-import Name            ( getOccName, nameOccName, globaliseName, setNameOcc, 
-                         localiseName, mkLocalName, isGlobalName, isDllName
+import NewDemand       ( isBottomingSig, topSig )
+import BasicTypes      ( isNeverActive )
+import Name            ( getOccName, nameOccName, mkLocalName, mkGlobalName, 
+                         localiseName, isGlobalName, nameSrcLoc

                        )
                        )

+import NameEnv         ( filterNameEnv )

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

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

 import Module          ( Module, moduleName )
 import Module          ( Module, moduleName )

-import PrimOp          ( PrimOp(..), setCCallUnique )

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

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

                        )
                        )

-import UniqSupply
-import DataCon         ( DataCon, dataConName )
-import Literal         ( isLitLitLit )

 import FiniteMap       ( lookupFM, addToFM )
 import FiniteMap       ( lookupFM, addToFM )

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

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

-import Outputable
-import FastTypes
+import UniqSupply      ( splitUniqSupply, uniqFromSupply )

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

+import Maybe           ( isJust )
+import Outputable

 \end{code}
 
 
 \end{code}
 
 

@@ -79,30 +82,34 @@ 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
-  
-  - Clone all local Ids.  This means that Tidy Core has the property
-    that all Ids are unique, rather than the weaker guarantee of
-    no clashes which the simplifier provides.
-
-  - Give each dynamic CCall occurrence a fresh unique; this is
-    rather like the cloning step above.
-
-  - Give the Id its UTTERLY FINAL IdInfo; in ptic, 
-       * Its flavour becomes ConstantId, reflecting the fact that
-         from now on we regard it as a constant, not local, Id
+ 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 unfolding, if it should have one
        
 
        * its unfolding, if it should have one
        

@@ -118,30 +125,19 @@ RHSs, so that they print nicely in interfaces.
 \begin{code}
 tidyCorePgm :: DynFlags -> Module
            -> PersistentCompilerState
 \begin{code}
 tidyCorePgm :: DynFlags -> Module
            -> PersistentCompilerState

-           -> [CoreBind] -> [IdCoreRule]
-           -> IO (PersistentCompilerState, [CoreBind], [IdCoreRule])
-tidyCorePgm dflags mod pcs binds_in orphans_in
+           -> CgInfoEnv                -- Information from the back end,
+                                       -- to be splatted into the IdInfo
+           -> ModDetails
+           -> IO (PersistentCompilerState, ModDetails)
+
+tidyCorePgm dflags mod pcs cg_info_env
+           (ModDetails { md_types = env_tc, md_insts = insts_tc, 
+                         md_binds = binds_in, md_rules = orphans_in })

   = do { showPass dflags "Tidy Core"
 
   = do { showPass dflags "Tidy Core"
 

-       ; let ext_ids = findExternalSet binds_in orphans_in
-
-       ; us <- mkSplitUniqSupply 't' -- for "tidy"
-
-       ; let ((us1, orig_env', occ_env, subst_env), binds_out) 
-                       = mapAccumL (tidyTopBind mod ext_ids) 
-                                   (init_tidy_env us) binds_in
-
-       ; let (orphans_out, _) 
-                  = initUs us1 (tidyIdRules (occ_env,subst_env) orphans_in)
-
-       ; let prs' = prs { prsOrig = orig { nsNames = orig_env' } }
-             pcs' = pcs { pcs_PRS = prs' }
-
-       ; endPass dflags "Tidy Core" Opt_D_dump_simpl binds_out
+       ; let ext_ids   = findExternalSet   binds_in orphans_in
+       ; let ext_rules = findExternalRules binds_in orphans_in ext_ids

 
 

-       ; return (pcs', binds_out, orphans_out)
-       }
-  where

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

@@ -150,15 +146,120 @@ tidyCorePgm dflags mod pcs binds_in orphans_in
        -- 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.
        -- 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
+       ; 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,
+                                                  isGlobalName 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
+
+       ; let tidy_rules = tidyIdRules (occ_env,subst_env) ext_rules
+
+       ; let prs' = prs { prsOrig = orig_ns' }
+             pcs' = pcs { pcs_PRS = prs' }
+
+       ; let final_ids  = [ id 
+                          | bind <- tidy_binds
+                          , id <- bindersOf bind
+                          , isGlobalName (idName id)]
+
+               -- Dfuns are local Ids that might have
+               -- changed their unique during tidying
+       ; let lookup_dfun_id id = lookupVarEnv subst_env id `orElse` 
+                                 pprPanic "lookup_dfun_id" (ppr id)

 
 

-    init_tidy_env us = (us, orig_env, initTidyOccEnv avoids, emptyVarEnv)
-    avoids          = [getOccName bndr | bndr <- bindersOfBinds binds_in,
-                                      isGlobalName (idName bndr)]
+
+       ; let tidy_type_env = mkFinalTypeEnv env_tc final_ids
+             tidy_dfun_ids = map lookup_dfun_id insts_tc
+
+       ; let tidy_details = ModDetails { md_types = tidy_type_env,
+                                         md_rules = tidy_rules,
+                                         md_insts = tidy_dfun_ids,
+                                         md_binds = tidy_binds }
+
+       ; endPass dflags "Tidy Core" Opt_D_dump_simpl tidy_binds
+       ; dumpIfSet_core dflags Opt_D_dump_simpl
+               "Tidy Core Rules"
+               (vcat (map pprIdCoreRule tidy_rules))
+
+       ; return (pcs', tidy_details)
+       }
+
+tidyCoreExpr :: CoreExpr -> IO CoreExpr
+tidyCoreExpr expr = return (tidyExpr emptyTidyEnv expr)
+\end{code}
+
+
+%************************************************************************
+%*                                                                     *
+\subsection{Write a new interface file}
+%*                                                                     *
+%************************************************************************
+
+\begin{code}
+mkFinalTypeEnv :: TypeEnv      -- From typechecker
+              -> [Id]          -- Final Ids
+              -> TypeEnv
+
+mkFinalTypeEnv type_env final_ids
+  = extendTypeEnvList (filterNameEnv keep_it type_env)
+                     (map AnId final_ids)
+  where
+       -- The competed type environment is gotten from
+       --      a) keeping the types and classes
+       --      b) removing all Ids, 
+       --      c) adding Ids with correct IdInfo, including unfoldings,
+       --              gotten from the bindings
+       -- From (c) we keep only those Ids with Global names;
+       --          the CoreTidy pass makes sure these are all and only
+       --          the externally-accessible ones
+       -- This truncates the type environment to include only the 
+       -- exported Ids and things needed from them, which saves space
+       --
+       -- However, we do keep things like constructors, which should not appear 
+       -- in interface files, because they are needed by importing modules when
+       -- using the compilation manager
+
+       -- We keep implicit Ids, because they won't appear 
+       -- in the bindings from which final_ids are derived!
+    keep_it (AnId id) = isImplicitId id        -- Remove all Ids except implicit ones
+    keep_it other     = True           -- Keep all TyCons and Classes

 \end{code}
 
 \end{code}
 

+\begin{code}
+findExternalRules :: [CoreBind]
+                 -> [IdCoreRule] -- Orphan rules
+                 -> IdEnv a      -- Ids that are exported, so we need their rules
+                 -> [IdCoreRule]
+  -- The complete rules are gotten by combining
+  --   a) the orphan rules
+  --   b) rules embedded in the top-level Ids
+findExternalRules binds orphan_rules ext_ids
+  | opt_OmitInterfacePragmas = []
+  | otherwise
+  = orphan_rules ++ local_rules
+  where
+    local_rules  = [ (id, rule)
+                  | 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
+                ]
+\end{code}

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

@@ -168,13 +269,14 @@ tidyCorePgm dflags mod pcs binds_in orphans_in
 
 \begin{code}
 findExternalSet :: [CoreBind] -> [IdCoreRule]
 
 \begin{code}
 findExternalSet :: [CoreBind] -> [IdCoreRule]

-               -> IdEnv Bool   -- True <=> show unfolding
+               -> IdEnv Bool   -- In domain => external
+                               -- Range = True <=> show unfolding

        -- Step 1 from the notes above
 findExternalSet binds orphan_rules
   = foldr find init_needed binds
   where
     orphan_rule_ids :: IdSet
        -- Step 1 from the notes above
 findExternalSet binds orphan_rules
   = foldr find init_needed binds
   where
     orphan_rule_ids :: IdSet

-    orphan_rule_ids = unionVarSets [ ruleSomeFreeVars isIdAndLocal rule 
+    orphan_rule_ids = unionVarSets [ ruleSomeFreeVars isLocalId 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

@@ -202,8 +304,6 @@ findExternalSet binds orphan_rules
     need_id needed_set id       = id `elemVarEnv` needed_set || isExportedId id 
     need_pr needed_set (id,rhs)        = need_id needed_set id
 
     need_id needed_set id       = id `elemVarEnv` needed_set || isExportedId id 
     need_pr needed_set (id,rhs)        = need_id needed_set id
 

-isIdAndLocal id = isId id && isLocalId id
-

 addExternal :: (Id,CoreExpr) -> IdEnv Bool -> IdEnv Bool
 -- The Id is needed; extend the needed set
 -- with it and its dependents (free vars etc)
 addExternal :: (Id,CoreExpr) -> IdEnv Bool -> IdEnv Bool
 -- The Id is needed; extend the needed set
 -- with it and its dependents (free vars etc)

@@ -221,9 +321,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
 

@@ -243,7 +343,7 @@ addExternal (id,rhs) needed
                  rhs_is_small           &&     -- Small enough
                  okToUnfoldInHiFile rhs        -- No casms etc
 
                  rhs_is_small           &&     -- Small enough
                  okToUnfoldInHiFile rhs        -- No casms etc
 

-    unfold_ids | show_unfold = exprSomeFreeVars isIdAndLocal rhs
+    unfold_ids | show_unfold = exprSomeFreeVars isLocalId rhs

               | otherwise   = emptyVarSet
 
     worker_ids = case worker_info of
               | otherwise   = emptyVarSet
 
     worker_ids = case worker_info of

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

-type TopTidyEnv = (UniqSupply, 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)

@@ -274,9 +375,6 @@ type TopTidyEnv = (UniqSupply, OrigNameCache, TidyOccEnv, VarEnv Var)
 --     are 'used'
 --
 --   * subst_env: A Var->Var mapping that substitutes the new Var for the old
 --     are 'used'
 --
 --   * subst_env: A Var->Var mapping that substitutes the new Var for the old

---
---   * uniqsuppy: so we can clone any Ids with non-preordained names.
---

 \end{code}
 
 
 \end{code}
 
 

@@ -284,194 +382,194 @@ type TopTidyEnv = (UniqSupply, OrigNameCache, TidyOccEnv, VarEnv Var)
 tidyTopBind :: Module
            -> IdEnv Bool       -- Domain = Ids that should be external
                                -- True <=> their unfolding is external too
 tidyTopBind :: Module
            -> IdEnv Bool       -- Domain = Ids that should be external
                                -- True <=> their unfolding is external too

+           -> CgInfoEnv

            -> TopTidyEnv -> CoreBind
            -> (TopTidyEnv, CoreBind)
 
            -> TopTidyEnv -> CoreBind
            -> (TopTidyEnv, CoreBind)
 

-tidyTopBind mod ext_ids env (NonRec bndr rhs)
-  = ((us2,orig,occ,subst) , NonRec bndr' rhs')
+tidyTopBind mod ext_ids cg_info_env top_tidy_env (NonRec bndr rhs)
+  = ((orig,occ,subst) , NonRec bndr' rhs')

   where
   where

-    ((us1,orig,occ,subst), bndr')
-        = tidyTopBinder mod ext_ids tidy_env rhs' caf_info env bndr
-    tidy_env    = (occ,subst)
-    caf_info    = hasCafRefs (const True) rhs'
-    (rhs',us2)  = initUs us1 (tidyExpr tidy_env rhs)
+    ((orig,occ,subst), 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

 
 

-tidyTopBind mod ext_ids env (Rec prs)
+tidyTopBind mod ext_ids cg_info_env top_tidy_env (Rec prs)

   = (final_env, Rec prs')
   where
   = (final_env, Rec prs')
   where

-    (final_env@(_,_,occ,subst), prs') = mapAccumL do_one env prs
-    final_tidy_env = (occ,subst)
+    (final_env@(_,occ,subst), prs') = mapAccumL do_one top_tidy_env prs
+    rec_tidy_env = (occ,subst)

 
 

-    do_one env (bndr,rhs) 
-       = ((us',orig,occ,subst), (bndr',rhs'))
+    do_one top_tidy_env (bndr,rhs) 
+       = ((orig,occ,subst), (bndr',rhs'))

        where
        where

-       ((us,orig,occ,subst), bndr')
-          = tidyTopBinder mod ext_ids final_tidy_env rhs' caf_info env bndr
-        (rhs', us')   = initUs us (tidyExpr final_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'
-    caf_info = hasCafRefss pred rhss
-    pred v = v `notElem` bndrs
-
-
-tidyTopBinder :: Module -> IdEnv Bool
-             -> TidyEnv -> CoreExpr -> CafInfo
-                       -- The TidyEnv is used to tidy the IdInfo
-                       -- The expr is the already-tided RHS
-                       -- Both are knot-tied: don't look at them!
+       ((orig,occ,subst), bndr')
+          = tidyTopBinder mod ext_ids cg_info_env
+               rec_tidy_env rhs rhs' top_tidy_env bndr
+
+        rhs' = tidyExpr rec_tidy_env rhs
+
+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)
              -> TopTidyEnv -> Id -> (TopTidyEnv, Id)

+  -- NB: tidyTopBinder doesn't affect the unique supply

 
 

-tidyTopBinder mod ext_ids tidy_env rhs caf_info
-             env@(us, 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
 
        -- The rhs is already tidied
        
        -- 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
 
        -- The rhs is already tidied
        

-  = ((us_r, orig_env', occ_env', subst_env'), id')
+  = ((orig_env', occ_env', subst_env'), id')

   where
   where

-    (us_l, us_r)    = splitUniqSupply us
-
-    (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)
-    idinfo'         = tidyIdInfo us_l tidy_env
-                        is_external unfold_info arity_info caf_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'               = mkId 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
 

-    arity_info = exprArity rhs
+    -- 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 us tidy_env is_external unfold_info arity_info caf_info id
-  | opt_OmitInterfacePragmas || not is_external
-       -- No IdInfo if the Id isn't external, or if we don't have -O
-  = mkIdInfo new_flavour caf_info
-       `setStrictnessInfo` strictnessInfo core_idinfo
-       `setArityInfo`      ArityExactly arity_info
-       -- Keep strictness, arity and CAF info; it's used by the code generator

 
 

-  | otherwise
-  =  let (rules', _) = initUs us (tidyRules tidy_env (specInfo core_idinfo))
-     in
-     mkIdInfo new_flavour caf_info
-       `setCprInfo`        cprInfo core_idinfo
-       `setStrictnessInfo` strictnessInfo core_idinfo
-       `setInlinePragInfo` inlinePragInfo core_idinfo
-       `setUnfoldingInfo`  unfold_info
-       `setWorkerInfo`     tidyWorker tidy_env arity_info (workerInfo core_idinfo)
-       `setSpecInfo`       rules'
-       `setArityInfo`      ArityExactly arity_info
-               -- this is the final IdInfo, it must agree with the
-               -- code finally generated (i.e. NO more transformations
-               -- after this!).
+-- 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
   where

-    core_idinfo = idInfo id
-    new_flavour = makeConstantFlavour (flavourInfo core_idinfo)
-       -- A DFunId must stay a DFunId, so that we can gather the
-       -- DFunIds up later.  Other local things become ConstantIds.
-
+       -- baasic_info is attached to every top-level binder
+    basic_info = vanillaIdInfo 
+                       `setCgInfo`            cg_info
+                       `setArityInfo`         arity
+                       `setNewStrictnessInfo` 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
 -- we intend to globalise it.
 
 -- 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
+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 globalise 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)
+  | local  && external = case lookupFM ns_names key of
+                          Just orig -> (ns,          occ_env', orig)
+                          Nothing   -> (ns_w_global, occ_env', new_global_name)

        -- If we want to globalise a currently-local name, check
        -- whether we have already assigned a unique for it.
        -- If we want to globalise a currently-local name, check
        -- 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
     local           = not global
     internal        = not external
 
     global          = isGlobalName name
     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   = mkLocalName  uniq     occ' loc
+    new_global_name  = mkGlobalName uniq mod occ' loc  
+
+    ns_w_local      = ns { nsUniqs = us2 }
+    ns_w_global             = ns { nsUniqs = us2, nsNames = addToFM ns_names key new_global_name }
+
+

 ------------  Worker  --------------
 ------------  Worker  --------------

--- We only treat a function as having a worker if
--- the exported arity (which is now the number of visible lambdas)
--- is the same as the arity at the moment of the w/w split
--- If so, we can safely omit the unfolding inside the wrapper, and
--- instead re-generate it from the type/arity/strictness info
--- But if the arity has changed, we just take the simple path and
--- put the unfolding into the interface file, forgetting the fact
--- that it's a wrapper.  
---
--- How can this happen?  Sometimes we get
---     f = coerce t (\x y -> $wf x y)
--- at the moment of w/w split; but the eta reducer turns it into
---     f = coerce t $wf
--- which is perfectly fine except that the exposed arity so far as
--- the code generator is concerned (zero) differs from the arity
--- when we did the split (2).  
---
--- All this arises because we use 'arity' to mean "exactly how many
--- top level lambdas are there" in interface files; but during the
--- compilation of this module it means "how many things can I apply
--- this to".
-tidyWorker tidy_env real_arity (HasWorker work_id wrap_arity) 
-  | real_arity == wrap_arity
+tidyWorker tidy_env (HasWorker work_id wrap_arity) 

   = HasWorker (tidyVarOcc tidy_env work_id) wrap_arity
   = HasWorker (tidyVarOcc tidy_env work_id) wrap_arity

-tidyWorker tidy_env real_arity other
+tidyWorker tidy_env other

   = NoWorker
 
 ------------  Rules  --------------
   = NoWorker
 
 ------------  Rules  --------------

-tidyIdRules :: TidyEnv -> [IdCoreRule] -> UniqSM [IdCoreRule]
-tidyIdRules env [] = returnUs []
+tidyIdRules :: TidyEnv -> [IdCoreRule] -> [IdCoreRule]
+tidyIdRules env [] = []

 tidyIdRules env ((fn,rule) : rules)
 tidyIdRules env ((fn,rule) : rules)

-  = tidyRule env rule                  `thenUs` \ rule ->
-    tidyIdRules env rules      `thenUs` \ rules ->
-    returnUs ((tidyVarOcc env fn, rule) : rules)
-
-tidyRules :: TidyEnv -> CoreRules -> UniqSM CoreRules
-tidyRules env (Rules rules fvs) 
-  = mapUs (tidyRule env) rules                 `thenUs` \ rules ->
-    returnUs (Rules rules (foldVarSet tidy_set_elem emptyVarSet fvs))
-  where
-    tidy_set_elem var new_set = extendVarSet new_set (tidyVarOcc env var)
-
-tidyRule :: TidyEnv -> CoreRule -> UniqSM CoreRule
-tidyRule env rule@(BuiltinRule _) = returnUs rule
-tidyRule env (Rule name vars tpl_args rhs)
-  = tidyBndrs env vars                 `thenUs` \ (env', vars) ->
-    mapUs (tidyExpr env') tpl_args     `thenUs` \ tpl_args ->
-    tidyExpr env' rhs                  `thenUs` \ rhs ->
-    returnUs (Rule name vars tpl_args rhs)
+  = tidyRule env rule                  =: \ rule ->
+    tidyIdRules env rules      =: \ rules ->
+     ((tidyVarOcc env fn, rule) : rules)
+
+tidyRule :: TidyEnv -> CoreRule -> CoreRule
+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 ->
+     (Rule name act vars tpl_args (tidyExpr env' rhs))

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

@@ -483,54 +581,40 @@ tidyRule env (Rule name vars tpl_args rhs)
 \begin{code}
 tidyBind :: TidyEnv
         -> CoreBind
 \begin{code}
 tidyBind :: TidyEnv
         -> CoreBind

-        -> UniqSM (TidyEnv, CoreBind)
+        ->  (TidyEnv, CoreBind)
+

 tidyBind env (NonRec bndr rhs)
 tidyBind env (NonRec bndr rhs)

-  = tidyBndrWithRhs env (bndr,rhs) `thenUs` \ (env', bndr') ->
-    tidyExpr env' rhs                     `thenUs` \ rhs' ->
-    returnUs (env', NonRec bndr' rhs')
+  = tidyLetBndr env (bndr,rhs)         =: \ (env', bndr') ->
+    (env', NonRec bndr' (tidyExpr env' rhs))

 
 tidyBind env (Rec prs)
 
 tidyBind env (Rec prs)

-  = mapAccumLUs tidyBndrWithRhs env prs        `thenUs` \ (env', bndrs') ->
-    mapUs (tidyExpr env') (map snd prs)                `thenUs` \ rhss' ->
-    returnUs (env', Rec (zip bndrs' rhss'))
+  = mapAccumL tidyLetBndr env prs      =: \ (env', bndrs') ->
+    map (tidyExpr env') (map snd prs)  =: \ rhss' ->
+    (env', Rec (zip bndrs' rhss'))

 
 

-tidyExpr env (Var v)   
-  = fiddleCCall v  `thenUs` \ v ->
-    returnUs (Var (tidyVarOcc env v))

 
 

-tidyExpr env (Type ty) = returnUs (Type (tidyType env ty))
-tidyExpr env (Lit lit) = returnUs (Lit lit)
-
-tidyExpr env (App f a)
-  = tidyExpr env f             `thenUs` \ f ->
-    tidyExpr env a             `thenUs` \ a ->
-    returnUs (App f a)
-
-tidyExpr env (Note n e)
-  = tidyExpr env e             `thenUs` \ e ->
-    returnUs (Note (tidyNote env n) e)
+tidyExpr env (Var v)           =  Var (tidyVarOcc env v)
+tidyExpr env (Type ty)         =  Type (tidyType env ty)
+tidyExpr env (Lit lit)         =  Lit lit
+tidyExpr env (App f a)         =  App (tidyExpr env f) (tidyExpr env a)
+tidyExpr env (Note n e) =  Note (tidyNote env n) (tidyExpr env e)

 
 tidyExpr env (Let b e) 
 
 tidyExpr env (Let b e) 

-  = tidyBind env b             `thenUs` \ (env', b') ->
-    tidyExpr env' e            `thenUs` \ e ->
-    returnUs (Let b' e)
+  = tidyBind env b     =: \ (env', b') ->
+    Let b' (tidyExpr env' e)

 
 tidyExpr env (Case e b alts)
 
 tidyExpr env (Case e b alts)

-  = tidyExpr env e             `thenUs` \ e ->
-    tidyBndr env b             `thenUs` \ (env', b) ->
-    mapUs (tidyAlt env') alts  `thenUs` \ alts ->
-    returnUs (Case e b alts)
+  = tidyBndr env b     =: \ (env', b) ->
+    Case (tidyExpr env e) b (map (tidyAlt env') alts)

 
 tidyExpr env (Lam b e)
 
 tidyExpr env (Lam b e)

-  = tidyBndr env b             `thenUs` \ (env', b) ->
-    tidyExpr env' e            `thenUs` \ e ->
-    returnUs (Lam b e)
+  = tidyBndr env b     =: \ (env', b) ->
+    Lam b (tidyExpr env' e)

 
 
 tidyAlt env (con, vs, rhs)
 
 
 tidyAlt env (con, vs, rhs)

-  = tidyBndrs env vs           `thenUs` \ (env', vs) ->
-    tidyExpr env' rhs          `thenUs` \ rhs ->
-    returnUs (con, vs, rhs)
+  = tidyBndrs env vs   =: \ (env', vs) ->
+    (con, vs, tidyExpr env' rhs)

 
 tidyNote env (Coerce t1 t2)  = Coerce (tidyType env t1) (tidyType env t2)
 tidyNote env note            = note
 
 tidyNote env (Coerce t1 t2)  = Coerce (tidyType env t1) (tidyType env t2)
 tidyNote env note            = note

@@ -549,166 +633,61 @@ tidyVarOcc (_, var_env) v = case lookupVarEnv var_env v of
                                  Nothing -> v
 
 -- tidyBndr is used for lambda and case binders
                                  Nothing -> v
 
 -- tidyBndr is used for lambda and case binders

-tidyBndr :: TidyEnv -> Var -> UniqSM (TidyEnv, Var)
+tidyBndr :: TidyEnv -> Var -> (TidyEnv, Var)

 tidyBndr env var
 tidyBndr env var

-  | isTyVar var = returnUs (tidyTyVar env var)
-  | otherwise   = tidyId env var vanillaIdInfo
-
-tidyBndrs :: TidyEnv -> [Var] -> UniqSM (TidyEnv, [Var])
-tidyBndrs env vars = mapAccumLUs tidyBndr env vars
-
--- tidyBndrWithRhs is used for let binders
-tidyBndrWithRhs :: TidyEnv -> (Var, CoreExpr) -> UniqSM (TidyEnv, Var)
-tidyBndrWithRhs env (id,rhs)
-   = tidyId env id idinfo
-   where
-       idinfo = vanillaIdInfo `setArityInfo` ArityExactly (exprArity rhs)
-                       -- NB: This throws away the IdInfo of the Id, which we
-                       -- no longer need.  That means we don't need to
-                       -- run over it with env, nor renumber it.
-
-tidyId :: TidyEnv -> Id -> IdInfo -> UniqSM (TidyEnv, Id)
-tidyId env@(tidy_env, var_env) id idinfo
+  | isTyVar var = tidyTyVarBndr env var
+  | otherwise   = tidyIdBndr env var
+
+tidyBndrs :: TidyEnv -> [Var] -> (TidyEnv, [Var])
+tidyBndrs env vars = mapAccumL tidyBndr env vars
+
+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
+               `setNewStrictnessInfo`  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
+
+tidyIdBndr :: TidyEnv -> Id -> (TidyEnv, Id)
+tidyIdBndr env@(tidy_env, var_env) id

   =    -- Non-top-level variables
   =    -- Non-top-level variables

-    getUniqueUs   `thenUs` \ uniq ->

     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

-       name'             = mkLocalName uniq occ' noSrcLoc
+       -- 
+       -- All nested Ids now have the same IdInfo, namely none,
+       -- which should save some space.

        (tidy_env', occ') = tidyOccName tidy_env (getOccName id)
        (tidy_env', occ') = tidyOccName tidy_env (getOccName id)

-        ty'              = tidyType (tidy_env,var_env) (idType id)
-       id'               = mkId name' ty' idinfo
+        ty'              = tidyType env (idType id)
+       id'               = mkUserLocal occ' (idUnique id) ty' noSrcLoc

        var_env'          = extendVarEnv var_env id id'
     in
        var_env'          = extendVarEnv var_env id id'
     in

-    returnUs ((tidy_env', var_env'), id')
-
-
-fiddleCCall id 
-  = case idFlavour id of
-         PrimOpId (CCallOp ccall) ->
-           -- Make a guaranteed unique name for a dynamic ccall.
-           getUniqueUs         `thenUs` \ uniq ->
-           returnUs (modifyIdInfo (`setFlavourInfo` 
-                           PrimOpId (CCallOp (setCCallUnique ccall uniq))) id)
-        other_flavour ->
-            returnUs id
+     ((tidy_env', var_env'), id')

 \end{code}
 
 \end{code}
 

-%************************************************************************
-%*                                                                     *
-\subsection{Figuring out CafInfo for an expression}
-%*                                                                     *
-%************************************************************************
-
-hasCafRefs decides whether a top-level closure can point into the dynamic heap.
-We mark such things as `MayHaveCafRefs' because this information is
-used to decide whether a particular closure needs to be referenced
-in an SRT or not.
-
-There are two reasons for setting MayHaveCafRefs:
-       a) The RHS is a CAF: a top-level updatable thunk.
-       b) The RHS refers to something that MayHaveCafRefs
-
-Possible improvement: In an effort to keep the number of CAFs (and 
-hence the size of the SRTs) down, we could also look at the expression and 
-decide whether it requires a small bounded amount of heap, so we can ignore 
-it as a CAF.  In these cases however, we would need to use an additional
-CAF list to keep track of non-collectable CAFs.  
-

 \begin{code}
 \begin{code}

-hasCafRefs  :: (Id -> Bool) -> CoreExpr -> CafInfo
--- Only called for the RHS of top-level lets
-hasCafRefss :: (Id -> Bool) -> [CoreExpr] -> CafInfo
-       -- predicate returns True for a given Id if we look at this Id when
-       -- calculating the result.  Used to *avoid* looking at the CafInfo
-       -- field for an Id that is part of the current recursive group.
-
-hasCafRefs p expr = if isCAF expr || isFastTrue (cafRefs p expr)
-                       then MayHaveCafRefs
-                       else NoCafRefs
-
-       -- used for recursive groups.  The whole group is set to
-       -- "MayHaveCafRefs" if at least one of the group is a CAF or
-       -- refers to any CAFs.
-hasCafRefss p exprs = if any isCAF exprs || isFastTrue (cafRefss p exprs)
-                       then MayHaveCafRefs
-                       else NoCafRefs
-
-cafRefs p (Var id)
- | p id
- = case idCafInfo id of 
-       NoCafRefs      -> fastBool False
-       MayHaveCafRefs -> fastBool True
- | otherwise
- = fastBool False
-
-cafRefs p (Lit l)           = fastBool False
-cafRefs p (App f a)         = cafRefs p f `fastOr` cafRefs p a
-cafRefs p (Lam x e)         = cafRefs p e
-cafRefs p (Let b e)         = cafRefss p (rhssOfBind b) `fastOr` cafRefs p e
-cafRefs p (Case e bndr alts) = cafRefs p e `fastOr` cafRefss p (rhssOfAlts alts)
-cafRefs p (Note n e)        = cafRefs p e
-cafRefs p (Type t)          = fastBool False
-
-cafRefss p []    = fastBool False
-cafRefss p (e:es) = cafRefs p e `fastOr` cafRefss p es
-
-
-isCAF :: CoreExpr -> Bool
--- Only called for the RHS of top-level lets
-isCAF e = not (rhsIsNonUpd e)
-  {- ToDo: check type for onceness, i.e. non-updatable thunks? -}
-
-rhsIsNonUpd :: CoreExpr -> Bool
-  -- True => Value-lambda, constructor, PAP
-  -- This is a bit like CoreUtils.exprIsValue, with the following differences:
-  --   a) scc "foo" (\x -> ...) is updatable (so we catch the right SCC)
-  --
-  --    b) (C x xs), where C is a contructors is updatable if the application is
-  --      dynamic: see isDynConApp
-  -- 
-  --    c) don't look through unfolding of f in (f x).  I'm suspicious of this one
-
-rhsIsNonUpd (Lam b e)          = isId b || rhsIsNonUpd e
-rhsIsNonUpd (Note (SCC _) e)   = False
-rhsIsNonUpd (Note _ e)         = rhsIsNonUpd e
-rhsIsNonUpd other_expr
-  = go other_expr 0 []
-  where
-    go (Var f) n_args args = idAppIsNonUpd f n_args args
-       
-    go (App f a) n_args args
-       | isTypeArg a = go f n_args args
-       | otherwise   = go f (n_args + 1) (a:args)
-
-    go (Note (SCC _) f) n_args args = False
-    go (Note _ f) n_args args       = go f n_args args
-
-    go other n_args args = False
-
-idAppIsNonUpd :: Id -> Int -> [CoreExpr] -> Bool
-idAppIsNonUpd id n_val_args args
-  = case idFlavour id of
-       DataConId con | not (isDynConApp con args) -> True
-       other -> n_val_args < idArity id
-
-isDynConApp :: DataCon -> [CoreExpr] -> Bool
-isDynConApp con args = isDllName (dataConName con) || any isDynArg args
--- Top-level constructor applications can usually be allocated 
--- statically, but they can't if 
---     a) the constructor, or any of the arguments, come from another DLL
---     b) any of the arguments are LitLits
--- (because we can't refer to static labels in other DLLs).
--- If this happens we simply make the RHS into an updatable thunk, 
--- and 'exectute' it rather than allocating it statically.
--- All this should match the decision in (see CoreToStg.coreToStgRhs)
-
-
-isDynArg :: CoreExpr -> Bool
-isDynArg (Var v)    = isDllName (idName v)
-isDynArg (Note _ e) = isDynArg e
-isDynArg (Lit lit)  = isLitLitLit lit
-isDynArg (App e _)  = isDynArg e       -- must be a type app
-isDynArg (Lam _ e)  = isDynArg e       -- must be a type lam
+m =: k = m `seq` k m

 \end{code}
 \end{code}