summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2016-12-21 12:13:11 +0000
committerSimon Peyton Jones <simonpj@microsoft.com>2016-12-21 12:26:24 +0000
commit05d233e8e18284cb98dc320bf58191ba4d86c754 (patch)
tree475395b747b7fee213691436bd5929dbd0844bff
parent0a18231b9c62c9f773a5c74f7cc290416fbbb655 (diff)
downloadhaskell-05d233e8e18284cb98dc320bf58191ba4d86c754.tar.gz
Move InId/OutId to CoreSyn
It turned out that many different modules defined the same type synonyms (InId, OutId, InType, OutType, etc) for the same purpose. This patch is refactoring only: it moves all those definitions to CoreSyn.
-rw-r--r--compiler/coreSyn/CoreLint.hs16
-rw-r--r--compiler/coreSyn/CoreSubst.hs9
-rw-r--r--compiler/coreSyn/CoreSyn.hs49
-rw-r--r--compiler/simplCore/CSE.hs11
-rw-r--r--compiler/simplCore/SetLevels.hs5
-rw-r--r--compiler/simplCore/SimplEnv.hs34
-rw-r--r--compiler/simplStg/UnariseStg.hs2
-rw-r--r--compiler/specialise/SpecConstr.hs9
8 files changed, 51 insertions, 84 deletions
diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs
index 345e4b5f97..b4946a274b 100644
--- a/compiler/coreSyn/CoreLint.hs
+++ b/compiler/coreSyn/CoreLint.hs
@@ -601,24 +601,12 @@ the desugarer.
************************************************************************
-}
-type InType = Type
-type InCoercion = Coercion
-type InVar = Var
-type InTyVar = Var
-type InCoVar = Var
-
-type OutType = Type -- Substitution has been applied to this,
- -- but has not been linted yet
-type OutKind = Kind
+-- For OutType, OutKind, the substitution has been applied,
+-- but has not been linted yet
type LintedType = Type -- Substitution applied, and type is linted
type LintedKind = Kind
-type OutCoercion = Coercion
-type OutVar = Var
-type OutTyVar = TyVar
-type OutCoVar = Var
-
lintCoreExpr :: CoreExpr -> LintM OutType
-- The returned type has the substitution from the monad
-- already applied to it:
diff --git a/compiler/coreSyn/CoreSubst.hs b/compiler/coreSyn/CoreSubst.hs
index ffd8c2a024..e8a8f6ea55 100644
--- a/compiler/coreSyn/CoreSubst.hs
+++ b/compiler/coreSyn/CoreSubst.hs
@@ -81,6 +81,7 @@ import Data.List
import TysWiredIn
+
{-
************************************************************************
* *
@@ -907,14 +908,6 @@ simpleOptPgm dflags this_mod binds rules vects
(subst', Nothing) -> (subst', binds')
(subst', Just bind') -> (subst', bind':binds')
-----------------------
-type InVar = Var
-type OutVar = Var
-type InId = Id
-type OutId = Id
-type InExpr = CoreExpr
-type OutExpr = CoreExpr
-
-- In these functions the substitution maps InVar -> OutExpr
----------------------
diff --git a/compiler/coreSyn/CoreSyn.hs b/compiler/coreSyn/CoreSyn.hs
index cf570211f5..52ffad041b 100644
--- a/compiler/coreSyn/CoreSyn.hs
+++ b/compiler/coreSyn/CoreSyn.hs
@@ -13,6 +13,12 @@ module CoreSyn (
CoreProgram, CoreExpr, CoreAlt, CoreBind, CoreArg, CoreBndr,
TaggedExpr, TaggedAlt, TaggedBind, TaggedArg, TaggedBndr(..), deTagExpr,
+ -- * In/Out type synonyms
+ InId, InBind, InExpr, InAlt, InArg, InType, InKind,
+ InBndr, InVar, InCoercion, InTyVar, InCoVar,
+ OutId, OutBind, OutExpr, OutAlt, OutArg, OutType, OutKind,
+ OutBndr, OutVar, OutCoercion, OutTyVar, OutCoVar,
+
-- ** 'Expr' construction
mkLets, mkLams,
mkApps, mkTyApps, mkCoApps, mkVarApps,
@@ -40,6 +46,7 @@ module CoreSyn (
isValArg, isTypeArg, isTyCoArg, valArgCount, valBndrCount,
isRuntimeArg, isRuntimeVar,
+ -- * Tick-related functions
tickishCounts, tickishScoped, tickishScopesLike, tickishFloatable,
tickishCanSplit, mkNoCount, mkNoScope,
tickishIsCode, tickishPlace,
@@ -393,7 +400,7 @@ The levity-polymorphism invariants are these:
A type (t::TYPE r) is "levity polymorphic" if 'r' has any free variables.
For example
- (\(r::RuntimeRep). \(a::TYPE r). \(x::a). e
+ \(r::RuntimeRep). \(a::TYPE r). \(x::a). e
is illegal because x's type has kind (TYPE r), which has 'r' free.
Note [CoreSyn let goal]
@@ -461,6 +468,44 @@ this exhaustive list can be empty!
************************************************************************
* *
+ In/Out type synonyms
+* *
+********************************************************************* -}
+
+{- Many passes apply a substitution, and it's very handy to have type
+ synonyms to remind us whether or not the subsitution has been applied -}
+
+-- Pre-cloning or substitution
+type InBndr = CoreBndr
+type InVar = Var
+type InTyVar = TyVar
+type InCoVar = CoVar
+type InId = Id
+type InType = Type
+type InKind = Kind
+type InBind = CoreBind
+type InExpr = CoreExpr
+type InAlt = CoreAlt
+type InArg = CoreArg
+type InCoercion = Coercion
+
+-- Post-cloning or substitution
+type OutBndr = CoreBndr
+type OutVar = Var
+type OutId = Id
+type OutTyVar = TyVar
+type OutCoVar = CoVar
+type OutType = Type
+type OutKind = Kind
+type OutCoercion = Coercion
+type OutBind = CoreBind
+type OutExpr = CoreExpr
+type OutAlt = CoreAlt
+type OutArg = CoreArg
+
+
+{- *********************************************************************
+* *
Ticks
* *
************************************************************************
@@ -1091,7 +1136,7 @@ data UnfoldingGuidance
-- Used (a) for small *and* cheap unfoldings
-- (b) for INLINE functions
-- See Note [INLINE for small functions] in CoreUnfold
- ug_arity :: Arity, -- Number of value arguments expected
+ ug_arity :: Arity, -- Number of value arguments expected
ug_unsat_ok :: Bool, -- True <=> ok to inline even if unsaturated
ug_boring_ok :: Bool -- True <=> ok to inline even if the context is boring
diff --git a/compiler/simplCore/CSE.hs b/compiler/simplCore/CSE.hs
index 039da8e763..42a2d289a2 100644
--- a/compiler/simplCore/CSE.hs
+++ b/compiler/simplCore/CSE.hs
@@ -17,7 +17,7 @@ import Id ( Id, idType, idUnfolding, idInlineActivation
import CoreUtils ( mkAltExpr
, exprIsTrivial, exprOkForSpeculation
, stripTicksE, stripTicksT, mkTicks )
-import Type ( Type, tyConAppArgs, isUnliftedType )
+import Type ( tyConAppArgs, isUnliftedType )
import CoreSyn
import Outputable
import BasicTypes ( isAlwaysActive )
@@ -368,15 +368,6 @@ cseCase env scrut bndr ty alts
************************************************************************
-}
-type InExpr = CoreExpr -- Pre-cloning
-type InId = Id
-type InAlt = CoreAlt
-type InType = Type
-
-type OutExpr = CoreExpr -- Post-cloning
-type OutId = Id
-type OutType = Type
-
data CSEnv
= CS { cs_subst :: Subst -- Maps InBndrs to OutExprs
-- The substitution variables to
diff --git a/compiler/simplCore/SetLevels.hs b/compiler/simplCore/SetLevels.hs
index ef98e7b915..bb1045740d 100644
--- a/compiler/simplCore/SetLevels.hs
+++ b/compiler/simplCore/SetLevels.hs
@@ -935,11 +935,6 @@ countFreeIds = nonDetFoldUDFM add 0
************************************************************************
-}
-type InVar = Var -- Pre cloning
-type InId = Id -- Pre cloning
-type OutVar = Var -- Post cloning
-type OutId = Id -- Post cloning
-
data LevelEnv
= LE { le_switches :: FloatOutSwitches
, le_ctxt_lvl :: Level -- The current level
diff --git a/compiler/simplCore/SimplEnv.hs b/compiler/simplCore/SimplEnv.hs
index 7061540942..59ac440230 100644
--- a/compiler/simplCore/SimplEnv.hs
+++ b/compiler/simplCore/SimplEnv.hs
@@ -7,11 +7,6 @@
{-# LANGUAGE CPP #-}
module SimplEnv (
- -- * Basic types
- InId, InBind, InExpr, InAlt, InArg, InType, InBndr, InVar,
- OutId, OutTyVar, OutBind, OutExpr, OutAlt, OutArg, OutType, OutBndr, OutVar,
- InCoercion, OutCoercion,
-
-- * The simplifier mode
setMode, getMode, updMode,
@@ -65,35 +60,6 @@ import Data.List
{-
************************************************************************
* *
-\subsection[Simplify-types]{Type declarations}
-* *
-************************************************************************
--}
-
-type InBndr = CoreBndr
-type InVar = Var -- Not yet cloned
-type InId = Id -- Not yet cloned
-type InType = Type -- Ditto
-type InBind = CoreBind
-type InExpr = CoreExpr
-type InAlt = CoreAlt
-type InArg = CoreArg
-type InCoercion = Coercion
-
-type OutBndr = CoreBndr
-type OutVar = Var -- Cloned
-type OutId = Id -- Cloned
-type OutTyVar = TyVar -- Cloned
-type OutType = Type -- Cloned
-type OutCoercion = Coercion
-type OutBind = CoreBind
-type OutExpr = CoreExpr
-type OutAlt = CoreAlt
-type OutArg = CoreArg
-
-{-
-************************************************************************
-* *
\subsubsection{The @SimplEnv@ type}
* *
************************************************************************
diff --git a/compiler/simplStg/UnariseStg.hs b/compiler/simplStg/UnariseStg.hs
index a393e8fae9..fc30859980 100644
--- a/compiler/simplStg/UnariseStg.hs
+++ b/compiler/simplStg/UnariseStg.hs
@@ -265,8 +265,6 @@ extendRho rho x (UnaryVal val)
--------------------------------------------------------------------------------
type OutStgExpr = StgExpr
-type InId = Id
-type OutId = Id
type InStgAlt = StgAlt
type InStgArg = StgArg
type OutStgArg = StgArg
diff --git a/compiler/specialise/SpecConstr.hs b/compiler/specialise/SpecConstr.hs
index 2f2087cd2e..4aa7f04f5f 100644
--- a/compiler/specialise/SpecConstr.hs
+++ b/compiler/specialise/SpecConstr.hs
@@ -788,15 +788,6 @@ data ScEnv = SCE { sc_dflags :: DynFlags,
}
---------------------
--- As we go, we apply a substitution (sc_subst) to the current term
-type InExpr = CoreExpr -- _Before_ applying the subst
-type InVar = Var
-
-type OutExpr = CoreExpr -- _After_ applying the subst
-type OutId = Id
-type OutVar = Var
-
----------------------
type HowBoundEnv = VarEnv HowBound -- Domain is OutVars
---------------------