diff options
author | Simon Peyton Jones <simonpj@microsoft.com> | 2016-12-21 12:13:11 +0000 |
---|---|---|
committer | Simon Peyton Jones <simonpj@microsoft.com> | 2016-12-21 12:26:24 +0000 |
commit | 05d233e8e18284cb98dc320bf58191ba4d86c754 (patch) | |
tree | 475395b747b7fee213691436bd5929dbd0844bff | |
parent | 0a18231b9c62c9f773a5c74f7cc290416fbbb655 (diff) | |
download | haskell-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.hs | 16 | ||||
-rw-r--r-- | compiler/coreSyn/CoreSubst.hs | 9 | ||||
-rw-r--r-- | compiler/coreSyn/CoreSyn.hs | 49 | ||||
-rw-r--r-- | compiler/simplCore/CSE.hs | 11 | ||||
-rw-r--r-- | compiler/simplCore/SetLevels.hs | 5 | ||||
-rw-r--r-- | compiler/simplCore/SimplEnv.hs | 34 | ||||
-rw-r--r-- | compiler/simplStg/UnariseStg.hs | 2 | ||||
-rw-r--r-- | compiler/specialise/SpecConstr.hs | 9 |
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 --------------------- |