[commit: ghc] wip/tc/typeable-with-kinds: Switch back to `newWatnedEvVar`, so we don't keep resolving the same constraint. (ecd6149)

git at git.haskell.org git at git.haskell.org
Mon Mar 9 17:15:57 UTC 2015


Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/tc/typeable-with-kinds
Link       : http://ghc.haskell.org/trac/ghc/changeset/ecd6149ca770ea88f8ac968b33683e5ccc9d17d6/ghc

>---------------------------------------------------------------

commit ecd6149ca770ea88f8ac968b33683e5ccc9d17d6
Author: Iavor S. Diatchki <diatchki at galois.com>
Date:   Mon Mar 9 10:15:56 2015 -0700

    Switch back to `newWatnedEvVar`, so we don't keep resolving the same constraint.


>---------------------------------------------------------------

ecd6149ca770ea88f8ac968b33683e5ccc9d17d6
 compiler/typecheck/TcInteract.hs | 11 +++++------
 1 file changed, 5 insertions(+), 6 deletions(-)

diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs
index 8f85dd3..5e514f4 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))
 
 



More information about the ghc-commits mailing list