Fix Trac #3259: expose 'lazy' only after generating interface files

This patch fixes an insidious and long-standing bug in the way that
parallelism is handled in GHC.  See Note [lazyId magic] in MkId.

Here's the diagnosis, copied from the Trac ticket.  par is defined 
in GHC.Conc thus:

    {-# INLINE par  #-}
    par :: a -> b -> b
    par  x y = case (par# x) of { _ -> lazy y }

    -- The reason for the strange "lazy" call is that it fools the
    -- compiler into thinking that pseq and par are non-strict in
    -- their second argument (even if it inlines pseq/par at the call
    -- site).  If it thinks par is strict in "y", then it often
    -- evaluates "y" before "x", which is totally wrong.

The function lazy is the identity function, but it is inlined only
after strictness analysis, and (via some magic) pretends to be
lazy. Hence par pretends to be lazy too.

The trouble is that both par and lazy are inlined into your definition
of parallelise, so that the unfolding for parallelise (exposed in
Parallelise.hi) does not use lazy at all. Then when compiling Main,
parallelise is in turn inlined (before strictness analysis), and so
the strictness analyser sees too much.

This was all sloppy thinking on my part. Inlining lazy after
strictness analysis works fine for the current module, but not for
importing modules.

The fix implemented by this patch is to inline 'lazy' in CorePrep,
not in WorkWrap. That way interface files never see the inlined version.

The downside is that a little less optimisation may happen on programs
that use 'lazy'.  And you'll only see this in the results -ddump-prep
not in -ddump-simpl.  So KEEP AN EYE OUT (Simon and Satnam especially).
Still, it should work properly now.  Certainly fixes #3259.

3 files changed, 36 insertions, 30 deletions

diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs
index b28b985e7f..a85b69c682 100644
--- a/compiler/basicTypes/MkId.lhs
+++ b/compiler/basicTypes/MkId.lhs
@@ -33,7 +33,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,
+        lazyId, lazyIdKey,
 
         mkRuntimeErrorApp, mkImpossibleExpr,
         rEC_CON_ERROR_ID, iRREFUT_PAT_ERROR_ID, rUNTIME_ERROR_ID,
@@ -920,29 +920,34 @@ seqId = pcMiscPrelId seqName ty info
     rhs = mkLams [alphaTyVar,openBetaTyVar,x,y] (Case (Var x) x openBetaTy [(DEFAULT, [], Var y)])
 
 ------------------------------------------------
-lazyId :: Id
--- lazy :: forall a?. a? -> a?   (i.e. works for unboxed types too)
--- Used to lazify pseq:         pseq a b = a `seq` lazy b
--- 
--- Also, no strictness: by being a built-in Id, all the info about lazyId comes from here,
--- not from GHC.Base.hi.   This is important, because the strictness
--- analyser will spot it as strict!
---
--- Also no unfolding in lazyId: it gets "inlined" by a HACK in the worker/wrapperpass
---      (see WorkWrap.wwExpr)   
--- We could use inline phases to do this, but that would be vulnerable to changes in 
--- phase numbering....we must inline precisely after strictness analysis.
+lazyId :: Id	-- See Note [lazyId magic]
 lazyId = pcMiscPrelId lazyIdName ty info
   where
     info = noCafIdInfo
     ty  = mkForAllTys [alphaTyVar] (mkFunTy alphaTy alphaTy)
-
-lazyIdUnfolding :: CoreExpr     -- Used to expand 'lazyId' after strictness anal
-lazyIdUnfolding = mkLams [openAlphaTyVar,x] (Var x)
-                where
-                  [x] = mkTemplateLocals [openAlphaTy]
 \end{code}
 
+Note [lazyId magic]
+~~~~~~~~~~~~~~~~~~~
+    lazy :: forall a?. a? -> a?   (i.e. works for unboxed types too)
+
+Used to lazify pseq:   pseq a b = a `seq` lazy b
+
+Also, no strictness: by being a built-in Id, all the info about lazyId comes from here,
+not from GHC.Base.hi.   This is important, because the strictness
+analyser will spot it as strict!
+
+Also no unfolding in lazyId: it gets "inlined" by a HACK in CorePrep.
+It's very important to do this inlining *after* unfoldings are exposed 
+in the interface file.  Otherwise, the unfolding for (say) pseq in the
+interface file will not mention 'lazy', so if we inline 'pseq' we'll totally
+miss the very thing that 'lazy' was there for in the first place.
+See Trac #3259 for a real world example.
+
+lazyId is defined in GHC.Base, so we don't *have* to inline it.  If it
+appears un-applied, we'll end up just calling it.
+
+-------------------------------------------------------------
 @realWorld#@ used to be a magic literal, \tr{void#}.  If things get
 nasty as-is, change it back to a literal (@Literal@).
 
diff --git a/compiler/coreSyn/CorePrep.lhs b/compiler/coreSyn/CorePrep.lhs
index 3a6d037979..89ec98f6f2 100644
--- a/compiler/coreSyn/CorePrep.lhs
+++ b/compiler/coreSyn/CorePrep.lhs
@@ -11,6 +11,7 @@ module CorePrep (
 
 #include "HsVersions.h"
 
+import PrelNames	( lazyIdKey, hasKey )
 import CoreUtils
 import CoreArity
 import CoreFVs
@@ -89,6 +90,8 @@ The goal of this pass is to prepare for code generation.
     We want curried definitions for all of these in case they
     aren't inlined by some caller.
 	
+9.  Replace (lazy e) by e.  See Note [lazyId magic] in MkId.lhs
+
 This is all done modulo type applications and abstractions, so that
 when type erasure is done for conversion to STG, we don't end up with
 any trivial or useless bindings.
@@ -341,9 +344,14 @@ cpeRhsE :: CorePrepEnv -> CoreExpr -> UniqSM (Floats, CpeRhs)
 
 cpeRhsE _env expr@(Type _) = return (emptyFloats, expr)
 cpeRhsE _env expr@(Lit _)  = return (emptyFloats, expr)
-cpeRhsE env expr@(App {})  = cpeApp env expr
 cpeRhsE env expr@(Var {})  = cpeApp env expr
 
+cpeRhsE env (Var f `App` _ `App` arg)
+  | f `hasKey` lazyIdKey  	  -- Replace (lazy a) by a
+  = cpeRhsE env arg		  -- See Note [lazyId magic] in MkId
+
+cpeRhsE env expr@(App {}) = cpeApp env expr
+
 cpeRhsE env (Let bind expr)
   = do { (env', new_binds) <- cpeBind NotTopLevel env bind
        ; (floats, body) <- cpeRhsE env' expr
@@ -475,7 +483,7 @@ cpeApp env expr
 
     collect_args (App fun arg) depth
       = do { (fun',hd,fun_ty,floats,ss) <- collect_args fun (depth+1)
-           ; let
+      	   ; let
               (ss1, ss_rest)   = case ss of
                                    (ss1:ss_rest) -> (ss1,     ss_rest)
                                    []            -> (lazyDmd, [])
diff --git a/compiler/stranal/WorkWrap.lhs b/compiler/stranal/WorkWrap.lhs
index 772a8623f3..a3219abb20 100644
--- a/compiler/stranal/WorkWrap.lhs
+++ b/compiler/stranal/WorkWrap.lhs
@@ -15,14 +15,12 @@ import Id		( Id, idType, isOneShotLambda, idUnfolding,
 			  setIdNewStrictness, mkWorkerId,
 			  setIdWorkerInfo, setInlineActivation,
 			  setIdArity, idInfo )
-import MkId		( lazyIdKey, lazyIdUnfolding )
 import Type		( Type )
 import IdInfo
 import NewDemand        ( Demand(..), StrictSig(..), DmdType(..), DmdResult(..), 
 			  Demands(..), mkTopDmdType, isBotRes, returnsCPR, topSig, isAbsent
 			)
 import UniqSupply
-import Unique		( hasKey )
 import BasicTypes	( RecFlag(..), isNonRec, isNeverActive,
                           Activation, inlinePragmaActivation )
 import VarEnv		( isEmptyVarEnv )
@@ -107,17 +105,12 @@ matching by looking for strict arguments of the correct type.
 \begin{code}
 wwExpr :: CoreExpr -> UniqSM CoreExpr
 
-wwExpr e@(Type _)          = return e
-wwExpr e@(Lit _)           = return e
+wwExpr e@(Type {})         = return e
+wwExpr e@(Lit  {})         = return e
+wwExpr e@(Var  {})         = return e
 wwExpr e@(Note InlineMe _) = return e
 	-- Don't w/w inside InlineMe's
 
-wwExpr e@(Var v)
-  | v `hasKey` lazyIdKey = return lazyIdUnfolding
-  | otherwise            = return e
-	-- HACK alert: Inline 'lazy' after strictness analysis
-	-- (but not inside InlineMe's)
-
 wwExpr (Lam binder expr)
   = Lam binder <$> wwExpr expr