-- newtype N a = MkN (Tree [a]) deriving( Foo Int )
--
-- The newtype gives an FC axiom looking like
--- axiom CoN a :: N a :=: Tree [a]
+-- axiom CoN a :: N a ~ Tree [a]
-- (see Note [Newtype coercions] in TyCon for this unusual form of axiom)
--
-- So all need is to generate a binding looking like:
; let coerced_rep_dict = wrapId the_coercion (instToId rep_dict)
; body <- make_body cls_tycon cls_inst_tys sc_dicts coerced_rep_dict
- ; let dict_bind = noLoc $ VarBind (instToId this_dict) (noLoc body)
+ ; let dict_bind = mkVarBind (instToId this_dict) (noLoc body)
; return (unitBag $ noLoc $
AbsBinds inst_tvs' (map instToVar dfun_dicts)
-- make_coercion
-- The inst_head looks like (C s1 .. sm (T a1 .. ak))
-- But we want the coercion (C s1 .. sm (sym (CoT a1 .. ak)))
- -- with kind (C s1 .. sm (T a1 .. ak) :=: C s1 .. sm <rep_ty>)
+ -- with kind (C s1 .. sm (T a1 .. ak) ~ C s1 .. sm <rep_ty>)
-- where rep_ty is the (eta-reduced) type rep of T
-- So we just replace T with CoT, and insert a 'sym'
-- NB: we know that k will be >= arity of CoT, because the latter fully eta-reduced
checkSigTyVars inst_tyvars'
-- Deal with 'SPECIALISE instance' pragmas
- prags <- tcPrags dfun_id (filter isSpecInstLSig uprags)
+ prags <- tcPrags NonRecursive dfun_id (filter isSpecInstLSig uprags)
-- Create the result bindings
let
-- See Note [Inline dfuns] below
sc_dict_vars = map instToVar sc_dicts
- dict_bind = L loc (VarBind this_dict_id dict_rhs)
+ dict_bind = mkVarBind this_dict_id dict_rhs
dict_rhs = foldl (\ f a -> L loc (HsApp f (L loc a))) inst_constr meth_exprs
inst_constr = L loc $ wrapId (mkWpApps sc_dict_vars <.> mkWpTyApps inst_tys')
(dataConWrapId dict_constr)
-- member) are dealt with by the common MkId.mkDataConWrapId code rather
-- than needing to be repeated here.
-
main_bind = noLoc $ AbsBinds
inst_tyvars'
dfun_lam_vars
-- then clashes with its friends
; uniq1 <- newUnique
; let local_meth_name = mkInternalName uniq1 sel_occ loc -- Same OccName
- this_dict_bind = L loc $ VarBind (instToId cloned_this) $
+ this_dict_bind = mkVarBind (instToId cloned_this) $
L loc $ wrapId meth_wrapper dfun_id
mb_this_bind | null tyvars = Nothing
| otherwise = Just (cloned_this, this_dict_bind)