X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FsimplCore%2FSetLevels.lhs;h=f8ab29dcd593189f77eb18929143305d51ae4b5a;hb=9d7da331989abcd1844e9d03b8d1e4163796fa85;hp=e67748884b322829586719377fced5c923023e19;hpb=fdba7999ba01b4e2b4ee704e6784192e4d92b8cf;p=ghc-hetmet.git

diff --git a/ghc/compiler/simplCore/SetLevels.lhs b/ghc/compiler/simplCore/SetLevels.lhs
index e677488..f8ab29d 100644
--- a/ghc/compiler/simplCore/SetLevels.lhs
+++ b/ghc/compiler/simplCore/SetLevels.lhs
@@ -55,21 +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		( Subst, SubstResult(..), emptySubst, extendInScope, extendIdSubst,
-			  substAndCloneId, substAndCloneRecIds )
-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
@@ -682,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
@@ -695,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
@@ -773,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
@@ -796,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)
 	
 
@@ -807,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.
@@ -819,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
@@ -832,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