-- And some particular Ids; see below for why they are wired in
wiredInIds, ghcPrimIds,
unsafeCoerceId, realWorldPrimId, voidArgId, nullAddrId, seqId,
+ lazyId, lazyIdUnfolding, lazyIdKey,
mkRuntimeErrorApp,
rEC_CON_ERROR_ID, iRREFUT_PAT_ERROR_ID, rUNTIME_ERROR_ID,
nON_EXHAUSTIVE_GUARDS_ERROR_ID,
nO_METHOD_BINDING_ERROR_ID,
pAT_ERROR_ID,
- rEC_CON_ERROR_ID
+ rEC_CON_ERROR_ID,
+
+ lazyId
] ++ ghcPrimIds
-- These Ids are exported from GHC.Prim
(mkFunTy alphaTy (mkFunTy betaTy betaTy))
[x,y] = mkTemplateLocals [alphaTy, betaTy]
rhs = mkLams [alphaTyVar,betaTyVar,x,y] (Case (Var x) x [(DEFAULT, [], Var y)])
+
+-- lazy :: forall a?. a? -> a? (i.e. works for unboxed types too)
+-- Used to lazify pseq: pseq a b = a `seq` lazy b
+-- No unfolding: it gets "inlined" by the worker/wrapper pass
+-- Also, no strictness: by being a built-in Id, it overrides all
+-- the info in PrelBase.hi. This is important, because the strictness
+-- analyser will spot it as strict!
+lazyId
+ = pcMiscPrelId lazyIdKey pREL_BASE FSLIT("lazy") ty info
+ where
+ info = noCafIdInfo
+ ty = mkForAllTys [alphaTyVar] (mkFunTy alphaTy alphaTy)
+
+lazyIdUnfolding :: CoreExpr -- Used to expand LazyOp after strictness anal
+lazyIdUnfolding = mkLams [openAlphaTyVar,x] (Var x)
+ where
+ [x] = mkTemplateLocals [openAlphaTy]
\end{code}
@getTag#@ is another function which can't be defined in Haskell. It needs to
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: CgExpr.lhs,v 1.48 2002/04/29 14:03:41 simonmar Exp $
+% $Id: CgExpr.lhs,v 1.49 2002/06/18 13:58:23 simonpj Exp $
%
%********************************************************
%* *
= tailCallPrimOp primop args
| otherwise
- = ASSERT(primop /= SeqOp) -- can't handle SeqOp
-
- getArgAmodes args `thenFC` \ arg_amodes ->
+ = getArgAmodes args `thenFC` \ arg_amodes ->
case (getPrimOpResultInfo primop) of
4. Ensure that lambdas only occur as the RHS of a binding
(The code generator can't deal with anything else.)
-5. Do the seq/par munging. See notes with mkCase below.
+5. [Not any more; nuked Jun 2002] Do the seq/par munging.
6. Clone all local Ids.
This means that all such Ids are unique, rather than the
= corePrepExprFloat env scrut `thenUs` \ (floats, scrut') ->
cloneBndr env bndr `thenUs` \ (env', bndr') ->
mapUs (sat_alt env') alts `thenUs` \ alts' ->
- returnUs (floats, mkCase scrut' bndr' alts')
+ returnUs (floats, Case scrut' bndr' alts')
where
sat_alt env (con, bs, rhs)
= cloneBndrs env bs `thenUs` \ (env', bs') ->
| otherwise = deLam body `thenUs` \ body' ->
returnUs (foldrOL mk_bind body' binds)
where
- mk_bind (FloatCase bndr rhs _) body = mkCase rhs bndr [(DEFAULT, [], body)]
+ mk_bind (FloatCase bndr rhs _) body = Case rhs bndr [(DEFAULT, [], body)]
mk_bind (FloatLet bind) body = Let bind body
etaExpandRhs bndr rhs
-- -----------------------------------------------------------------------------
--- Do the seq and par transformation
--- -----------------------------------------------------------------------------
-
-Here we do two pre-codegen transformations:
-
-1. case seq# a of {
- 0 -> seqError ...
- DEFAULT -> rhs }
- ==>
- case a of { DEFAULT -> rhs }
-
-
-2. case par# a of {
- 0 -> parError ...
- DEFAULT -> rhs }
- ==>
- case par# a of {
- DEFAULT -> rhs }
-
-NB: seq# :: a -> Int# -- Evaluate value and return anything
- par# :: a -> Int# -- Spark value and return anything
-
-These transformations can't be done earlier, or else we might
-think that the expression was strict in the variables in which
-rhs is strict --- but that would defeat the purpose of seq and par.
-
-
-\begin{code}
-mkCase scrut@(Var fn `App` Type ty `App` arg) bndr alts@(deflt_alt@(DEFAULT,_,rhs) : con_alts)
- -- DEFAULT alt is always first
- = case isPrimOpId_maybe fn of
- Just ParOp -> Case scrut bndr [deflt_alt]
- Just SeqOp -> Case arg new_bndr [deflt_alt]
- other -> Case scrut bndr alts
- where
- -- The binder shouldn't be used in the expression!
- new_bndr = ASSERT2( not (bndr `elemVarSet` exprFreeVars rhs), ppr bndr )
- setIdType bndr (exprType arg)
- -- NB: SeqOp :: forall a. a -> Int#
- -- So bndr has type Int#
- -- But now we are going to scrutinise the SeqOp's argument directly,
- -- so we must change the type of the case binder to match that
- -- of the argument expression e.
-
-mkCase scrut bndr alts = Case scrut bndr alts
-\end{code}
-
-
--- -----------------------------------------------------------------------------
-- Demands
-- -----------------------------------------------------------------------------
andIdKey = mkPreludeMiscIdUnique 57
orIdKey = mkPreludeMiscIdUnique 58
thenIOIdKey = mkPreludeMiscIdUnique 59
+lazyIdKey = mkPreludeMiscIdUnique 60
-- Parallel array functions
nullPIdKey = mkPreludeMiscIdUnique 70
-- ToDo: something for integer-shift ops?
-- NotOp
- primop_rule SeqOp = one_rule seqRule
primop_rule TagToEnumOp = one_rule tagToEnumRule
primop_rule DataToTagOp = one_rule dataToTagRule
%* *
%************************************************************************
-In the parallel world, we use _seq_ to control the order in which
-certain expressions will be evaluated. Operationally, the expression
-``_seq_ a b'' evaluates a and then evaluates b. We have an inlining
-for _seq_ which translates _seq_ to:
-
- _seq_ = /\ a b -> \ x::a y::b -> case seq# x of { 0# -> parError#; _ -> y }
-
-Now, we know that the seq# primitive will never return 0#, but we
-don't let the simplifier know that. We also use a special error
-value, parError#, which is *not* a bottoming Id, so as far as the
-simplifier is concerned, we have to evaluate seq# a before we know
-whether or not y will be evaluated.
-
-If we didn't have the extra case, then after inlining the compiler might
-see:
- f p q = case seq# p of { _ -> p+q }
-
-If it sees that, it can see that f is strict in q, and hence it might
-evaluate q before p! The "0# ->" case prevents this happening.
-By having the parError# branch we make sure that anything in the
-other branch stays there!
-
-This is fine, but we'd like to get rid of the extraneous code. Hence,
-we *do* let the simplifier know that seq# is strict in its argument.
-As a result, we hope that `a' will be evaluated before seq# is called.
-At this point, we have a very special and magical simpification which
-says that ``seq# a'' can be immediately simplified to `1#' if we
-know that `a' is already evaluated.
-
-NB: If we ever do case-floating, we have an extra worry:
-
- case a of
- a' -> let b' = case seq# a of { True -> b; False -> parError# }
- in case b' of ...
-
- =>
-
- case a of
- a' -> let b' = case True of { True -> b; False -> parError# }
- in case b' of ...
-
- =>
-
- case a of
- a' -> let b' = b
- in case b' of ...
-
- =>
-
- case a of
- a' -> case b of ...
-
-The second case must never be floated outside of the first!
-
-\begin{code}
-seqRule [Type ty, arg] | exprIsValue arg = Just (mkIntVal 1)
-seqRule other = Nothing
-\end{code}
-
-
\begin{code}
tagToEnumRule [Type ty, Lit (MachInt i)]
= ASSERT( isEnumerationTyCon tycon )
-----------------------------------------------------------------------
--- $Id: primops.txt.pp,v 1.19 2002/05/01 13:16:04 simonmar Exp $
+-- $Id: primops.txt.pp,v 1.20 2002/06/18 13:58:24 simonpj Exp $
--
-- Primitive Operations
--
section "Parallelism"
------------------------------------------------------------------------
-primop SeqOp "seq#" GenPrimOp
- a -> Int#
- with
- usage = { mangle SeqOp [mkO] mkR }
- strictness = { \ arity -> mkStrictSig (mkTopDmdType [evalDmd] TopRes) }
- -- Seq is strict in its argument; see notes in ConFold.lhs
- has_side_effects = True
-
primop ParOp "par#" GenPrimOp
a -> Int#
with
import CoreUnfold ( certainlyWillInline )
import CoreLint ( showPass, endPass )
import CoreUtils ( exprType, exprIsValue )
-import Id ( Id, idType, isOneShotLambda,
+import Id ( Id, idType, isOneShotLambda,
setIdNewStrictness, mkWorkerId,
setIdWorkerInfo, setInlinePragma,
idInfo )
+import MkId ( lazyIdKey, lazyIdUnfolding )
import Type ( Type )
import IdInfo ( WorkerInfo(..), arityInfo,
newDemandInfo, newStrictnessInfo, unfoldingInfo, inlinePragInfo
Demands(..), mkTopDmdType, isBotRes, returnsCPR, topSig, isAbsent
)
import UniqSupply ( UniqSupply, initUs_, returnUs, thenUs, mapUs, getUniqueUs, UniqSM )
+import Unique ( hasKey )
import BasicTypes ( RecFlag(..), isNonRec, Activation(..) )
import VarEnv ( isEmptyVarEnv )
import Maybes ( orElse )
\begin{code}
wwExpr :: CoreExpr -> UniqSM CoreExpr
-wwExpr e@(Type _) = returnUs e
-wwExpr e@(Var _) = returnUs e
-wwExpr e@(Lit _) = returnUs e
+wwExpr e@(Type _) = returnUs e
+wwExpr e@(Lit _) = returnUs e
+wwExpr e@(Note InlineMe expr) = returnUs expr
+ -- Don't w/w inside InlineMe's
+
+wwExpr e@(Var v)
+ | v `hasKey` lazyIdKey = returnUs lazyIdUnfolding
+ | otherwise = returnUs e
+ -- Inline 'lazy' after strictness analysis
+ -- (but not inside InlineMe's)
wwExpr (Lam binder expr)
= wwExpr expr `thenUs` \ new_expr ->
projects / ghc-hetmet.git / commitdiff