[commit: ghc] master: Comments and tc-tracing only (6386fc3)

git at git.haskell.org git at git.haskell.org
Wed Jul 26 11:34:15 UTC 2017


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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/6386fc320b25b0d7d6dbf9356cb984f28bb23d3e/ghc

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

commit 6386fc320b25b0d7d6dbf9356cb984f28bb23d3e
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Wed Jul 26 08:57:16 2017 +0100

    Comments and tc-tracing only


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

6386fc320b25b0d7d6dbf9356cb984f28bb23d3e
 compiler/typecheck/TcInteract.hs | 11 +++++++----
 compiler/typecheck/TcSMonad.hs   |  2 +-
 compiler/typecheck/TcType.hs     |  5 ++++-
 3 files changed, 12 insertions(+), 6 deletions(-)

diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs
index 83dc10c..69e84a4 100644
--- a/compiler/typecheck/TcInteract.hs
+++ b/compiler/typecheck/TcInteract.hs
@@ -527,7 +527,8 @@ solveOneFromTheOther ev_i ev_w
 
   | CtWanted { ctev_loc = loc_w } <- ev_w
   , prohibitedSuperClassSolve (ctEvLoc ev_i) loc_w
-  = return (IRDelete, False)
+  = do { traceTcS "prohibitedClassSolve1" (ppr ev_i $$ ppr ev_w)
+       ; return (IRDelete, False) }
 
   | CtWanted { ctev_dest = dest } <- ev_w
        -- Inert is Given or Wanted
@@ -536,9 +537,10 @@ solveOneFromTheOther ev_i ev_w
 
   | CtWanted { ctev_loc = loc_i } <- ev_i   -- Work item is Given
   , prohibitedSuperClassSolve (ctEvLoc ev_w) loc_i
-  = return (IRKeep, False)  -- Just discard the un-usable Given
-                            -- This never actually happens because
-                            -- Givens get processed first
+  = do { traceTcS "prohibitedClassSolve2" (ppr ev_i $$ ppr ev_w)
+       ; return (IRKeep, False) } -- Just discard the un-usable Given
+                                  -- This never actually happens because
+                                  -- Givens get processed first
 
   | CtWanted { ctev_dest = dest } <- ev_i
   = do { setWantedEvTerm dest (ctEvTerm ev_w)
@@ -877,6 +879,7 @@ interactDict inerts workItem@(CDictCan { cc_ev = ev_w, cc_class = cls, cc_tyargs
       -- we solve it from the solution in the inerts we just retrieved.
       Nothing ->  do
         { (inert_effect, stop_now) <- solveOneFromTheOther ctev_i ev_w
+        ; traceTcS "lookupInertDict" (ppr inert_effect <+> ppr stop_now)
         ; case inert_effect of
             IRKeep    -> return ()
             IRDelete  -> updInertDicts $ \ ds -> delDict ds cls tys
diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs
index b5f6554..92b753f 100644
--- a/compiler/typecheck/TcSMonad.hs
+++ b/compiler/typecheck/TcSMonad.hs
@@ -2067,7 +2067,7 @@ solvable from the other. So, we do lookup in the inert set using
 loose types, which omit the kind-check.
 
 We must be careful when using the result of a lookup because it may
-not match the requsted info exactly!
+not match the requested info exactly!
 
 -}
 
diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs
index 00bcea2..7b8ff13 100644
--- a/compiler/typecheck/TcType.hs
+++ b/compiler/typecheck/TcType.hs
@@ -2559,8 +2559,11 @@ sizeType = go
     go (TyVarTy {})              = 1
     go (TyConApp tc tys)
       | isTypeFamilyTyCon tc     = infinity  -- Type-family applications can
-                                           -- expand to any arbitrary size
+                                             -- expand to any arbitrary size
       | otherwise                = sizeTypes (filterOutInvisibleTypes tc tys) + 1
+                                   -- Why filter out invisible args?  I suppose any
+                                   -- size ordering is sound, but why is this better?
+                                   -- I came across this when investigating #14010.
     go (LitTy {})                = 1
     go (FunTy arg res)           = go arg + go res + 1
     go (AppTy fun arg)           = go fun + go arg



More information about the ghc-commits mailing list