%
+% (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,
mkLets, mkLams,
mkApps, mkTyApps, mkValApps, mkVarApps,
mkLit, mkIntLitInt, mkIntLit,
- mkConApp,
- varToCoreExpr,
+ mkConApp, mkCast,
+ varToCoreExpr, varsToCoreExprs,
isTyVar, isId, cmpAltCon, cmpAlt, ltAlt,
bindersOf, bindersOfBinds, rhssOfBind, rhssOfAlts,
-- 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 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
+
+infixl 4 `mkApps`, `mkValApps`, `mkTyApps`, `mkVarApps`
+-- Left associative, so that we can say (f `mkTyApps` xs `mkVarApps` ys)
\end{code}
%************************************************************************
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)
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
- | Coerce
- Type -- The to-type: type of whole coerce expression
- Type -- The from-type: type of enclosed expression
-
| InlineMe -- Instructs simplifer to treat the enclosed expression
-- as very small, and inline it at its call sites
-- 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.
-
%************************************************************************
%* *
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
varToCoreExpr :: CoreBndr -> Expr b
varToCoreExpr v | isId v = Var v
| otherwise = Type (mkTyVarTy v)
+
+varsToCoreExprs :: [CoreBndr] -> [Expr b]
+varsToCoreExprs vs = map varToCoreExpr vs
+
+mkCast :: Expr b -> Coercion -> Expr b
+mkCast e co = Cast e co
\end{code}
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
seqExpr (Type t) = seqType t
seqExprs [] = ()
seqExprs (e:es) = seqExpr e `seq` seqExprs es
-seqNote (Coerce t1 t2) = seqType t1 `seq` seqType t2
seqNote (CoreNote s) = s `seq` ()
seqNote other = ()
| 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
| AnnNote Note (AnnExpr bndr annot)
| AnnType Type
deAnnotate' (AnnLit lit) = Lit lit
deAnnotate' (AnnLam binder body) = Lam binder (deAnnotate body)
deAnnotate' (AnnApp fun arg) = App (deAnnotate fun) (deAnnotate arg)
+deAnnotate' (AnnCast e co) = Cast (deAnnotate e) co
deAnnotate' (AnnNote note body) = Note note (deAnnotate body)
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)
projects / ghc-hetmet.git / blobdiff