[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