[commit: ghc] master: Zonk the type in reifyInstances (fixes Trac #7477) (8944fd3)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/8944fd3fc5fa7d435f438c5680c8d177257d27e9/ghc

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

commit 8944fd3fc5fa7d435f438c5680c8d177257d27e9
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Wed Nov 6 09:30:20 2013 +0000

    Zonk the type in reifyInstances (fixes Trac #7477)
    
    A simple oversight, but crucial!  tcLHsType was returning
        F k Int
    where k is a unification variable that has been unified with *


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

8944fd3fc5fa7d435f438c5680c8d177257d27e9
 compiler/typecheck/TcSplice.lhs |    6 ++++++
 1 file changed, 6 insertions(+)

diff --git a/compiler/typecheck/TcSplice.lhs b/compiler/typecheck/TcSplice.lhs
index 5a55d25..fde2d7b 100644
--- a/compiler/typecheck/TcSplice.lhs
+++ b/compiler/typecheck/TcSplice.lhs
@@ -1171,16 +1171,22 @@ reifyInstances th_nm th_tys
         ; (rn_ty, _fvs) <- checkNoErrs $ rnLHsType doc rdr_ty   -- Rename  to HsType Name
                          -- checkNoErrs: see Note [Renamer errors]
         ; (ty, _kind)  <- tcLHsType rn_ty
+        ; ty <- zonkTcTypeToType emptyZonkEnv ty   -- Substitute out the meta type variables
+                                                   -- In particular, the type might have kind
+                                                   -- variables inside it (Trac #7477)
 
+        ; traceTc "reifyInstances" (ppr ty $$ ppr (typeKind ty))
         ; case splitTyConApp_maybe ty of   -- This expands any type synonyms
             Just (tc, tys)                 -- See Trac #7910
                | Just cls <- tyConClass_maybe tc
                -> do { inst_envs <- tcGetInstEnvs
                      ; let (matches, unifies, _) = lookupInstEnv inst_envs cls tys
+                     ; traceTc "reifyInstances1" (ppr matches)
                      ; mapM reifyClassInstance (map fst matches ++ unifies) }
                | isOpenFamilyTyCon tc
                -> do { inst_envs <- tcGetFamInstEnvs
                      ; let matches = lookupFamInstEnv inst_envs tc tys
+                     ; traceTc "reifyInstances2" (ppr matches)
                      ; mapM (reifyFamilyInstance . fim_instance) matches }
             _  -> bale_out (hang (ptext (sLit "reifyInstances:") <+> quotes (ppr ty)) 
                                2 (ptext (sLit "is not a class constraint or type family application"))) }