Separate NondecreasingIndentation out into its own extension

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

diff --git a/compiler/simplCore/SimplEnv.lhs b/compiler/simplCore/SimplEnv.lhs
index b341b87..9f424cd 100644 (file)
--- a/compiler/simplCore/SimplEnv.lhs
+++ b/compiler/simplCore/SimplEnv.lhs
@@ -1,5 +1,5 @@
 %
-% (c) The AQUA Project, Glasgow University, 1993-1998
+o% (c) The AQUA Project, Glasgow University, 1993-1998
 %
 \section[SimplMonad]{The simplifier Monad}
 
@@ -12,18 +12,14 @@ module SimplEnv (
        -- The simplifier mode
        setMode, getMode, updMode,
 
-       -- Switch checker
-       SwitchChecker, SwitchResult(..), getSwitchChecker, getSimplIntSwitch,
-       isAmongSimpl, intSwitchSet, switchIsOn,
-
-       setEnclosingCC, getEnclosingCC,
+        setEnclosingCC, getEnclosingCC,
 
        -- Environments
        SimplEnv(..), StaticEnv, pprSimplEnv,   -- Temp not abstract
        mkSimplEnv, extendIdSubst, SimplEnv.extendTvSubst, 
        zapSubstEnv, setSubstEnv, 
        getInScope, setInScope, setInScopeSet, modifyInScope, addNewInScopeIds,
-       getSimplRules, inGentleMode,
+        getSimplRules,
 
        SimplSR(..), mkContEx, substId, lookupRecBndr,
 
@@ -106,8 +102,7 @@ data SimplEnv
      -- wrt the original expression
 
        seMode      :: SimplifierMode,
-       seChkr      :: SwitchChecker,
-       seCC        :: CostCentreStack, -- The enclosing CCS (when profiling)
+        seCC        :: CostCentreStack, -- The enclosing CCS (when profiling)
 
        -- The current substitution
        seTvSubst   :: TvSubstEnv,      -- InTyVar |--> OutType
@@ -131,7 +126,13 @@ pprSimplEnv :: SimplEnv -> SDoc
 -- Used for debugging; selective
 pprSimplEnv env
   = vcat [ptext (sLit "TvSubst:") <+> ppr (seTvSubst env),
-         ptext (sLit "IdSubst:") <+> ppr (seIdSubst env) ]
+         ptext (sLit "IdSubst:") <+> ppr (seIdSubst env),
+          ptext (sLit "InScope:") <+> vcat (map ppr_one in_scope_vars)
+    ]
+  where
+   in_scope_vars = varEnvElts (getInScopeVars (seInScope env))
+   ppr_one v | isId v = ppr v <+> ppr (idUnfolding v)
+             | otherwise = ppr v
 
 type SimplIdSubst = IdEnv SimplSR      -- IdId |--> OutExpr
        -- See Note [Extending the Subst] in CoreSubst
@@ -154,7 +155,8 @@ instance Outputable SimplSR where
        -- keep uniq _ = uniq `elemUFM_Directly` fvs
 \end{code}
 
-
+Note [SimplEnv invariants]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
 seInScope: 
        The in-scope part of Subst includes *all* in-scope TyVars and Ids
        The elements of the set may have better IdInfo than the
@@ -190,9 +192,8 @@ seIdSubst:
 * substId adds a binding (DoneId new_id) to the substitution if 
        the Id's unique has changed
 
-
   Note, though that the substitution isn't necessarily extended
-  if the type changes.  Why not?  Because of the next point:
+  if the type of the Id changes.  Why not?  Because of the next point:
 
 * We *always, always* finish by looking up in the in-scope set 
   any variable that doesn't get a DoneEx or DoneVar hit in the substitution.
@@ -217,19 +218,15 @@ seIdSubst:
 
 
 \begin{code}
-mkSimplEnv :: SwitchChecker -> SimplifierMode -> SimplEnv
-mkSimplEnv switches mode
-  = SimplEnv { seChkr = switches, seCC = subsumedCCS, 
+mkSimplEnv :: SimplifierMode -> SimplEnv
+mkSimplEnv mode
+  = SimplEnv { seCC = subsumedCCS,
               seMode = mode, seInScope = emptyInScopeSet, 
               seFloats = emptyFloats,
               seTvSubst = emptyVarEnv, seIdSubst = emptyVarEnv }
        -- The top level "enclosing CC" is "SUBSUMED".
 
 ---------------------
-getSwitchChecker :: SimplEnv -> SwitchChecker
-getSwitchChecker env = seChkr env
-
----------------------
 getMode :: SimplEnv -> SimplifierMode
 getMode env = seMode env
 
@@ -239,11 +236,6 @@ setMode mode env = env { seMode = mode }
 updMode :: (SimplifierMode -> SimplifierMode) -> SimplEnv -> SimplEnv
 updMode upd env = env { seMode = upd (seMode env) }
 
-inGentleMode :: SimplEnv -> Bool
-inGentleMode env = case seMode env of
-                       SimplGently {} -> True
-                       _other         -> False
-
 ---------------------
 getEnclosingCC :: SimplEnv -> CostCentreStack
 getEnclosingCC env = seCC env
@@ -397,7 +389,9 @@ addNonRec :: SimplEnv -> OutId -> OutExpr -> SimplEnv
 -- in-scope set (although it might also have been created with newId)
 -- but it may now have more IdInfo
 addNonRec env id rhs
-  = env { seFloats = seFloats env `addFlts` unitFloat (NonRec id rhs),
+  = id `seq`   -- This seq forces the Id, and hence its IdInfo,
+              -- and hence any inner substitutions
+    env { seFloats = seFloats env `addFlts` unitFloat (NonRec id rhs),
          seInScope = extendInScopeSet (seInScope env) id }
 
 extendFloats :: SimplEnv -> OutBind -> SimplEnv
@@ -528,7 +522,7 @@ simplBinder :: SimplEnv -> InBndr -> SimplM (SimplEnv, OutBndr)
 -- The substitution is extended only if the variable is cloned, because
 -- we *don't* need to use it to track occurrence info.
 simplBinder env bndr
-  | isTyVar bndr  = do { let (env', tv) = substTyVarBndr env bndr
+  | isTyCoVar bndr  = do       { let (env', tv) = substTyVarBndr env bndr
                        ; seqTyVar tv `seq` return (env', tv) }
   | otherwise     = do { let (env', id) = substIdBndr env bndr
                        ; seqId id `seq` return (env', id) }
@@ -735,12 +729,14 @@ substIdType (SimplEnv { seInScope = in_scope,  seTvSubst = tv_env}) id
 ------------------
 substExpr :: SDoc -> SimplEnv -> CoreExpr -> CoreExpr
 substExpr doc env
-  = CoreSubst.substExprSC (text "SimplEnv.substExpr1" <+> doc) 
-                          (mkCoreSubst (text "SimplEnv.substExpr2" <+> doc) env) 
+  = CoreSubst.substExpr (text "SimplEnv.substExpr1" <+> doc) 
+                        (mkCoreSubst (text "SimplEnv.substExpr2" <+> doc) env) 
   -- Do *not* short-cut in the case of an empty substitution
-  -- See CoreSubst: Note [Extending the Subst]
+  -- See Note [SimplEnv invariants]
 
 substUnfolding :: SimplEnv -> Unfolding -> Unfolding
-substUnfolding env unf = CoreSubst.substUnfoldingSC (mkCoreSubst (text "subst-unfolding") env) unf
+substUnfolding env unf = CoreSubst.substUnfolding (mkCoreSubst (text "subst-unfolding") env) unf
+  -- Do *not* short-cut in the case of an empty substitution
+  -- See Note [SimplEnv invariants]
 \end{code}