projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Fix #3741, simplifying things in the process
[ghc-hetmet.git]
/
compiler
/
deSugar
/
DsBinds.lhs
diff --git
a/compiler/deSugar/DsBinds.lhs
b/compiler/deSugar/DsBinds.lhs
index
0bb7045
..
4a11ea2
100644
(file)
--- a/
compiler/deSugar/DsBinds.lhs
+++ b/
compiler/deSugar/DsBinds.lhs
@@
-322,7
+322,7
@@
makeCorePair gbl_id arity rhs
| isInlinePragma (idInlinePragma gbl_id)
-- Add an Unfolding for an INLINE (but not for NOINLINE)
-- And eta-expand the RHS; see Note [Eta-expanding INLINE things]
| isInlinePragma (idInlinePragma gbl_id)
-- Add an Unfolding for an INLINE (but not for NOINLINE)
-- And eta-expand the RHS; see Note [Eta-expanding INLINE things]
- = (gbl_id `setIdUnfolding` mkInlineRule InlSat rhs arity,
+ = (gbl_id `setIdUnfolding` mkInlineRule needSaturated rhs arity,
etaExpand arity rhs)
| otherwise
= (gbl_id, rhs)
etaExpand arity rhs)
| otherwise
= (gbl_id, rhs)
@@
-406,22
+406,28
@@
dsSpecs :: [TyVar] -> [DictId] -> [TyVar]
-> DsM ( [(Id,CoreExpr)] -- Binding for specialised Ids
, [CoreRule] ) -- Rules for the Global Ids
-- Example:
-> DsM ( [(Id,CoreExpr)] -- Binding for specialised Ids
, [CoreRule] ) -- Rules for the Global Ids
-- Example:
--- f :: (Eq a, Ix b) => a -> b -> b
--- {-# SPECIALISE f :: Ix b => Int -> b -> b #-}
+-- f :: (Eq a, Ix b) => a -> b -> Bool
+-- {-# SPECIALISE f :: (Ix p, Ix q) => Int -> (p,q) -> Bool #-}
--
-- AbsBinds [ab] [d1,d2] [([ab], f, f_mono, prags)] binds
--
--
-- AbsBinds [ab] [d1,d2] [([ab], f, f_mono, prags)] binds
--
--- SpecPrag (/\b.\(d:Ix b). f Int b dInt d)
--- (forall b. Ix b => Int -> b -> b)
+-- SpecPrag /\pq.\(dp:Ix p, dq:Ix q). f Int (p,q) dInt ($dfIxPair dp dq)
+-- :: forall p q. (Ix p, Ix q) => Int -> (p,q) -> Bool
--
--
--- Rule: forall b,(d:Ix b). f Int b dInt d = f_spec b d
+--
+-- Rule: forall p,q,(dp:Ix p),(dq:Ix q).
+-- f Int (p,q) dInt ($dfInPair dp dq) = f_spec p q dp dq
--
-- Spec bind: f_spec = Let f = /\ab \(d1:Eq a)(d2:Ix b). let binds in f_mono
--
-- Spec bind: f_spec = Let f = /\ab \(d1:Eq a)(d2:Ix b). let binds in f_mono
--- /\b.\(d:Ix b). in f Int b dInt d
+-- /\pq.\(dp:Ix p, dq:Ix q). f Int (p,q) dInt ($dfIxPair dp dq)
-- The idea is that f occurs just once, so it'll be
-- inlined and specialised
--
-- The idea is that f occurs just once, so it'll be
-- inlined and specialised
--
--- Given SpecPrag (/\as.\ds. f es) t, we have
+-- Note that the LHS of the rule may mention dictionary *expressions*
+-- (eg $dfIxPair dp dq), and that is essential because
+-- the dp, dq are needed on the RHS.
+--
+-- In general, given SpecPrag (/\as.\ds. f es) t, we have
-- the defn f_spec as ds = let-nonrec f = /\fas\fds. let f_mono = <f-rhs> in f_mono
-- in f es
-- and the RULE forall as, ds. f es = f_spec as ds
-- the defn f_spec as ds = let-nonrec f = /\fas\fds. let f_mono = <f-rhs> in f_mono
-- in f es
-- and the RULE forall as, ds. f es = f_spec as ds
@@
-467,8
+473,8
@@
dsSpecs all_tvs dicts tvs poly_id mono_id inl_arity mono_bind prags
spec_id_arity = inl_arity + count isDictId bndrs
extra_dict_bndrs = [ localiseId d -- See Note [Constant rule dicts]
spec_id_arity = inl_arity + count isDictId bndrs
extra_dict_bndrs = [ localiseId d -- See Note [Constant rule dicts]
- | d <- varSetElems (exprFreeVars ds_spec_expr)
- , isDictId d]
+ | d <- varSetElems (exprFreeVars ds_spec_expr)
+ , isDictId d]
-- Note [Const rule dicts]
rule = mkLocalRule (mkFastString ("SPEC " ++ showSDoc (ppr poly_name)))
-- Note [Const rule dicts]
rule = mkLocalRule (mkFastString ("SPEC " ++ showSDoc (ppr poly_name)))