More work on the simplifier's inlining strategies

[ghc-hetmet.git] / compiler / deSugar / DsBinds.lhs

diff --git a/compiler/deSugar/DsBinds.lhs b/compiler/deSugar/DsBinds.lhs
index 3fe8d54..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]
-  = (gbl_id `setIdUnfolding` mkInlineRule InlSat rhs arity,
+  = (gbl_id `setIdUnfolding` mkInlineRule needSaturated rhs arity,
      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:
---     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
 -- 
---     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 
---                      /\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
 --
--- 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
@@ -452,7 +458,7 @@ dsSpecs all_tvs dicts tvs poly_id mono_id inl_arity mono_bind prags
                bs | not (null bs) -> do { warnDs (dead_msg bs); return Nothing } 
                   | otherwise -> do
 
-          { (spec_unf, unf_pairs) <- specUnfolding wrap_fn (idUnfolding poly_id)
+          { (spec_unf, unf_pairs) <- specUnfolding wrap_fn (realIdUnfolding poly_id)
 
           ; let f_body = fix_up (Let mono_bind (Var mono_id))
                  spec_ty = exprType ds_spec_expr
@@ -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]
-                                        | 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)))