X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FdeSugar%2FDsBinds.lhs;h=0c8e37a0bba96f79296f9cf79cf2e6d014062263;hb=708533dec3189bb624c8467627055a78de07e52b;hp=4c144b8e507ba201100dc1f73fa38bec7f9f7bc6;hpb=2dce32ca5188120ca220a36139ff216b852b389e;p=ghc-hetmet.git

diff --git a/compiler/deSugar/DsBinds.lhs b/compiler/deSugar/DsBinds.lhs
index 4c144b8..0c8e37a 100644
--- a/compiler/deSugar/DsBinds.lhs
+++ b/compiler/deSugar/DsBinds.lhs
@@ -36,11 +36,11 @@ import TcType
 import CostCentre
 import Module
 import Id
+import MkId	( seqId )
 import Var	( Var, TyVar )
 import VarSet
 import Rules
 import VarEnv
-import Type
 import Outputable
 import SrcLoc
 import Maybes
@@ -476,6 +476,12 @@ decomposeRuleLhs lhs
         -- a LHS:       let f71 = M.f Int in f71
     decomp env (Let (NonRec dict rhs) body) 
         = decomp (extendVarEnv env dict (simpleSubst env rhs)) body
+
+    decomp env (Case scrut bndr ty [(DEFAULT, _, body)])
+        | isDeadBinder bndr	-- Note [Matching seqId]
+        = Just (seqId, [Type (idType bndr), Type ty, 
+                        simpleSubst env scrut, simpleSubst env body])
+
     decomp env body 
         = case collectArgs (simpleSubst env body) of
             (Var fn, args) -> Just (fn, args)
@@ -516,17 +522,23 @@ addInlinePrags prags bndr rhs
 	(inl:_) -> addInlineInfo inl bndr rhs
 
 addInlineInfo :: InlineSpec -> Id -> CoreExpr -> (Id,CoreExpr)
-addInlineInfo (Inline phase is_inline) bndr rhs
-  = (attach_phase bndr phase, wrap_inline is_inline rhs)
+addInlineInfo (Inline prag is_inline) bndr rhs
+  = (attach_pragma bndr prag, wrap_inline is_inline rhs)
   where
-    attach_phase bndr phase 
-	| isAlwaysActive phase = bndr	-- Default phase
-	| otherwise  	       = bndr `setInlinePragma` phase
+    attach_pragma bndr prag
+        | isDefaultInlinePragma prag = bndr
+        | otherwise                  = bndr `setInlinePragma` prag
 
     wrap_inline True  body = mkInlineMe body
     wrap_inline False body = body
 \end{code}
 
+Note [Matching seq]
+~~~~~~~~~~~~~~~~~~~
+The desugarer turns (seq e r) into (case e of _ -> r), via a special-case hack
+and this code turns it back into an application of seq!  
+See Note [Rules for seq] in MkId for the details.
+
 
 %************************************************************************
 %*									*