(arg_ty, res_ty) = splitFunTy fun_ty
-----------
mk_val_app :: CoreExpr -> CoreExpr -> Type -> Type -> CoreExpr
+mk_val_app (Var f `App` Type ty1 `App` Type _ `App` arg1) arg2 _ res_ty
+ | f == seqId -- Note [Desugaring seq (1), (2)]
+ = Case arg1 case_bndr res_ty [(DEFAULT,[],arg2)]
+ where
+ case_bndr = case arg1 of
+ Var v1 | isLocalId v1 -> v1 -- Note [Desugaring seq (2) and (3)]
+ _ -> mkWildId ty1
+
mk_val_app fun arg arg_ty _ -- See Note [CoreSyn let/app invariant]
| not (isUnLiftedType arg_ty) || exprOkForSpeculation arg
= App fun arg -- The vastly common case
-mk_val_app (Var f `App` Type ty1 `App` Type _ `App` arg1) arg2 _ res_ty
- | f == seqId -- Note [Desugaring seq]
- = Case arg1 (mkWildId ty1) res_ty [(DEFAULT,[],arg2)]
-
mk_val_app fun arg arg_ty res_ty
= Case arg (mkWildId arg_ty) res_ty [(DEFAULT,[],App fun (Var arg_id))]
where
-- because 'fun ' should not have a free wild-id
\end{code}
-Note [Desugaring seq] cf Trac #1031
-~~~~~~~~~~~~~~~~~~~~~
+Note [Desugaring seq (1)] cf Trac #1031
+~~~~~~~~~~~~~~~~~~~~~~~~~
f x y = x `seq` (y `seq` (# x,y #))
The [CoreSyn let/app invariant] means that, other things being equal, because
Seq is very, very special! So we recognise it right here, and desugar to
case x of _ -> case y of _ -> (# x,y #)
-The special case would be valid for all calls to 'seq', but it's only *necessary*
-for ones whose second argument has an unlifted type. So we only catch the latter
-case here, to avoid unnecessary tests.
+Note [Desugaring seq (2)] cf Trac #2231
+~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider
+ let chp = case b of { True -> fst x; False -> 0 }
+ in chp `seq` ...chp...
+Here the seq is designed to plug the space leak of retaining (snd x)
+for too long.
+
+If we rely on the ordinary inlining of seq, we'll get
+ let chp = case b of { True -> fst x; False -> 0 }
+ case chp of _ { I# -> ...chp... }
+
+But since chp is cheap, and the case is an alluring contet, we'll
+inline chp into the case scrutinee. Now there is only one use of chp,
+so we'll inline a second copy. Alas, we've now ruined the purpose of
+the seq, by re-introducing the space leak:
+ case (case b of {True -> fst x; False -> 0}) of
+ I# _ -> ...case b of {True -> fst x; False -> 0}...
+
+We can try to avoid doing this by ensuring that the binder-swap in the
+case happens, so we get his at an early stage:
+ case chp of chp2 { I# -> ...chp2... }
+But this is fragile. The real culprit is the source program. Perhaps we
+should have said explicitly
+ let !chp2 = chp in ...chp2...
+
+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:
+ 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.
+
+The reason it's a hack is because if you define mySeq=seq, the hack
+won't work on mySeq.
+
+Note [Desugaring seq (3)] cf Trac #2409
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The isLocalId ensures that we don't turn
+ True `seq` e
+into
+ case True of True { ... }
+which stupidly tries to bind the datacon 'True'.
%************************************************************************
wrapBinds ((new,old):prs) e = wrapBind new old (wrapBinds prs e)
wrapBind :: Var -> Var -> CoreExpr -> CoreExpr
-wrapBind new old body
+wrapBind new old body -- Can deal with term variables *or* type variables
| new==old = body
- | isTyVar new = App (Lam new body) (Type (mkTyVarTy old))
- | otherwise = Let (NonRec new (Var old)) body
+ | isTyVar new = Let (mkTyBind new (mkTyVarTy old)) body
+ | otherwise = Let (NonRec new (Var old)) body
seqVar :: Var -> CoreExpr -> CoreExpr
seqVar var body = Case (Var var) var (exprType body)
\end{code}
-*************************************************************
+%************************************************************************
%* *
\subsection{Making literals}
%* *
%************************************************************************
\begin{code}
-mkCharExpr :: Char -> CoreExpr -- Returns C# c :: Int
-mkIntExpr :: Integer -> CoreExpr -- Returns I# i :: Int
+mkCharExpr :: Char -> CoreExpr -- Returns @C# c :: Int@
+mkIntExpr :: Integer -> CoreExpr -- Returns @I# i :: Int@
mkIntegerExpr :: Integer -> DsM CoreExpr -- Result :: Integer
mkStringExpr :: String -> DsM CoreExpr -- Result :: String
mkStringExprFS :: FastString -> DsM CoreExpr -- Result :: String
mkLHsTup :: [LHsExpr Id] -> LHsExpr Id
mkLHsTup [] = nlHsVar unitDataConId
mkLHsTup [lexp] = lexp
-mkLHsTup lexps = noLoc $ ExplicitTuple lexps Boxed
-
+mkLHsTup lexps = L (getLoc (head lexps)) $
+ ExplicitTuple lexps Boxed
-- Smart constructors for source tuple patterns
mkLHsVarPatTup :: [Id] -> LPat Id
mkLHsVarPatTup bs = mkLHsPatTup (map nlVarPat bs)
mkLHsPatTup :: [LPat Id] -> LPat Id
+mkLHsPatTup [] = noLoc $ mkVanillaTuplePat [] Boxed
mkLHsPatTup [lpat] = lpat
-mkLHsPatTup lpats = noLoc $ mkVanillaTuplePat lpats Boxed -- Handles the case where lpats = [] gracefully
-
+mkLHsPatTup lpats = L (getLoc (head lpats)) $
+ mkVanillaTuplePat lpats Boxed
-- The Big equivalents for the source tuple expressions
mkBigLHsVarTup :: [Id] -> LHsExpr Id
mkBigLHsPatTup :: [LPat Id] -> LPat Id
mkBigLHsPatTup = mkBigTuple mkLHsPatTup
-
\end{code}