X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FdeSugar%2FDsUtils.lhs;h=071953f20112fc5b8aa545b452230bf4113f47ff;hb=9ca17cfcd9d1dc84bea3f19b60b9055f02ef7736;hp=553b4688322f3d361cc6135d1c4e5aafb289909a;hpb=1b1190e01d0c65043628d2532988d9b1b4a78384;p=ghc-hetmet.git

diff --git a/compiler/deSugar/DsUtils.lhs b/compiler/deSugar/DsUtils.lhs
index 553b468..071953f 100644
--- a/compiler/deSugar/DsUtils.lhs
+++ b/compiler/deSugar/DsUtils.lhs
@@ -168,8 +168,8 @@ mk_val_app (Var f `App` Type ty1 `App` Type _ `App` arg1) arg2 _ res_ty
   = Case arg1 case_bndr res_ty [(DEFAULT,[],arg2)]
   where
     case_bndr = case arg1 of
-		   Var v1 -> v1	-- Note [Desugaring seq (2)]
-		   _      -> mkWildId ty1
+		   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
@@ -220,7 +220,7 @@ the seq, by re-introducing the space leak:
 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.  Perhpas we
+But this is fragile.  The real culprit is the source program.  Perhaps we
 should have said explicitly
    let !chp2 = chp in ...chp2...
 
@@ -234,6 +234,15 @@ 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'. 
+
+
 %************************************************************************
 %*									*
 \subsection{ Selecting match variables}
@@ -532,15 +541,15 @@ mkErrorAppDs err_id ty msg = do
 \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
@@ -797,17 +806,18 @@ mkLHsVarTup ids  = mkLHsTup (map nlHsVar ids)
 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
@@ -823,7 +833,6 @@ mkBigLHsVarPatTup bs = mkBigLHsPatTup (map nlVarPat bs)
 
 mkBigLHsPatTup :: [LPat Id] -> LPat Id
 mkBigLHsPatTup = mkBigTuple mkLHsPatTup
-
 \end{code}