X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FcoreSyn%2FCoreSyn.lhs;h=05de8607bbd20c1e7278c767c7018ed56a2f834e;hp=f83845f3f5b26fd35074854fef8745aca6a04ade;hb=7fc749a43b4b6b85d234fa95d4928648259584f4;hpb=afbc90b056b31768e243f3b4900034aec1c6b706 diff --git a/compiler/coreSyn/CoreSyn.lhs b/compiler/coreSyn/CoreSyn.lhs index f83845f..05de860 100644 --- a/compiler/coreSyn/CoreSyn.lhs +++ b/compiler/coreSyn/CoreSyn.lhs @@ -1,9 +1,18 @@ % +% (c) The University of Glasgow 2006 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % -\section[CoreSyn]{A data type for the Haskell compiler midsection} + +CoreSyn: A data type for the Haskell compiler midsection \begin{code} +{-# OPTIONS -w #-} +-- The above warning supression flag is a temporary kludge. +-- While working on this module you are encouraged to remove it and fix +-- any warnings in the module. See +-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings +-- for details + module CoreSyn ( Expr(..), Alt, Bind(..), AltCon(..), Arg, Note(..), CoreExpr, CoreAlt, CoreBind, CoreArg, CoreBndr, @@ -40,22 +49,21 @@ module CoreSyn ( -- Core rules CoreRule(..), -- CoreSubst, CoreTidy, CoreFVs, PprCore only - RuleName, seqRules, + RuleName, seqRules, ruleArity, isBuiltinRule, ruleName, isLocalRule, ruleIdName ) where #include "HsVersions.h" -import StaticFlags ( opt_RuntimeTypes ) -import CostCentre ( CostCentre, noCostCentre ) -import Var ( Var, Id, TyVar, isTyVar, isId ) -import Type ( Type, mkTyVarTy, seqType ) -import Coercion ( Coercion ) -import Name ( Name ) -import OccName ( OccName ) -import Literal ( Literal, mkMachInt ) -import DataCon ( DataCon, dataConWorkId, dataConTag ) -import BasicTypes ( Activation ) +import StaticFlags +import CostCentre +import Var +import Type +import Coercion +import Name +import Literal +import DataCon +import BasicTypes import FastString import Outputable @@ -77,42 +85,23 @@ infixl 8 `App` -- App brackets to the left data Expr b -- "b" for the type of binders, = Var Id | Lit Literal - | App (Expr b) (Arg b) + | App (Expr b) (Arg b) -- See Note [CoreSyn let/app invariant] | Lam b (Expr b) - | Let (Bind b) (Expr b) + | Let (Bind b) (Expr b) -- See [CoreSyn let/app invariant], + -- and [CoreSyn letrec invariant] | Case (Expr b) b Type [Alt b] -- Binder gets bound to value of scrutinee - -- Invariant: The list of alternatives is ALWAYS EXHAUSTIVE, - -- meaning that it covers all cases that can occur - -- See the example below - -- - -- Invariant: The DEFAULT case must be *first*, if it occurs at all - -- Invariant: The remaining cases are in order of increasing - -- tag (for DataAlts) - -- lit (for LitAlts) - -- This makes finding the relevant constructor easy, - -- and makes comparison easier too + -- See Note [CoreSyn case invariants] | Cast (Expr b) Coercion | Note Note (Expr b) | Type Type -- This should only show up at the top -- level of an Arg --- An "exhausive" case does not necessarily mention all constructors: --- data Foo = Red | Green | Blue --- --- ...case x of --- Red -> True --- other -> f (case x of --- Green -> ... --- Blue -> ... ) --- The inner case does not need a Red alternative, because x can't be Red at --- that program point. - - type Arg b = Expr b -- Can be a Type type Alt b = (AltCon, [b], Expr b) -- (DEFAULT, [], rhs) is the default alternative -data AltCon = DataAlt DataCon +data AltCon = DataAlt DataCon -- Invariant: the DataCon is always from + -- a *data* type, and never from a *newtype* | LitAlt Literal | DEFAULT deriving (Eq, Ord) @@ -120,7 +109,61 @@ data AltCon = DataAlt DataCon data Bind b = NonRec b (Expr b) | Rec [(b, (Expr b))] +\end{code} + +-------------------------- CoreSyn INVARIANTS --------------------------- + +Note [CoreSyn top-level invariant] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +* The RHSs of all top-level lets must be of LIFTED type. + +Note [CoreSyn letrec invariant] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +* The RHS of a letrec must be of LIFTED type. + +Note [CoreSyn let/app invariant] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +* The RHS of a non-recursive let, *and* the argument of an App, + may be of UNLIFTED type, but only if the expression + is ok-for-speculation. This means that the let can be floated around + without difficulty. e.g. + y::Int# = x +# 1# ok + y::Int# = fac 4# not ok [use case instead] +This is intially enforced by DsUtils.mkDsLet and mkDsApp + +Note [CoreSyn case invariants] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Invariant: The DEFAULT case must be *first*, if it occurs at all + +Invariant: The remaining cases are in order of increasing + tag (for DataAlts) + lit (for LitAlts) + This makes finding the relevant constructor easy, + and makes comparison easier too +Invariant: The list of alternatives is ALWAYS EXHAUSTIVE, + meaning that it covers all cases that can occur + + An "exhausive" case does not necessarily mention all constructors: + data Foo = Red | Green | Blue + + ...case x of + Red -> True + other -> f (case x of + Green -> ... + Blue -> ... ) + The inner case does not need a Red alternative, because x can't be Red at + that program point. + + +Note [CoreSyn let goal] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +* The simplifier tries to ensure that if the RHS of a let is a constructor + application, its arguments are trivial, so that the constructor can be + inlined vigorously. + + +\begin{code} data Note = SCC CostCentre @@ -140,23 +183,6 @@ data Note -- should inline f even inside lambdas. In effect, we should trust the programmer. \end{code} -INVARIANTS: - -* The RHS of a letrec, and the RHSs of all top-level lets, - must be of LIFTED type. - -* The RHS of a let, may be of UNLIFTED type, but only if the expression - is ok-for-speculation. This means that the let can be floated around - without difficulty. e.g. - y::Int# = x +# 1# ok - y::Int# = fac 4# not ok [use case instead] - -* The argument of an App can be of any type. - -* The simplifier tries to ensure that if the RHS of a let is a constructor - application, its arguments are trivial, so that the constructor can be - inlined vigorously. - %************************************************************************ %* * @@ -197,21 +223,33 @@ data CoreRule ru_rhs :: CoreExpr, -- Locality - ru_local :: Bool, -- The fn at the head of the rule is + ru_local :: Bool -- The fn at the head of the rule is -- defined in the same module as the rule - - -- Orphan-hood; see comments is InstEnv.Instance( is_orph ) - ru_orph :: Maybe OccName } + -- and is not an implicit Id (like a record sel + -- class op, or data con) + -- NB: ru_local is *not* used to decide orphan-hood + -- c.g. MkIface.coreRuleToIfaceRule + } | BuiltinRule { -- Built-in rules are used for constant folding ru_name :: RuleName, -- and suchlike. It has no free variables. ru_fn :: Name, -- Name of the Id at -- the head of this rule + ru_nargs :: Int, -- Number of args that ru_try expects, + -- including type args ru_try :: [CoreExpr] -> Maybe CoreExpr } + -- This function does the rewrite. It given too many + -- arguments, it simply discards them; the returned CoreExpr + -- is just the rewrite of ru_fn applied to the first ru_nargs args + -- See Note [Extra args in rule matching] in Rules.lhs isBuiltinRule (BuiltinRule {}) = True isBuiltinRule _ = False +ruleArity :: CoreRule -> Int +ruleArity (BuiltinRule {ru_nargs = n}) = n +ruleArity (Rule {ru_args = args}) = length args + ruleName :: CoreRule -> RuleName ruleName = ru_name @@ -439,7 +477,7 @@ mkLets :: [Bind b] -> Expr b -> Expr b mkLams :: [b] -> Expr b -> Expr b mkLit lit = Lit lit -mkConApp con args = pprTrace "mkConApp" (ppr con) $ mkApps (Var (dataConWorkId con)) args +mkConApp con args = mkApps (Var (dataConWorkId con)) args mkLams binders body = foldr Lam body binders mkLets binds body = foldr Let body binds @@ -603,7 +641,6 @@ seqExpr (Lit lit) = lit `seq` () seqExpr (App f a) = seqExpr f `seq` seqExpr a seqExpr (Lam b e) = seqBndr b `seq` seqExpr e seqExpr (Let b e) = seqBind b `seq` seqExpr e --- gaw 2004 seqExpr (Case e b t as) = seqExpr e `seq` seqBndr b `seq` seqType t `seq` seqAlts as seqExpr (Cast e co) = seqExpr e `seq` seqType co seqExpr (Note n e) = seqNote n `seq` seqExpr e @@ -651,7 +688,6 @@ data AnnExpr' bndr annot | AnnLit Literal | AnnLam bndr (AnnExpr bndr annot) | AnnApp (AnnExpr bndr annot) (AnnExpr bndr annot) --- gaw 2004 | AnnCase (AnnExpr bndr annot) bndr Type [AnnAlt bndr annot] | AnnLet (AnnBind bndr annot) (AnnExpr bndr annot) | AnnCast (AnnExpr bndr annot) Coercion @@ -683,7 +719,6 @@ deAnnotate' (AnnLet bind body) deAnnBind (AnnNonRec var rhs) = NonRec var (deAnnotate rhs) deAnnBind (AnnRec pairs) = Rec [(v,deAnnotate rhs) | (v,rhs) <- pairs] --- gaw 2004 deAnnotate' (AnnCase scrut v t alts) = Case (deAnnotate scrut) v t (map deAnnAlt alts)