Commit cc2d2e1d authored by dimitris's avatar dimitris

Midstream check-in on

   (i) Replaced a lot of clunky and fragile EvVar handling code with
       a more uniform ``flavor transformer'' API in the canonicalizer
       and the interaction solver. Now EvVars are just fields inside
       the CtFlavors.
   (ii) Significantly simplified our caching story
This patch does not validate yet and more refactoring is on the way.
parent 4bbe9f71
......@@ -14,7 +14,7 @@
{-# LANGUAGE TypeFamilies #-}
module TrieMap(
CoreMap, emptyCoreMap, extendCoreMap, lookupCoreMap, foldCoreMap,
TypeMap, foldTypeMap,
TypeMap, foldTypeMap, lookupTypeMap_mod,
CoercionMap,
MaybeMap,
ListMap,
......@@ -521,6 +521,44 @@ lkT env ty m
go (TyConApp tc tys) = tm_tc_app >.> lkNamed tc >=> lkList (lkT env) tys
go (ForAllTy tv ty) = tm_forall >.> lkT (extendCME env tv) ty >=> lkBndr env tv
lkT_mod :: CmEnv
-> TyVarEnv a -- A substitution
-> (a -> Type)
-> Type
-> TypeMap b -> Maybe b
lkT_mod env s f ty m
| EmptyTM <- m = Nothing
| Just ty' <- coreView ty
= lkT_mod env s f ty' m
| isEmptyVarEnv candidates
= go env s ty m
| otherwise
= Just $ head (varEnvElts candidates) -- Yikes!
where
candidates = filterVarEnv_Directly find_matching (vm_fvar $ tm_var m)
find_matching tv _b = case lookupVarEnv_Directly s tv of
Nothing -> False
Just a -> f a `eqType` ty
go env _s (TyVarTy v) = tm_var >.> lkVar env v
go env s (AppTy t1 t2) = tm_app >.> lkT_mod env s f t1 >=> lkT_mod env s f t2
go env s (FunTy t1 t2) = tm_fun >.> lkT_mod env s f t1 >=> lkT_mod env s f t2
go env s (TyConApp tc tys) = tm_tc_app >.> lkNamed tc >=> lkList (lkT_mod env s f) tys
go _env _s (ForAllTy _tv _ty) = const Nothing
{- TODO: bleah the following is wrong!
= let (s',inscope') = substTyVarBndr tv (s,inscope)
in
let s' = delVarEnv s tv -- I think it's enough to just restrict substution
-- without renaming anything
in tm_forall >.> lkT_mod (extendCME env tv) s' f ty >=> lkBndr env tv
-}
lookupTypeMap_mod :: TyVarEnv a -- A substitution to be applied to the /keys/ of type map
-> (a -> Type)
-> Type
-> TypeMap b -> Maybe b
lookupTypeMap_mod = lkT_mod emptyCME
-----------------
xtT :: CmEnv -> Type -> XT a -> TypeMap a -> TypeMap a
xtT env ty f m
......
......@@ -85,7 +85,7 @@ emitWanteds origin theta = mapM (emitWanted origin) theta
emitWanted :: CtOrigin -> TcPredType -> TcM EvVar
emitWanted origin pred = do { loc <- getCtLoc origin
; ev <- newWantedEvVar pred
; emitFlat (mkNonCanonical ev (Wanted loc))
; emitFlat (mkNonCanonical (Wanted loc ev))
; return ev }
newMethodFromName :: CtOrigin -> Name -> TcRhoType -> TcM (HsExpr TcId)
......@@ -527,7 +527,7 @@ tyVarsOfCt (CFunEqCan { cc_tyargs = tys, cc_rhs = xi }) = tyVarsOfTypes (xi:tys)
tyVarsOfCt (CDictCan { cc_tyargs = tys }) = tyVarsOfTypes tys
tyVarsOfCt (CIPCan { cc_ip_ty = ty }) = tyVarsOfType ty
tyVarsOfCt (CIrredEvCan { cc_ty = ty }) = tyVarsOfType ty
tyVarsOfCt (CNonCanonical { cc_id = ev }) = tyVarsOfEvVar ev
tyVarsOfCt (CNonCanonical { cc_flavor = fl }) = tyVarsOfType (ctFlavPred fl)
tyVarsOfCDict :: Ct -> TcTyVarSet
tyVarsOfCDict (CDictCan { cc_tyargs = tys }) = tyVarsOfTypes tys
......@@ -563,19 +563,29 @@ tyVarsOfBag tvs_of = foldrBag (unionVarSet . tvs_of) emptyVarSet
tidyCt :: TidyEnv -> Ct -> Ct
-- Also converts it to non-canonical
tidyCt env ct
= CNonCanonical { cc_id = tidyEvVar env (cc_id ct)
, cc_flavor = tidyFlavor env (cc_flavor ct)
= CNonCanonical { cc_flavor = tidy_flavor env (cc_flavor ct)
, cc_depth = cc_depth ct }
where tidy_flavor :: TidyEnv -> CtFlavor -> CtFlavor
tidy_flavor env (Given { flav_gloc = gloc, flav_evar = evar })
= Given { flav_gloc = tidyGivenLoc env gloc
, flav_evar = tidyEvVar env evar }
tidy_flavor env (Solved { flav_gloc = gloc
, flav_evar = evar })
= Solved { flav_gloc = tidyGivenLoc env gloc
, flav_evar = tidyEvVar env evar }
tidy_flavor env (Wanted { flav_wloc = wloc
, flav_evar = evar })
= Wanted { flav_wloc = wloc -- Interesting: no tidying needed?
, flav_evar = tidyEvVar env evar }
tidy_flavor env (Derived { flav_wloc = wloc, flav_der_pty = pty })
= Derived { flav_wloc = wloc, flav_der_pty = tidyType env pty }
tidyEvVar :: TidyEnv -> EvVar -> EvVar
tidyEvVar env var = setVarType var (tidyType env (varType var))
tidyFlavor :: TidyEnv -> CtFlavor -> CtFlavor
tidyFlavor env (Given loc gk) = Given (tidyGivenLoc env loc) gk
tidyFlavor _ fl = fl
tidyGivenLoc :: TidyEnv -> GivenLoc -> GivenLoc
tidyGivenLoc env (CtLoc skol span ctxt) = CtLoc (tidySkolemInfo env skol) span ctxt
tidyGivenLoc env (CtLoc skol span ctxt)
= CtLoc (tidySkolemInfo env skol) span ctxt
tidySkolemInfo :: TidyEnv -> SkolemInfo -> SkolemInfo
tidySkolemInfo env (SigSkol cx ty) = SigSkol cx (tidyType env ty)
......@@ -595,13 +605,12 @@ substCt :: TvSubst -> Ct -> Ct
-- Conservatively converts it to non-canonical:
-- Postcondition: if the constraint does not get rewritten
substCt subst ct
| ev <- cc_id ct, pty <- evVarPred (cc_id ct)
| pty <- ctPred ct
, sty <- substTy subst pty
= if sty `eqType` pty then
ct { cc_flavor = substFlavor subst (cc_flavor ct) }
else
CNonCanonical { cc_id = setVarType ev sty
, cc_flavor = substFlavor subst (cc_flavor ct)
CNonCanonical { cc_flavor = substFlavor subst (cc_flavor ct)
, cc_depth = cc_depth ct }
substWC :: TvSubst -> WantedConstraints -> WantedConstraints
......@@ -626,11 +635,24 @@ substEvVar :: TvSubst -> EvVar -> EvVar
substEvVar subst var = setVarType var (substTy subst (varType var))
substFlavor :: TvSubst -> CtFlavor -> CtFlavor
substFlavor subst (Given loc gk) = Given (substGivenLoc subst loc) gk
substFlavor _ fl = fl
substFlavor subst (Given { flav_gloc = gloc, flav_evar = evar })
= Given { flav_gloc = substGivenLoc subst gloc
, flav_evar = substEvVar subst evar }
substFlavor subst (Solved { flav_gloc = gloc, flav_evar = evar })
= Solved { flav_gloc = substGivenLoc subst gloc
, flav_evar = substEvVar subst evar }
substFlavor subst (Wanted { flav_wloc = wloc, flav_evar = evar })
= Wanted { flav_wloc = wloc
, flav_evar = substEvVar subst evar }
substFlavor subst (Derived { flav_wloc = wloc, flav_der_pty = pty })
= Derived { flav_wloc = wloc
, flav_der_pty = substTy subst pty }
substGivenLoc :: TvSubst -> GivenLoc -> GivenLoc
substGivenLoc subst (CtLoc skol span ctxt) = CtLoc (substSkolemInfo subst skol) span ctxt
substGivenLoc subst (CtLoc skol span ctxt)
= CtLoc (substSkolemInfo subst skol) span ctxt
substSkolemInfo :: TvSubst -> SkolemInfo -> SkolemInfo
substSkolemInfo subst (SigSkol cx ty) = SigSkol cx (substTy subst ty)
......
This diff is collapsed.
......@@ -159,10 +159,11 @@ reportTidyWanteds ctxt insols flats implics
deferToRuntime :: EvBindsVar -> ReportErrCtxt -> (ReportErrCtxt -> Ct -> TcM ErrMsg)
-> Ct -> TcM ()
deferToRuntime ev_binds_var ctxt mk_err_msg ct
| Wanted loc <- cc_flavor ct
| fl <- cc_flavor ct
, Wanted loc _ <- fl
= do { err <- setCtLoc loc $
mk_err_msg ctxt ct
; let ev_id = cc_id ct
; let ev_id = ctId "deferToRuntime" ct -- Prec satisfied: Wanted
err_msg = pprLocErrMsg err
err_fs = mkFastString $ showSDoc $
err_msg $$ text "(deferred type error)"
......@@ -323,8 +324,8 @@ groupErrs mk_err (ct1 : rest)
same_group :: CtFlavor -> CtFlavor -> Bool
same_group (Given l1 _) (Given l2 _) = same_loc l1 l2
same_group (Derived l1) (Derived l2) = same_loc l1 l2
same_group (Wanted l1) (Wanted l2) = same_loc l1 l2
same_group (Derived l1 _) (Derived l2 _) = same_loc l1 l2
same_group (Wanted l1 _) (Wanted l2 _) = same_loc l1 l2
same_group _ _ = False
same_loc :: CtLoc o -> CtLoc o -> Bool
......@@ -345,7 +346,7 @@ pprWithArising []
pprWithArising (ct:cts)
| null cts
= (loc, addArising (ctLocOrigin (ctWantedLoc ct))
(pprEvVarTheta [cc_id ct]))
(pprTheta [ctPred ct]))
| otherwise
= (loc, vcat (map ppr_one (ct:cts)))
where
......@@ -425,22 +426,23 @@ mkEqErr _ [] = panic "mkEqErr"
mkEqErr1 :: ReportErrCtxt -> Ct -> TcM ErrMsg
-- Wanted constraints only!
mkEqErr1 ctxt ct
= case cc_flavor ct of
Given gl gk -> mkEqErr_help ctxt2 ct False ty1 ty2
where
ctxt2 = ctxt { cec_extra = cec_extra ctxt $$
inaccessible_msg gl gk }
flav -> do { let orig = ctLocOrigin (getWantedLoc flav)
; (ctxt1, orig') <- zonkTidyOrigin ctxt orig
; mk_err ctxt1 orig' }
= if isGivenOrSolved flav then
let ctx2 = ctxt { cec_extra = cec_extra ctxt $$ inaccessible_msg flav }
in mkEqErr_help ctx2 ct False ty1 ty2
else
do { let orig = ctLocOrigin (getWantedLoc flav)
; (ctxt1, orig') <- zonkTidyOrigin ctxt orig
; mk_err ctxt1 orig' }
where
-- If a GivenSolved then we should not report inaccessible code
inaccessible_msg loc GivenOrig = hang (ptext (sLit "Inaccessible code in"))
flav = cc_flavor ct
inaccessible_msg (Given loc _) = hang (ptext (sLit "Inaccessible code in"))
2 (ppr (ctLocOrigin loc))
inaccessible_msg _ _ = empty
-- If a Solved then we should not report inaccessible code
inaccessible_msg _ = empty
(ty1, ty2) = getEqPredTys (evVarPred (cc_id ct))
(ty1, ty2) = getEqPredTys (ctPred ct)
-- If the types in the error message are the same as the types
-- we are unifying, don't add the extra expected/actual message
......@@ -1070,6 +1072,19 @@ solverDepthErrorTcS depth stack
| null stack -- Shouldn't happen unless you say -fcontext-stack=0
= failWith msg
| otherwise
= setCtFlavorLoc (cc_flavor top_item) $
do { zstack <- mapM zonkCt stack
; env0 <- tcInitTidyEnv
; let zstack_tvs = foldr (unionVarSet . tyVarsOfCt) emptyVarSet zstack
tidy_env = tidyFreeTyVars env0 zstack_tvs
tidy_cts = map (tidyCt tidy_env) zstack
; failWithTcM (tidy_env, hang msg 2 (vcat (map (ppr . ctPred) tidy_cts))) }
where
top_item = head stack
msg = vcat [ ptext (sLit "Context reduction stack overflow; size =") <+> int depth
, ptext (sLit "Use -fcontext-stack=N to increase stack size to N") ]
{- DV: Changing this because Derived's no longer have ids ... Kind of a corner case ...
= setCtFlavorLoc (cc_flavor top_item) $
do { ev_vars <- mapM (zonkEvVar . cc_id) stack
; env0 <- tcInitTidyEnv
......@@ -1080,6 +1095,8 @@ solverDepthErrorTcS depth stack
top_item = head stack
msg = vcat [ ptext (sLit "Context reduction stack overflow; size =") <+> int depth
, ptext (sLit "Use -fcontext-stack=N to increase stack size to N") ]
-}
flattenForAllErrorTcS :: CtFlavor -> TcType -> TcM a
flattenForAllErrorTcS fl ty
......@@ -1099,9 +1116,10 @@ flattenForAllErrorTcS fl ty
\begin{code}
setCtFlavorLoc :: CtFlavor -> TcM a -> TcM a
setCtFlavorLoc (Wanted loc) thing = setCtLoc loc thing
setCtFlavorLoc (Derived loc) thing = setCtLoc loc thing
setCtFlavorLoc (Given loc _gk) thing = setCtLoc loc thing
setCtFlavorLoc (Wanted loc _) thing = setCtLoc loc thing
setCtFlavorLoc (Derived loc _) thing = setCtLoc loc thing
setCtFlavorLoc (Given loc _) thing = setCtLoc loc thing
setCtFlavorLoc (Solved loc _) thing = setCtLoc loc thing
\end{code}
%************************************************************************
......
This diff is collapsed.
......@@ -686,18 +686,29 @@ zonkWC (WC { wc_flat = flat, wc_impl = implic, wc_insol = insol })
zonkCt :: Ct -> TcM Ct
-- Zonking a Ct conservatively gives back a CNonCanonical
zonkCt ct
= do { v' <- zonkEvVar (cc_id ct)
; fl' <- zonkFlavor (cc_flavor ct)
= do { fl' <- zonkFlavor (cc_flavor ct)
; return $
CNonCanonical { cc_id = v'
, cc_flavor = fl'
CNonCanonical { cc_flavor = fl'
, cc_depth = cc_depth ct } }
zonkCts :: Cts -> TcM Cts
zonkCts = mapBagM zonkCt
zonkFlavor :: CtFlavor -> TcM CtFlavor
zonkFlavor (Given loc gk) = do { loc' <- zonkGivenLoc loc; return (Given loc' gk) }
zonkFlavor fl = return fl
zonkFlavor (Given loc evar)
= do { loc' <- zonkGivenLoc loc
; evar' <- zonkEvVar evar
; return (Given loc' evar') }
zonkFlavor (Solved loc evar)
= do { loc' <- zonkGivenLoc loc
; evar' <- zonkEvVar evar
; return (Solved loc' evar') }
zonkFlavor (Wanted loc evar)
= do { evar' <- zonkEvVar evar
; return (Wanted loc evar') }
zonkFlavor (Derived loc pty)
= do { pty' <- zonkTcType pty
; return (Derived loc pty') }
zonkGivenLoc :: GivenLoc -> TcM GivenLoc
-- GivenLocs may have unification variables inside them!
......
This diff is collapsed.
This diff is collapsed.
......@@ -39,7 +39,7 @@ import BasicTypes ( RuleName )
import Control.Monad ( when )
import Outputable
import FastString
import TrieMap
import TrieMap () -- DV: for now
import DynFlags
\end{code}
......@@ -603,7 +603,7 @@ simplifyRule name tv_bndrs lhs_wanted rhs_wanted
; traceTc "simplifyRule" $
vcat [ text "zonked_lhs" <+> ppr zonked_lhs
, text "lhs_results" <+> ppr lhs_results
, text "lhs_results" <+> ppr lhs_results
, text "lhs_binds" <+> ppr lhs_binds
, text "rhs_wanted" <+> ppr rhs_wanted ]
......@@ -611,8 +611,11 @@ simplifyRule name tv_bndrs lhs_wanted rhs_wanted
-- Don't quantify over equalities (judgement call here)
; let (eqs, dicts) = partitionBag (isEqPred . ctPred)
(wc_flat lhs_results)
lhs_dicts = map cc_id (bagToList dicts)
lhs_dicts = map (ctId "tcSimplify") (bagToList dicts)
-- Dicts and implicit parameters
-- NB: dicts come from lhs_results which
-- are all Wanted, hence have ids, hence
-- it's fine to call ctId on them
-- Fail if we have not got down to unsolved flats
; ev_binds_var <- newTcEvBinds
......@@ -808,17 +811,21 @@ simpl_loop n implics
; inerts <- getTcSInerts
; let ((_,unsolved_flats),_) = extractUnsolved inerts
{- DELETEME
; ecache_pre <- getTcSEvVarCacheMap
; let pr = ppr ((\k z m -> foldTM k m z) (:) [] ecache_pre)
; traceTcS "ecache_pre" $ pr
-}
; improve_eqs <- if not (isEmptyBag implic_eqs)
then return implic_eqs
else applyDefaultingRules unsolved_flats
{- DELETEME
; ecache_post <- getTcSEvVarCacheMap
; let po = ppr ((\k z m -> foldTM k m z) (:) [] ecache_post)
; traceTcS "ecache_po" $ po
-}
; traceTcS "solveWanteds: simpl_loop end" $
vcat [ text "improve_eqs =" <+> ppr improve_eqs
......@@ -865,7 +872,10 @@ solveNestedImplications implics
where givens_from_wanteds = foldrBag get_wanted []
get_wanted cc rest_givens
| pushable_wanted cc
= let this_given = cc { cc_flavor = mkGivenFlavor (cc_flavor cc) UnkSkol }
= let fl = cc_flavor cc
wloc = flav_wloc fl
gfl = Given (mkGivenLoc wloc UnkSkol) (flav_evar fl)
this_given = cc { cc_flavor = gfl }
in this_given : rest_givens
| otherwise = rest_givens
......@@ -1096,23 +1106,22 @@ solveCTyFunEqs cts
; return (niFixTvSubst ni_subst, unsolved_can_cts) }
where
solve_one (cv,tv,ty) = do { setWantedTyBind tv ty
; _ <- setEqBind cv (mkTcReflCo ty) $
(Wanted $ panic "Met an already solved function equality!")
; return () -- Don't care about flavors etc this is
-- the last thing happening
}
solve_one (Wanted _ cv,tv,ty)
= setWantedTyBind tv ty >> setEvBind cv (EvCoercion (mkTcReflCo ty))
solve_one (Derived {}, tv, ty)
= setWantedTyBind tv ty
solve_one arg
= pprPanic "solveCTyFunEqs: can't solve a /given/ family equation!" $ ppr arg
------------
type FunEqBinds = (TvSubstEnv, [(CoVar, TcTyVar, TcType)])
type FunEqBinds = (TvSubstEnv, [(CtFlavor, TcTyVar, TcType)])
-- The TvSubstEnv is not idempotent, but is loop-free
-- See Note [Non-idempotent substitution] in Unify
emptyFunEqBinds :: FunEqBinds
emptyFunEqBinds = (emptyVarEnv, [])
extendFunEqBinds :: FunEqBinds -> CoVar -> TcTyVar -> TcType -> FunEqBinds
extendFunEqBinds (tv_subst, cv_binds) cv tv ty
= (extendVarEnv tv_subst tv ty, (cv, tv, ty):cv_binds)
extendFunEqBinds :: FunEqBinds -> CtFlavor -> TcTyVar -> TcType -> FunEqBinds
extendFunEqBinds (tv_subst, cv_binds) fl tv ty
= (extendVarEnv tv_subst tv ty, (fl, tv, ty):cv_binds)
------------
getSolvableCTyFunEqs :: TcsUntouchables
......@@ -1124,8 +1133,7 @@ getSolvableCTyFunEqs untch cts
dflt_funeq :: (Cts, FunEqBinds) -> Ct
-> (Cts, FunEqBinds)
dflt_funeq (cts_in, feb@(tv_subst, _))
(CFunEqCan { cc_id = cv
, cc_flavor = fl
(CFunEqCan { cc_flavor = fl
, cc_fun = tc
, cc_tyargs = xis
, cc_rhs = xi })
......@@ -1145,7 +1153,7 @@ getSolvableCTyFunEqs untch cts
, not (tv `elemVarSet` niSubstTvSet tv_subst (tyVarsOfTypes xis))
-- Occurs check: see Note [Solving Family Equations], Point 2
= ASSERT ( not (isGivenOrSolved fl) )
(cts_in, extendFunEqBinds feb cv tv (mkTyConApp tc xis))
(cts_in, extendFunEqBinds feb fl tv (mkTyConApp tc xis))
dflt_funeq (cts_in, fun_eq_binds) ct
= (cts_in `extendCts` ct, fun_eq_binds)
......@@ -1283,12 +1291,19 @@ defaultTyVar untch the_tv
, not (k `eqKind` default_k)
= tryTcS $ -- Why tryTcS? See Note [tryTcS in defaulting]
do { let loc = CtLoc DefaultOrigin (getSrcSpan the_tv) [] -- Yuk
fl = Wanted loc
; eqv <- TcSMonad.newKindConstraint the_tv default_k fl
; if isNewEvVar eqv then
; eqv <- TcSMonad.newKindConstraint the_tv default_k
; case eqv of
Fresh x ->
return $ unitBag $
CNonCanonical { cc_flavor = Wanted loc x, cc_depth = 0 }
Cached _ -> return emptyBag }
{- DELETEME
if isNewEvVar eqv then
return $ unitBag (CNonCanonical { cc_id = evc_the_evvar eqv
, cc_flavor = fl, cc_depth = 0 })
else return emptyBag }
-}
| otherwise
= return emptyBag -- The common case
where
......@@ -1364,12 +1379,16 @@ disambigGroup [] _grp
disambigGroup (default_ty:default_tys) group
= do { traceTcS "disambigGroup" (ppr group $$ ppr default_ty)
; success <- tryTcS $ -- Why tryTcS? See Note [tryTcS in defaulting]
do { let der_flav = mk_derived_flavor (cc_flavor the_ct)
; derived_eq <- tryTcS $
do { derived_eq <- tryTcS $
-- I need a new tryTcS because we will call solveInteractCts below!
do { eqv <- TcSMonad.newEqVar der_flav (mkTyVarTy the_tv) default_ty
; return [ CNonCanonical { cc_id = evc_the_evvar eqv
, cc_flavor = der_flav, cc_depth = 0 } ] }
do { md <- newDerived (mkTcEqPred (mkTyVarTy the_tv) default_ty)
; case md of
Cached _ -> return []
Fresh pty ->
-- flav_wloc because constraint is not Given/Solved!
let dfl = Derived (flav_wloc the_fl) pty
in return [ CNonCanonical { cc_flavor = dfl, cc_depth = 0 } ] }
; traceTcS "disambigGroup (solving) {"
(text "trying to solve constraints along with default equations ...")
; solveInteractCts (derived_eq ++ wanteds)
......@@ -1392,10 +1411,8 @@ disambigGroup (default_ty:default_tys) group
; disambigGroup default_tys group } }
where
((the_ct,the_tv):_) = group
the_fl = cc_flavor the_ct
wanteds = map fst group
mk_derived_flavor :: CtFlavor -> CtFlavor
mk_derived_flavor (Wanted loc) = Derived loc
mk_derived_flavor _ = panic "Asked to disambiguate given or derived!"
\end{code}
Note [Avoiding spurious errors]
......@@ -1425,9 +1442,8 @@ newFlatWanteds orig theta
= do { loc <- getCtLoc orig
; mapM (inst_to_wanted loc) theta }
where inst_to_wanted loc pty
= do { v <- newWantedEvVar pty
= do { v <- TcMType.newWantedEvVar pty
; return $
CNonCanonical { cc_id = v
, cc_flavor = Wanted loc
CNonCanonical { cc_flavor = Wanted loc v
, cc_depth = 0 } }
\end{code}
\ No newline at end of file
......@@ -535,7 +535,7 @@ uType_defer items ty1 ty2
= ASSERT( not (null items) )
do { eqv <- newEq ty1 ty2
; loc <- getCtLoc (TypeEqOrigin (last items))
; emitFlat (mkNonCanonical eqv (Wanted loc))
; emitFlat $ mkNonCanonical (Wanted loc eqv)
-- Error trace only
-- NB. do *not* call mkErrInfo unless tracing is on, because
......
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