import TysPrim
import Id
import IdInfo
-import Var ( TyVar )
+import Var ( TyVar, varType )
import Name
import NameSet
import NameEnv
generalise dflags top_lvl bind_list sig_fn mono_bind_infos lie_req
-- BUILD THE POLYMORPHIC RESULT IDs
- ; let dict_ids = map instToId dicts
- ; exports <- mapM (mkExport top_lvl prag_fn tyvars_to_gen (map idType dict_ids))
+ ; let dict_vars = map instToVar dicts -- May include equality constraints
+ ; exports <- mapM (mkExport top_lvl prag_fn tyvars_to_gen (map varType dict_vars))
mono_bind_infos
; let poly_ids = [poly_id | (_, poly_id, _, _) <- exports]
; traceTc (text "binding:" <+> ppr (poly_ids `zip` map idType poly_ids))
; let abs_bind = L loc $ AbsBinds tyvars_to_gen
- dict_ids exports
+ dict_vars exports
(dict_binds `unionBags` binds')
; return ([unitBag abs_bind], poly_ids) -- poly_ids are guaranteed zonked by mkExport
zonkIdBndrs :: ZonkEnv -> [TcId] -> TcM [Id]
zonkIdBndrs env ids = mappM (zonkIdBndr env) ids
+zonkDictBndrs :: ZonkEnv -> [Var] -> TcM [Var]
+-- "Dictionary" binders can be coercion variables or dictionary variables
+zonkDictBndrs env ids = mappM (zonkDictBndr env) ids
+
+zonkDictBndr env var | isTyVar var = return var
+ | otherwise = zonkIdBndr env var
+
zonkTopBndrs :: [TcId] -> TcM [Id]
zonkTopBndrs ids = zonkIdBndrs emptyZonkEnv ids
\end{code}
zonk_bind env (AbsBinds { abs_tvs = tyvars, abs_dicts = dicts,
abs_exports = exports, abs_binds = val_binds })
= ASSERT( all isImmutableTyVar tyvars )
- zonkIdBndrs env dicts `thenM` \ new_dicts ->
+ zonkDictBndrs env dicts `thenM` \ new_dicts ->
fixM (\ ~(new_val_binds, _) ->
let
env1 = extendZonkEnv env new_dicts
; let dict_bind = noLoc $ VarBind (instToId this_dict) (noLoc body)
; return (unitBag $ noLoc $
- AbsBinds tvs (map instToId dfun_dicts)
+ AbsBinds tvs (map instToVar dfun_dicts)
[(tvs, dfun_id, instToId this_dict, [])]
(dict_bind `consBag` sc_binds)) }
where
| null irreds
= return emptyBag
| otherwise
- = do { let givens' = filter isDict givens
- -- The givens can include methods
+ = do { let givens' = filter isAbstractableInst givens
+ -- The givens can (redundantly) include methods
+ -- We want to retain both EqInsts and Dicts
+ -- There should be no implicadtion constraints
-- See Note [Pruning the givens in an implication constraint]
-- If there are no 'givens' *and* the refinement is empty
--
-- This binding must line up the 'rhs' in reduceImplication
makeImplicationBind loc all_tvs reft
- givens -- Guaranteed all Dicts (TOMDO: true?)
+ givens -- Guaranteed all Dicts
+ -- or EqInsts
irreds
| null irreds -- If there are no irreds, we are done
= return ([], emptyBag)