Print out a bit more info with the "arity decrease" waring

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

diff --git a/compiler/simplCore/SimplEnv.lhs b/compiler/simplCore/SimplEnv.lhs
index b6f2fbf..2a620ff 100644 (file)
--- a/compiler/simplCore/SimplEnv.lhs
+++ b/compiler/simplCore/SimplEnv.lhs
@@ -19,7 +19,7 @@ module SimplEnv (
        setEnclosingCC, getEnclosingCC,
 
        -- Environments
-       SimplEnv(..), pprSimplEnv,      -- Temp not abstract
+       SimplEnv(..), StaticEnv, pprSimplEnv,   -- Temp not abstract
        mkSimplEnv, extendIdSubst, SimplEnv.extendTvSubst, 
        zapSubstEnv, setSubstEnv, 
        getInScope, setInScope, setInScopeSet, modifyInScope, addNewInScopeIds,
@@ -29,7 +29,7 @@ module SimplEnv (
 
        simplNonRecBndr, simplRecBndrs, simplLamBndr, simplLamBndrs, 
        simplBinder, simplBinders, addBndrRules,
-       substExpr, substTy, mkCoreSubst,
+       substExpr, substTy, getTvSubst, mkCoreSubst,
 
        -- Floats
        Floats, emptyFloats, isEmptyFloats, addNonRec, addFloats, extendFloats,
@@ -40,6 +40,7 @@ module SimplEnv (
 #include "HsVersions.h"
 
 import SimplMonad
+import CoreMonad       ( SimplifierMode(..) )
 import IdInfo
 import CoreSyn
 import CoreUtils
@@ -54,7 +55,6 @@ import qualified Type         ( substTy, substTyVarBndr )
 import Type hiding             ( substTy, substTyVarBndr )
 import Coercion
 import BasicTypes      
-import DynFlags
 import MonadUtils
 import Outputable
 import FastString
@@ -99,23 +99,32 @@ type OutArg  = CoreArg
 \begin{code}
 data SimplEnv
   = SimplEnv {
+     ----------- Static part of the environment -----------
+     -- Static in the sense of lexically scoped, 
+     -- wrt the original expression
+
        seMode      :: SimplifierMode,
        seChkr      :: SwitchChecker,
        seCC        :: CostCentreStack, -- The enclosing CCS (when profiling)
 
+       -- The current substitution
+       seTvSubst   :: TvSubstEnv,      -- InTyVar |--> OutType
+       seIdSubst   :: SimplIdSubst,    -- InId    |--> OutExpr
+
+     ----------- Dynamic part of the environment -----------
+     -- Dynamic in the sense of describing the setup where
+     -- the expression finally ends up
+
        -- The current set of in-scope variables
        -- They are all OutVars, and all bound in this module
        seInScope   :: InScopeSet,      -- OutVars only
                -- Includes all variables bound by seFloats
-       seFloats    :: Floats,
+       seFloats    :: Floats
                -- See Note [Simplifier floats]
-
-       -- The current substitution
-       seTvSubst   :: TvSubstEnv,      -- InTyVar |--> OutType
-       seIdSubst   :: SimplIdSubst     -- InId    |--> OutExpr
-
     }
 
+type StaticEnv = SimplEnv      -- Just the static part is relevant
+
 pprSimplEnv :: SimplEnv -> SDoc
 -- Used for debugging; selective
 pprSimplEnv env
@@ -678,13 +687,16 @@ addBndrRules env in_id out_id
 %************************************************************************
 
 \begin{code}
+getTvSubst :: SimplEnv -> TvSubst
+getTvSubst (SimplEnv { seInScope = in_scope, seTvSubst = tv_env })
+  = mkTvSubst in_scope tv_env
+
 substTy :: SimplEnv -> Type -> Type 
-substTy (SimplEnv { seInScope = in_scope, seTvSubst = tv_env }) ty
-  = Type.substTy (TvSubst in_scope tv_env) ty
+substTy env ty = Type.substTy (getTvSubst env) ty
 
 substTyVarBndr :: SimplEnv -> TyVar -> (SimplEnv, TyVar)
-substTyVarBndr env@(SimplEnv { seInScope = in_scope, seTvSubst = tv_env }) tv
-  = case Type.substTyVarBndr (TvSubst in_scope tv_env) tv of
+substTyVarBndr env tv
+  = case Type.substTyVarBndr (getTvSubst env) tv of
        (TvSubst in_scope' tv_env', tv') 
           -> (env { seInScope = in_scope', seTvSubst = tv_env'}, tv')