import Class ( Class, classBigSig )
import Var ( idName, idType )
import NameSet
-import Id ( setIdLocalExported )
import MkId ( mkDictFunId, rUNTIME_ERROR_ID )
import FunDeps ( checkInstFDs )
import Generics ( validGenericInstanceType )
[(inst_tyvars', dfun_id, this_dict_id)]
inlines all_binds
in
- showLIE "instance" `thenM_`
+ showLIE (text "instance") `thenM_`
returnM (main_bind `AndMonoBinds` prag_binds `AndMonoBinds` sc_binds_outer)
let
mk_method_bind = mkMethodBind InstanceDeclOrigin clas inst_tys' monobinds
in
- mapAndUnzipM mk_method_bind op_items `thenM` \ (meth_insts, meth_infos) ->
+ mapAndUnzipM mk_method_bind op_items `thenM` \ (meth_insts, meth_infos) ->
-- And type check them
-- It's really worth making meth_insts available to the tcMethodBind
--
-- Solution: make meth_insts available, so that 'then' refers directly
-- to the local 'bind' rather than going via the dictionary.
+ --
+ -- BUT WATCH OUT! If the method type mentions the class variable, then
+ -- this optimisation is not right. Consider
+ -- class C a where
+ -- op :: Eq a => a
+ --
+ -- instance C Int where
+ -- op = op
+ -- The occurrence of 'op' on the rhs gives rise to a constraint
+ -- op at Int
+ -- The trouble is that the 'meth_inst' for op, which is 'available', also
+ -- looks like 'op at Int'. But they are not the same.
let
- all_insts = avail_insts ++ meth_insts
+ all_insts = avail_insts ++ catMaybes meth_insts
xtve = inst_tyvars `zip` inst_tyvars'
tc_method_bind = tcMethodBind xtve inst_tyvars' dfun_theta' all_insts uprags
in
mapM tc_method_bind meth_infos `thenM` \ meth_binds_s ->
- returnM (map instToId meth_insts, andMonoBindList meth_binds_s)
+ returnM ([meth_id | (_,meth_id,_) <- meth_infos],
+ andMonoBindList meth_binds_s)
-- Derived newtype instances