diff options
| author | Iavor S. Diatchki <diatchki@galois.com> | 2015-03-09 10:15:56 -0700 |
|---|---|---|
| committer | Iavor S. Diatchki <diatchki@galois.com> | 2015-03-09 10:15:56 -0700 |
| commit | ecd6149ca770ea88f8ac968b33683e5ccc9d17d6 (patch) | |
| tree | f7827b446b20f975579035f54967ac0fbb91b07e | |
| parent | 2540a1f9d3728e815c4a491a109df7af5544bfc3 (diff) | |
| download | haskell-wip/tc/typeable-with-kinds.tar.gz | |
Switch back to `newWatnedEvVar`, so we don't keep resolving the same constraint.wip/tc/typeable-with-kinds
| -rw-r--r-- | compiler/typecheck/TcInteract.hs | 11 |
1 files changed, 5 insertions, 6 deletions
diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs index 8f85dd3c81..5e514f4654 100644 --- a/compiler/typecheck/TcInteract.hs +++ b/compiler/typecheck/TcInteract.hs @@ -1858,7 +1858,7 @@ matchTypeableClass clas k t loc Nothing -> return NoInstance -- Not concrete kinds Just kReps -> do tCts <- mapM subGoal ts - mkEv tCts (EvTypeableTyCon tc kReps (map ctEvTerm tCts `zip` ts)) + mkEv tCts (EvTypeableTyCon tc kReps (map getEv tCts `zip` ts)) where (ks,ts) = span isKind ks_ts @@ -1876,7 +1876,7 @@ matchTypeableClass clas k t loc | otherwise = do ct1 <- subGoal f ct2 <- subGoal tk - mkEv [ct1,ct2] (EvTypeableTyApp (ctEvTerm ct1,f) (ctEvTerm ct2,tk)) + mkEv [ct1,ct2] (EvTypeableTyApp (getEv ct1,f) (getEv ct2,tk)) -- Representation for concrete kinds. We just use the kind itself, @@ -1886,13 +1886,12 @@ matchTypeableClass clas k t loc mapM_ kindRep ks return ki + getEv (ct,_fresh) = ctEvTerm ct -- Emit a `Typeable` constraint for the given type. subGoal ty = do let goal = mkClassPred clas [ typeKind ty, ty ] - ev <- newWantedEvVarNC loc goal - return ev + newWantedEvVar loc goal - - mkEv subs ev = return (GenInst subs (EvTypeable ev)) + mkEv subs ev = return (GenInst [ c | (c,Fresh) <- subs ] (EvTypeable ev)) |