X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FdeSugar%2FDsUtils.lhs;h=25366faa597593c0e8ca92e9da03bf3c9e8da1c2;hp=f5650217d0c245ab515b853e465cadcc1a615410;hb=fb6d198f498d4e325a540f28aaa6e1d1530839c3;hpb=58521c72cec262496dabf5fffb057d25ab17a0f7

diff --git a/compiler/deSugar/DsUtils.lhs b/compiler/deSugar/DsUtils.lhs
index f565021..25366fa 100644
--- a/compiler/deSugar/DsUtils.lhs
+++ b/compiler/deSugar/DsUtils.lhs
@@ -419,7 +419,7 @@ But that is bad for two reasons:
 Seq is very, very special!  So we recognise it right here, and desugar to
         case x of _ -> case y of _ -> (# x,y #)
 
-Note [Desugaring seq (2)]  cf Trac #2231
+Note [Desugaring seq (2)]  cf Trac #2273
 ~~~~~~~~~~~~~~~~~~~~~~~~~
 Consider
    let chp = case b of { True -> fst x; False -> 0 }
@@ -447,10 +447,14 @@ should have said explicitly
 
 But that's painful.  So the code here does a little hack to make seq
 more robust: a saturated application of 'seq' is turned *directly* into
-the case expression. So we desugar to:
+the case expression, thus:
+   x  `seq` e2 ==> case x of x -> e2    -- Note shadowing!
+   e1 `seq` e2 ==> case x of _ -> e2
+
+So we desugar our example to:
    let chp = case b of { True -> fst x; False -> 0 }
    case chp of chp { I# -> ...chp... }
-Notice the shadowing of the case binder! And now all is well.
+And now all is well.
 
 The reason it's a hack is because if you define mySeq=seq, the hack
 won't work on mySeq.  
@@ -600,7 +604,7 @@ mkLHsVarPatTup bs  = mkLHsPatTup (map nlVarPat bs)
 mkVanillaTuplePat :: [OutPat Id] -> Boxity -> Pat Id
 -- A vanilla tuple pattern simply gets its type from its sub-patterns
 mkVanillaTuplePat pats box 
-  = TuplePat pats box (mkTupleTy box (length pats) (map hsLPatType pats))
+  = TuplePat pats box (mkTupleTy box (map hsLPatType pats))
 
 -- The Big equivalents for the source tuple expressions
 mkBigLHsVarTup :: [Id] -> LHsExpr Id
@@ -674,23 +678,36 @@ Now @fail.33@ is a function, so it can be let-bound.
 \begin{code}
 mkFailurePair :: CoreExpr	-- Result type of the whole case expression
 	      -> DsM (CoreBind,	-- Binds the newly-created fail variable
-				-- to either the expression or \ _ -> expression
-		      CoreExpr)	-- Either the fail variable, or fail variable
-				-- applied to unit tuple
+				-- to \ _ -> expression
+		      CoreExpr)	-- Fail variable applied to realWorld#
+-- See Note [Failure thunks and CPR]
 mkFailurePair expr
-  | isUnLiftedType ty = do
-     fail_fun_var <- newFailLocalDs (unitTy `mkFunTy` ty)
-     fail_fun_arg <- newSysLocalDs unitTy
-     return (NonRec fail_fun_var (Lam fail_fun_arg expr),
-             App (Var fail_fun_var) (Var unitDataConId))
-
-  | otherwise = do
-     fail_var <- newFailLocalDs ty
-     return (NonRec fail_var expr, Var fail_var)
+  = do { fail_fun_var <- newFailLocalDs (realWorldStatePrimTy `mkFunTy` ty)
+       ; fail_fun_arg <- newSysLocalDs realWorldStatePrimTy
+       ; return (NonRec fail_fun_var (Lam fail_fun_arg expr),
+                 App (Var fail_fun_var) (Var realWorldPrimId)) }
   where
     ty = exprType expr
 \end{code}
 
+Note [Failure thunks and CPR]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+When we make a failure point we ensure that it
+does not look like a thunk. Example:
+
+   let fail = \rw -> error "urk"
+   in case x of 
+        [] -> fail realWorld#
+        (y:ys) -> case ys of
+                    [] -> fail realWorld#  
+                    (z:zs) -> (y,z)
+
+Reason: we know that a failure point is always a "join point" and is
+entered at most once.  Adding a dummy 'realWorld' token argument makes
+it clear that sharing is not an issue.  And that in turn makes it more
+CPR-friendly.  This matters a lot: if you don't get it right, you lose
+the tail call property.  For example, see Trac #3403.
+
 \begin{code}
 mkOptTickBox :: Maybe (Int,[Id]) -> CoreExpr -> DsM CoreExpr
 mkOptTickBox Nothing e   = return e