projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
thenIO, bindIO, returnIO moved to GHC.Base
[ghc-hetmet.git]
/
compiler
/
deSugar
/
DsBinds.lhs
diff --git
a/compiler/deSugar/DsBinds.lhs
b/compiler/deSugar/DsBinds.lhs
index
80a7cf6
..
0c8e37a
100644
(file)
--- a/
compiler/deSugar/DsBinds.lhs
+++ b/
compiler/deSugar/DsBinds.lhs
@@
-36,11
+36,11
@@
import TcType
import CostCentre
import Module
import Id
import CostCentre
import Module
import Id
+import MkId ( seqId )
import Var ( Var, TyVar )
import VarSet
import Rules
import VarEnv
import Var ( Var, TyVar )
import VarSet
import Rules
import VarEnv
-import Type
import Outputable
import SrcLoc
import Maybes
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
-- 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)
decomp env body
= case collectArgs (simpleSubst env body) of
(Var fn, args) -> Just (fn, args)
@@
-527,6
+533,12
@@
addInlineInfo (Inline prag is_inline) bndr rhs
wrap_inline False body = body
\end{code}
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.
+
%************************************************************************
%* *
%************************************************************************
%* *