Commit 6bb65108 authored by simonpj@microsoft.com's avatar simonpj@microsoft.com
Browse files

In an AbsBinds, the 'dicts' can include EqInsts

An AbsBinds abstrats over evidence, and the evidence can be both
Dicts (class constraints, implicit parameters) and EqInsts (equality
constraints).  So we need to
  - use varType rather than idType
  - use instToVar rather than instToId
  - use zonkDictBndr rather than zonkIdBndr in zonking

It actually all worked before, but gave warnings.
parent 0f8aee2a
......@@ -42,7 +42,7 @@ import VarEnv
import TysPrim
import Id
import IdInfo
import Var ( TyVar )
import Var ( TyVar, varType )
import Name
import NameSet
import NameEnv
......@@ -344,15 +344,15 @@ tcPolyBinds top_lvl sig_fn prag_fn rec_group rec_tc binds
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
......
......@@ -194,6 +194,13 @@ zonkIdBndr env id
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}
......@@ -287,7 +294,7 @@ zonk_bind env bind@(FunBind { fun_id = var, fun_matches = ms, fun_co_fn = co_fn
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
......
......@@ -525,7 +525,7 @@ tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = NewTypeDerived })
; 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
......
......@@ -950,8 +950,10 @@ bindIrredsR loc qtvs co_vars reft givens irreds
| 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
......@@ -987,7 +989,8 @@ makeImplicationBind :: InstLoc -> [TcTyVar] -> Refinement
--
-- 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)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment