[project @ 2006-01-06 16:30:17 by simonmar]

[ghc-hetmet.git] / ghc / compiler / simplCore / SetLevels.lhs

diff --git a/ghc/compiler/simplCore/SetLevels.lhs b/ghc/compiler/simplCore/SetLevels.lhs
index d0f043b..f8ab29d 100644 (file)
--- a/ghc/compiler/simplCore/SetLevels.lhs
+++ b/ghc/compiler/simplCore/SetLevels.lhs
@@ -55,20 +55,21 @@ module SetLevels (
 
 import CoreSyn
 
-import CmdLineOpts     ( FloatOutSwitches(..) )
+import DynFlags        ( FloatOutSwitches(..) )
 import CoreUtils       ( exprType, exprIsTrivial, exprIsCheap, mkPiTypes )
 import CoreFVs         -- all of it
-import Subst
-import Id              ( Id, idType, mkSysLocalUnencoded, 
-                         isOneShotLambda, zapDemandIdInfo,
+import CoreSubst       ( Subst, emptySubst, extendInScope, extendIdSubst,
+                         cloneIdBndr, cloneRecIdBndrs )
+import Id              ( Id, idType, mkSysLocal, isOneShotLambda,
+                         zapDemandIdInfo,
                          idSpecialisation, idWorkerInfo, setIdInfo
                        )
-import IdInfo          ( workerExists, vanillaIdInfo, )
+import IdInfo          ( workerExists, vanillaIdInfo, isEmptySpecInfo )
 import Var             ( Var )
 import VarSet
 import VarEnv
 import Name            ( getOccName )
-import OccName         ( occNameUserString )
+import OccName         ( occNameString )
 import Type            ( isUnLiftedType, Type )
 import BasicTypes      ( TopLevelFlag(..) )
 import UniqSupply
@@ -681,7 +682,7 @@ extendLvlEnv (float_lams, lvl_env, subst, id_env) prs
 extendCaseBndrLvlEnv (float_lams, lvl_env, subst, id_env) (Var scrut_var) case_bndr lvl
   = (float_lams,
      extendVarEnv lvl_env case_bndr lvl,
-     extendIdSubst subst case_bndr (DoneEx (Var scrut_var)),
+     extendIdSubst subst case_bndr (Var scrut_var),
      extendVarEnv id_env case_bndr ([scrut_var], Var scrut_var))
      
 extendCaseBndrLvlEnv env scrut case_bndr lvl
@@ -694,7 +695,7 @@ extendPolyLvlEnv dest_lvl (float_lams, lvl_env, subst, id_env) abs_vars bndr_pai
      foldl add_id    id_env  bndr_pairs)
   where
      add_lvl   env (v,v') = extendVarEnv env v' dest_lvl
-     add_subst env (v,v') = extendIdSubst env v (DoneEx (mkVarApps (Var v') abs_vars))
+     add_subst env (v,v') = extendIdSubst env v (mkVarApps (Var v') abs_vars)
      add_id    env (v,v') = extendVarEnv env v ((v':abs_vars), mkVarApps (Var v') abs_vars)
 
 extendCloneLvlEnv lvl (float_lams, lvl_env, _, id_env) new_subst bndr_pairs
@@ -772,7 +773,7 @@ absVarsOf dest_lvl (_, lvl_env, _, id_env) v
        -- We are going to lambda-abstract, so nuke any IdInfo,
        -- and add the tyvars of the Id (if necessary)
     zap v | isId v = WARN( workerExists (idWorkerInfo v) ||
-                          not (isEmptyCoreRules (idSpecialisation v)),
+                          not (isEmptySpecInfo (idSpecialisation v)),
                           text "absVarsOf: discarding info on" <+> ppr v )
                     setIdInfo v vanillaIdInfo
          | otherwise = v
@@ -795,9 +796,9 @@ newPolyBndrs dest_lvl env abs_vars bndrs
     in
     returnLvl (extendPolyLvlEnv dest_lvl env abs_vars (bndrs `zip` new_bndrs), new_bndrs)
   where
-    mk_poly_bndr bndr uniq = mkSysLocalUnencoded (mkFastString str) uniq poly_ty
+    mk_poly_bndr bndr uniq = mkSysLocal (mkFastString str) uniq poly_ty
                           where
-                            str     = "poly_" ++ occNameUserString (getOccName bndr)
+                            str     = "poly_" ++ occNameString (getOccName bndr)
                             poly_ty = mkPiTypes abs_vars (idType bndr)
        
 
@@ -806,7 +807,7 @@ newLvlVar :: String
          -> LvlM Id
 newLvlVar str vars body_ty     
   = getUniqueUs        `thenLvl` \ uniq ->
-    returnUs (mkSysLocalUnencoded (mkFastString str) uniq (mkPiTypes vars body_ty))
+    returnUs (mkSysLocal (mkFastString str) uniq (mkPiTypes vars body_ty))
     
 -- The deeply tiresome thing is that we have to apply the substitution
 -- to the rules inside each Id.  Grr.  But it matters.
@@ -818,7 +819,7 @@ cloneVar NotTopLevel env@(_,_,subst,_) v ctxt_lvl dest_lvl
   = ASSERT( isId v )
     getUs      `thenLvl` \ us ->
     let
-      (subst', v1) = substAndCloneId subst us v
+      (subst', v1) = cloneIdBndr subst us v
       v2          = zap_demand ctxt_lvl dest_lvl v1
       env'        = extendCloneLvlEnv dest_lvl env subst' [(v,v2)]
     in
@@ -831,7 +832,7 @@ cloneRecVars NotTopLevel env@(_,_,subst,_) vs ctxt_lvl dest_lvl
   = ASSERT( all isId vs )
     getUs                      `thenLvl` \ us ->
     let
-      (subst', vs1) = substAndCloneRecIds subst us vs
+      (subst', vs1) = cloneRecIdBndrs subst us vs
       vs2          = map (zap_demand ctxt_lvl dest_lvl) vs1
       env'         = extendCloneLvlEnv dest_lvl env subst' (vs `zip` vs2)
     in