import FamInstEnv
import TcDeriv
import TcEnv
-import RnEnv ( lookupGlobalOccRn )
import RnSource ( addTcgDUs )
import TcHsType
import TcUnify
import Class
import Var
import CoreUnfold ( mkDFunUnfolding )
+import CoreSyn ( Expr(Var) )
import Id
import MkId
import Name
-- If there are no superclasses, matters are simpler, because we don't need the case
-- see Note [Newtype deriving superclasses] in TcDeriv.lhs
-tc_inst_decl2 dfun_id (NewTypeDerived coi)
+tc_inst_decl2 dfun_id (NewTypeDerived coi _)
= do { let rigid_info = InstSkol
origin = SigOrigin rigid_info
inst_ty = idType dfun_id
-- Ordinary instances
tc_inst_decl2 dfun_id (VanillaInst monobinds uprags standalone_deriv)
- = do { let rigid_info = InstSkol
- inst_ty = idType dfun_id
- loc = getSrcSpan dfun_id
+ = do { let rigid_info = InstSkol
+ inst_ty = idType dfun_id
+ loc = getSrcSpan dfun_id
-- Instantiate the instance decl with skolem constants
; (inst_tyvars', dfun_theta', inst_head') <- tcSkolSigType rigid_info inst_ty
; let dict_constr = classDataCon clas
this_dict_id = instToId this_dict
dict_bind = mkVarBind this_dict_id dict_rhs
- dict_rhs = foldl mk_app inst_constr (sc_ids ++ meth_ids)
+ dict_rhs = foldl mk_app inst_constr sc_meth_ids
+ sc_meth_ids = sc_ids ++ meth_ids
inst_constr = L loc $ wrapId (mkWpTyApps inst_tys')
(dataConWrapId dict_constr)
-- We don't produce a binding for the dict_constr; instead we
-- See Note [ClassOp/DFun selection]
-- See also note [Single-method classes]
dfun_id_w_fun = dfun_id
- `setIdUnfolding` mkDFunUnfolding dict_constr (sc_ids ++ meth_ids)
+ `setIdUnfolding` mkDFunUnfolding inst_ty (map Var sc_meth_ids)
`setInlinePragma` dfunInlinePragma
main_bind = AbsBinds
= do { meth_bind <- mkGenericDefMethBind clas inst_tys sel_id local_meth_name
; tc_body meth_bind }
- tc_default DefMeth -- An polymorphic default method
+ tc_default (DefMeth dm_name) -- An polymorphic default method
= do { -- Build the typechecked version directly,
-- without calling typecheck_method;
-- see Note [Default methods in instances]
-- in $dm inst_tys this
-- The 'let' is necessary only because HsSyn doesn't allow
-- you to apply a function to a dictionary *expression*.
- dm_name <- lookupGlobalOccRn (mkDefMethRdrName sel_name)
- -- Might not be imported, but will be an OrigName
+
; dm_id <- tcLookupId dm_name
; let dm_inline_prag = idInlinePragma dm_id
rhs = HsWrap (WpApp (instToId this_dict) <.> mkWpTyApps inst_tys) $