-dsSpec :: [TyVar] -> [DictId] -> [TyVar]
- -> Id -> Id -- Global, local
- -> CoreBind -> LPrag
- -> DsM (Maybe ((Id,CoreExpr), -- Binding for specialised Id
- CoreRule)) -- Rule for the Global Id
-
--- Example:
--- f :: (Eq a, Ix b) => a -> b -> b
--- {-# SPECIALISE f :: Ix b => Int -> b -> b #-}
---
--- 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)
---
--- Rule: forall b,(d:Ix b). f Int b dInt d = f_spec b d
---
--- 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
--- The idea is that f occurs just once, so it'll be
--- inlined and specialised
---
--- 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
---
--- It is *possible* that 'es' does not mention all of the dictionaries 'ds'
--- (a bit silly, because then the
-dsSpec _ _ _ _ _ _ (L _ (InlinePrag {}))
- = return Nothing
-
-dsSpec all_tvs dicts tvs poly_id mono_id mono_bind
- (L loc (SpecPrag spec_expr spec_ty inl))
- = putSrcSpanDs loc $
- do { let poly_name = idName poly_id
- ; spec_name <- newLocalName poly_name
- ; ds_spec_expr <- dsExpr spec_expr
- ; case (decomposeRuleLhs ds_spec_expr) of {
- Nothing -> do { warnDs decomp_msg; return Nothing } ;
-
- Just (bndrs, _fn, args) ->
-
- -- Check for dead binders: Note [Unused spec binders]
- case filter isDeadBinder bndrs of {
- bs | not (null bs) -> do { warnDs (dead_msg bs); return Nothing }
- | otherwise -> do
-
- { f_body <- fix_up (Let mono_bind (Var mono_id))
-
- ; let local_poly = setIdNotExported poly_id
- -- Very important to make the 'f' non-exported,
- -- else it won't be inlined!
- spec_id = mkLocalId spec_name spec_ty
- spec_rhs = Let (NonRec local_poly poly_f_body) ds_spec_expr
- poly_f_body = mkLams (tvs ++ dicts) f_body
-
- extra_dict_bndrs = [localiseId d -- See Note [Constant rule dicts]
- | d <- varSetElems (exprFreeVars ds_spec_expr)
- , isDictId d]
- -- Note [Const rule dicts]
-
- rule = mkLocalRule (mkFastString ("SPEC " ++ showSDoc (ppr poly_name)))
- AlwaysActive poly_name
- (extra_dict_bndrs ++ bndrs) args
- (mkVarApps (Var spec_id) bndrs)
- ; return (Just (addInlineInfo inl spec_id spec_rhs, rule))
- } } } }
- where
- -- Bind to Any any of all_ptvs that aren't
- -- relevant for this particular function
- fix_up body | null void_tvs = return body
- | otherwise = do { void_tys <- mapM dsMkArbitraryType void_tvs
- ; return (mkTyApps (mkLams void_tvs body) void_tys) }
+ AbsBinds [a,b] [ ([a,b], fg, fl, _),
+ ([b], gg, gl, _) ]
+ { fl = e1
+ gl = e2
+ h = e3 }
+
+and desugar it to
+
+ fg = /\ab. let B in e1
+ gg = /\b. let a = () in let B in S(e2)
+ h = /\ab. let B in e3
+
+where B is the *non-recursive* binding
+ fl = fg a b
+ gl = gg b
+ h = h a b -- See (b); note shadowing!
+
+Notice (a) g has a different number of type variables to f, so we must
+ use the mkArbitraryType thing to fill in the gaps.
+ We use a type-let to do that.
+
+ (b) The local variable h isn't in the exports, and rather than
+ clone a fresh copy we simply replace h by (h a b), where
+ the two h's have different types! Shadowing happens here,
+ which looks confusing but works fine.
+
+ (c) The result is *still* quadratic-sized if there are a lot of
+ small bindings. So if there are more than some small
+ number (10), we filter the binding set B by the free
+ variables of the particular RHS. Tiresome.
+
+Why got to this trouble? It's a common case, and it removes the
+quadratic-sized tuple desugaring. Less clutter, hopefullly faster
+compilation, especially in a case where there are a *lot* of
+bindings.
+
+
+Note [Eta-expanding INLINE things]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider
+ foo :: Eq a => a -> a
+ {-# INLINE foo #-}
+ foo x = ...
+
+If (foo d) ever gets floated out as a common sub-expression (which can
+happen as a result of method sharing), there's a danger that we never
+get to do the inlining, which is a Terribly Bad thing given that the
+user said "inline"!
+
+To avoid this we pre-emptively eta-expand the definition, so that foo
+has the arity with which it is declared in the source code. In this
+example it has arity 2 (one for the Eq and one for x). Doing this
+should mean that (foo d) is a PAP and we don't share it.
+
+Note [Nested arities]
+~~~~~~~~~~~~~~~~~~~~~
+For reasons that are not entirely clear, method bindings come out looking like
+this:
+
+ AbsBinds [] [] [$cfromT <= [] fromT]
+ $cfromT [InlPrag=INLINE] :: T Bool -> Bool
+ { AbsBinds [] [] [fromT <= [] fromT_1]
+ fromT :: T Bool -> Bool
+ { fromT_1 ((TBool b)) = not b } } }
+
+Note the nested AbsBind. The arity for the InlineRule on $cfromT should be
+gotten from the binding for fromT_1.
+
+It might be better to have just one level of AbsBinds, but that requires more
+thought!
+
+Note [Implementing SPECIALISE pragmas]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Example:
+ f :: (Eq a, Ix b) => a -> b -> Bool
+ {-# SPECIALISE f :: (Ix p, Ix q) => Int -> (p,q) -> Bool #-}
+ f = <poly_rhs>
+
+From this the typechecker generates
+
+ AbsBinds [ab] [d1,d2] [([ab], f, f_mono, prags)] binds
+
+ SpecPrag (wrap_fn :: forall a b. (Eq a, Ix b) => XXX
+ -> forall p q. (Ix p, Ix q) => XXX[ Int/a, (p,q)/b ])
+
+Note that wrap_fn can transform *any* function with the right type prefix
+ forall ab. (Eq a, Ix b) => XXX
+regardless of XXX. It's sort of polymorphic in XXX. This is
+useful: we use the same wrapper to transform each of the class ops, as
+well as the dict.
+
+From these we generate:
+
+ 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 = wrap_fn <poly_rhs>