[commit: ghc] ghc-8.0: typechecker: fix trac issue #11708 (fefbd6c)

[git at git.haskell.org]

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

On branch  : ghc-8.0
Link       : http://ghc.haskell.org/trac/ghc/changeset/fefbd6cc0d381ad81a80a8a5ed24f0dc1b011c95/ghc

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

commit fefbd6cc0d381ad81a80a8a5ed24f0dc1b011c95
Author: Csongor Kiss <kiss.csongor.kiss at gmail.com>
Date:   Wed Mar 16 15:26:59 2016 -0400

    typechecker: fix trac issue #11708
    
    Summary: Fixes T11708
    
    Reviewers: austin, bgamari, goldfire, simonpj
    
    Reviewed By: goldfire, simonpj
    
    Subscribers: simonpj, goldfire, thomie
    
    Differential Revision: https://phabricator.haskell.org/D2006
    
    GHC Trac Issues: #11708
    
    (cherry picked from commit c5ed41cbcaa40068763c8bd01badcada38cdbd03)


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

fefbd6cc0d381ad81a80a8a5ed24f0dc1b011c95
 compiler/typecheck/TcHsType.hs | 11 +++++++++--
 1 file changed, 9 insertions(+), 2 deletions(-)

diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs
index 58c0ca1..552c0d0 100644
--- a/compiler/typecheck/TcHsType.hs
+++ b/compiler/typecheck/TcHsType.hs
@@ -933,10 +933,17 @@ tcTyVar mode name         -- Could be a tyvar, a tycon, or a datacon
                   -> TcM (TcType, TcKind)
     handle_tyfams tc tc_tc
       | mightBeUnsaturatedTyCon tc_tc
-      = return (ty, tc_kind)
+      = do { traceTc "tcTyVar2a" (ppr tc_tc $$ ppr tc_kind)
+           ; return (ty, tc_kind) }
 
       | otherwise
-      = instantiateTyN 0 ty tc_kind
+      = do { (tc_ty, kind) <- instantiateTyN 0 ty tc_kind
+           -- tc and tc_ty must not be traced here, because that would
+           -- force the evaluation of a potentially knot-tied variable (tc),
+           -- and the typechecker would hang, as per #11708
+           ; traceTc "tcTyVar2b" (vcat [ ppr tc_tc <+> dcolon <+> ppr tc_kind
+                                       , ppr kind ])
+           ; return (tc_ty, kind) }
       where
         ty      = mkNakedTyConApp tc []
         tc_kind = tyConKind tc_tc