From: simonpj Date: Tue, 18 Jun 2002 13:58:24 +0000 (+0000) Subject: [project @ 2002-06-18 13:58:22 by simonpj] X-Git-Tag: Approx_11550_changesets_converted~1953 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;ds=sidebyside;h=80e399639dc521561cc9fe33e6f24079c4eae609;p=ghc-hetmet.git [project @ 2002-06-18 13:58:22 by simonpj] --------------------------------------- Rehash the handling of SeqOp --------------------------------------- See the comments in the commentary (Cunning Prelude Code). * Expunge SeqOp altogether * Add GHC.Base.lazy :: a -> a to GHC.Base * Add GHC.Base.lazy to basicTypes/MkId. The idea is that this defn will over-ride the info from GHC.Base.hi, thereby hiding strictness and unfolding * Make stranal/WorkWrap do a "manual inlining" for GHC.Base.lazy This happens nicely after the strictness analyser has run. * Expunge the SeqOp/ParOp magic in CorePrep * Expunge the RULE for seq in PrelRules * Change the defns of pseq/par in GHC.Conc to: {-# INLINE pseq #-} pseq :: a -> b -> b pseq x y = x `seq` lazy y {-# INLINE par #-} par :: a -> b -> b par x y = case (par# x) of { _ -> lazy y } --- diff --git a/ghc/compiler/basicTypes/MkId.lhs b/ghc/compiler/basicTypes/MkId.lhs index 9382d57..d8fab3c 100644 --- a/ghc/compiler/basicTypes/MkId.lhs +++ b/ghc/compiler/basicTypes/MkId.lhs @@ -25,6 +25,7 @@ module MkId ( -- 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, @@ -128,7 +129,9 @@ wiredInIds 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 @@ -838,6 +841,23 @@ seqId (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 diff --git a/ghc/compiler/codeGen/CgExpr.lhs b/ghc/compiler/codeGen/CgExpr.lhs index 2076a07..2894de2 100644 --- a/ghc/compiler/codeGen/CgExpr.lhs +++ b/ghc/compiler/codeGen/CgExpr.lhs @@ -1,7 +1,7 @@ % % (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 $ % %******************************************************** %* * @@ -150,9 +150,7 @@ cgExpr x@(StgOpApp op@(StgPrimOp primop) args res_ty) = 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 diff --git a/ghc/compiler/coreSyn/CorePrep.lhs b/ghc/compiler/coreSyn/CorePrep.lhs index 5b18681..6e109c8 100644 --- a/ghc/compiler/coreSyn/CorePrep.lhs +++ b/ghc/compiler/coreSyn/CorePrep.lhs @@ -64,7 +64,7 @@ The goal of this pass is to prepare for code generation. 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 @@ -359,7 +359,7 @@ corePrepExprFloat env (Case scrut bndr alts) = 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') -> @@ -532,7 +532,7 @@ mkBinds binds body | 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 @@ -636,55 +636,6 @@ tryEta bndrs _ = Nothing -- ----------------------------------------------------------------------------- --- 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 -- ----------------------------------------------------------------------------- diff --git a/ghc/compiler/prelude/PrelNames.lhs b/ghc/compiler/prelude/PrelNames.lhs index dafee0d..b99e354 100644 --- a/ghc/compiler/prelude/PrelNames.lhs +++ b/ghc/compiler/prelude/PrelNames.lhs @@ -949,6 +949,7 @@ runMainKey = mkPreludeMiscIdUnique 56 andIdKey = mkPreludeMiscIdUnique 57 orIdKey = mkPreludeMiscIdUnique 58 thenIOIdKey = mkPreludeMiscIdUnique 59 +lazyIdKey = mkPreludeMiscIdUnique 60 -- Parallel array functions nullPIdKey = mkPreludeMiscIdUnique 70 diff --git a/ghc/compiler/prelude/PrelRules.lhs b/ghc/compiler/prelude/PrelRules.lhs index 5f0981c..62b8cfc 100644 --- a/ghc/compiler/prelude/PrelRules.lhs +++ b/ghc/compiler/prelude/PrelRules.lhs @@ -66,7 +66,6 @@ primOpRules op = primop_rule op -- 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 @@ -357,66 +356,6 @@ mkDoubleVal d = Lit (convFloating (MachDouble d)) %* * %************************************************************************ -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 ) diff --git a/ghc/compiler/prelude/primops.txt.pp b/ghc/compiler/prelude/primops.txt.pp index fc134c0..a1ff417 100644 --- a/ghc/compiler/prelude/primops.txt.pp +++ b/ghc/compiler/prelude/primops.txt.pp @@ -1,5 +1,5 @@ ----------------------------------------------------------------------- --- $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 -- @@ -1534,14 +1534,6 @@ primop ReallyUnsafePtrEqualityOp "reallyUnsafePtrEquality#" GenPrimOp 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 diff --git a/ghc/compiler/stranal/WorkWrap.lhs b/ghc/compiler/stranal/WorkWrap.lhs index 89417f4..2cdda70 100644 --- a/ghc/compiler/stranal/WorkWrap.lhs +++ b/ghc/compiler/stranal/WorkWrap.lhs @@ -12,10 +12,11 @@ import CoreSyn 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 @@ -24,6 +25,7 @@ import NewDemand ( Demand(..), StrictSig(..), DmdType(..), DmdResult(..), 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 ) @@ -127,9 +129,16 @@ matching by looking for strict arguments of the correct type. \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 ->