-add_solns inst_infos_in eqns solns
-
--- ------------------
--- OLD: checkErrsTc above now deals with this
--- = discardErrsTc (buildInstanceEnvs all_inst_infos `thenTc` \ inst_mapper ->
- -- We do the discard-errs so that we don't get repeated error messages
- -- about duplicate instances.
- -- They'll appear later, when we do the top-level buildInstanceEnvs.
--- ------------------
-
- = buildInstanceEnvs all_inst_infos `thenTc` \ inst_mapper ->
- returnTc (new_inst_infos, inst_mapper)
- where
- new_inst_infos = zipWithEqual "add_solns" mk_deriv_inst_info eqns solns
-
- all_inst_infos = inst_infos_in `unionBags` listToBag new_inst_infos
-
- mk_deriv_inst_info (clas, tycon, tyvars, _) theta
- = InstInfo clas tyvars (applyTyCon tycon (mkTyVarTys tyvars))
- theta
- (my_panic "dfun_theta")
-
- dummy_dfun_id
-
- (my_panic "binds") (getSrcLoc tycon)
- (my_panic "upragmas")
- where
- dummy_dfun_id
- = mkDictFunId (getName tycon) dummy_dfun_ty bottom bottom
- -- The name is getSrcLoc'd in an error message
- where
- bottom = panic "dummy_dfun_id"
-
- dummy_dfun_ty = mkSigmaTy tyvars theta voidTy
- -- All we need from the dfun is its "theta" part, used during
- -- equation simplification (tcSimplifyThetas). The final
- -- dfun_id will have the superclass dictionaries as arguments too,
- -- but that'll be added after the equations are solved. For now,
- -- it's enough just to make a dummy dfun with the simple theta part.
- --
- -- The part after the theta is dummied here as voidTy; actually it's
- -- (C (T a b)), but it doesn't seem worth constructing it.
- -- We can't leave it as a panic because to get the theta part we
- -- have to run down the type!
-
- my_panic str = panic "add_soln" -- pprPanic ("add_soln:"++str) (hsep [char ':', ppr PprDebug clas, ppr PprDebug tycon])
+add_solns dflags inst_env_in eqns solns
+ = (new_dfuns, inst_env)
+ where
+ new_dfuns = zipWithEqual "add_solns" mk_deriv_dfun eqns solns
+ (inst_env, _) = extendInstEnv dflags inst_env_in new_dfuns
+ -- Ignore the errors about duplicate instances.
+ -- We don't want repeated error messages
+ -- They'll appear later, when we do the top-level extendInstEnvs
+
+ mk_deriv_dfun (dfun_name, clas, tycon, tyvars, _) theta
+ = mkDictFunId dfun_name clas tyvars
+ [mkTyConApp tycon (mkTyVarTys tyvars)]
+ theta