[Git][ghc/ghc][wip/int-index/emb-type] WIP (vdq): fix the subst in tcInstFun

[Vladislav Zavialov (@int-index)]

Vladislav Zavialov pushed to branch wip/int-index/emb-type at Glasgow Haskell Compiler / GHC


Commits:
7cdc9b2a by Vladislav Zavialov at 2022-10-30T18:29:54+04:00
WIP (vdq): fix the subst in tcInstFun

- - - - -


3 changed files:

- compiler/GHC/Tc/Gen/App.hs
- + testsuite/tests/vdq-rta/should_compile/T22326_callStack.hs
- testsuite/tests/vdq-rta/should_compile/all.T


Changes:

=====================================
compiler/GHC/Tc/Gen/App.hs
=====================================
@@ -613,22 +613,21 @@ tcInstFun do_ql inst_final (rn_fun, fun_ctxt) fun_sigma rn_args
     go1 delta acc so_far fun_ty ((EValArg { eva_arg = ValArg arg }) : rest_args)
       | Just (tvb, body) <- tcSplitForAllTyVarBinder_maybe fun_ty
       , binderArgFlag tvb == Required
-      = do { -- TODO (int-index): zonk the inner type?
+      = do { let tv = binderVar tvb
+           ; ty_arg <- tc_vdq_arg (tyVarKind tv) arg
+             -- TODO (int-index): zonk the inner type?
              --                   This is what tcVTA does. See #14158 and Note [Visible type application zonk]
              --                   However, I tried to reproduce the issue in T14158_vdq
              --                   and it works even without a zonk here.
-             let free_tvs = tyCoVarsOfType body
-                 in_scope = mkInScopeSet (free_tvs `delVarSet` tv)
-                 empty_subst = mkEmptySubst in_scope
-                 tv = binderVar tvb
-           ; inst_ty <- tc_vdq_arg (tyVarKind tv) arg
-           ; let subst     = extendTvSubst empty_subst tv inst_ty
-                 inst_body = substTy subst body
-                 wrap      = mkWpTyApps [inst_ty]
+           ; let in_scope  = mkInScopeSet (tyCoVarsOfTypes [fun_ty, ty_arg])
+                                -- TODO (int-index): I used fun_ty instead of body here, as that's what tcVTA does.
+                                -- But why? Using tyCoVarOfTypes [body, ty_arg] seems to work just as well.
+                 inst_body = substTyWithInScope in_scope [tv] [ty_arg] body
+                 wrap      = mkWpTyApps [ty_arg]
            ; traceTc "Instantiating VDQ"
                  (vcat [ text "tv"   <+> ppr tv
                        , text "type" <+> debugPprType body
-                       , text "with" <+> debugPprType inst_ty])
+                       , text "with" <+> debugPprType ty_arg])
            ; go delta (addArgWrap wrap acc) so_far inst_body rest_args
            }
 


=====================================
testsuite/tests/vdq-rta/should_compile/T22326_callStack.hs
=====================================
@@ -0,0 +1,12 @@
+{-# LANGUAGE ExplicitNamespaces #-}
+{-# LANGUAGE RequiredTypeArguments #-}
+
+module T22326_callStack where
+
+import GHC.Stack
+
+u :: HasCallStack => ()
+u = ()
+
+f :: forall a -> ()
+f (type _) = u


=====================================
testsuite/tests/vdq-rta/should_compile/all.T
=====================================
@@ -5,6 +5,7 @@ test('T22326_typeRep', normal, compile, [''])
 test('T22326_sizeOf', normal, compile, [''])
 test('T22326_symbolVal', normal, compile, [''])
 test('T22326_noext', extra_files(['T22326_noext_def.hs']), multimod_compile, ['T22326_noext', '-v0'])
+test('T22326_callStack', normal, compile, [''])
 test('T17792_vdq', normal, compile, [''])
 test('T14158_vdq', normal, compile, [''])
 



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7cdc9b2ace685a525afbf9732b096133cd2010e7

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7cdc9b2ace685a525afbf9732b096133cd2010e7
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20221030/1f7e6033/attachment-0001.html>