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
; poly_tup_id <- newSysLocalDs (exprType poly_tup_expr)
- ; let dict_args = map Var dicts
-
- mk_bind ((tyvars, global, local, prags), n) -- locals !! n == local
- = -- Need to make fresh locals to bind in the selector, because
- -- some of the tyvars will be bound to 'Any'
+ ; let mk_bind ((tyvars, global, local, prags), n) -- locals!!n == local
+ = -- Need to make fresh locals to bind in the selector,
+ -- because some of the tyvars will be bound to 'Any'
do { ty_args <- mapM mk_ty_arg all_tyvars
; let substitute = substTyWith all_tyvars ty_args
; locals' <- newSysLocalsDs (map substitute local_tys)
; tup_id <- newSysLocalDs (substitute tup_ty)
- ; mb_specs <- mapM (dsSpec all_tyvars dicts tyvars global local core_bind)
+ ; mb_specs <- mapM (dsSpec all_tyvars dicts tyvars global
+ local core_bind)
prags
; let (spec_binds, rules) = unzip (catMaybes mb_specs)
global' = addIdSpecialisations global rules
rhs = mkLams tyvars $ mkLams dicts $
mkTupleSelector locals' (locals' !! n) tup_id $
- mkApps (mkTyApps (Var poly_tup_id) ty_args) dict_args
+ mkVarApps (mkTyApps (Var poly_tup_id) ty_args)
+ dicts
; return ((global', rhs) : spec_binds) }
where
mk_ty_arg all_tyvar
-- 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)
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.
+
%************************************************************************
%* *