[Git][ghc/ghc][wip/T20264] Improve zonking of foreign decls to avoid TcTyVars escaping

[Simon Peyton Jones (@simonpj)]

Simon Peyton Jones pushed to branch wip/T20264 at Glasgow Haskell Compiler / GHC


Commits:
2df7352c by Simon Peyton Jones at 2024-11-03T00:03:38+00:00
Improve zonking of foreign decls to avoid TcTyVars escaping

- - - - -


3 changed files:

- compiler/GHC/Core/Opt/Simplify/Env.hs
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Tc/Zonk/Type.hs


Changes:

=====================================
compiler/GHC/Core/Opt/Simplify/Env.hs
=====================================
@@ -1133,7 +1133,7 @@ substIdBndr env bndr
 --                = extendVarEnv tv_subst old_tv (DoneId new_tv)
 --                | otherwise
 --                = delVarEnv tv_subst old_tv
--- 
+--
 --     !new_in_scope = in_scope `extendInScopeSet` new_tv
 
 ---------------


=====================================
compiler/GHC/Core/Opt/Simplify/Iteration.hs
=====================================
@@ -1889,7 +1889,7 @@ simpl_lam env bndr body (ApplyToTy { sc_arg_ty = arg_ty, sc_cont = cont })
   = do { tick (BetaReduction bndr)
        ; (floats1, env1)  <- completeTyVarBindX env bndr arg_ty
        ; (floats2, expr') <- simplLam env1 body cont
-       ; return (floats1 `addFloats` floats2, expr') } 
+       ; return (floats1 `addFloats` floats2, expr') }
 
 -- Coercion beta-reduction
 simpl_lam env bndr body (ApplyToVal { sc_arg = Coercion arg_co, sc_env = arg_se


=====================================
compiler/GHC/Tc/Zonk/Type.hs
=====================================
@@ -667,11 +667,13 @@ zonkTopDecls :: Bag EvBind
 zonkTopDecls ev_binds binds rules imp_specs fords
   = initZonkEnv DefaultFlexi $
     runZonkBndrT (zonkEvBinds ev_binds)   $ \ ev_binds' ->
+    runZonkBndrT (zonkForeignDecls fords) $ \ fords'    ->
+      -- Do foreign decls first; they bring Ids
+      -- into scope that are mentioned in `binds`
     runZonkBndrT (zonkRecMonoBinds binds) $ \ binds'    ->
      -- Top level is implicitly recursive
   do  { rules' <- zonkRules rules
       ; specs' <- zonkLTcSpecPrags imp_specs
-      ; fords' <- zonkForeignDecls fords
       ; ty_env <- zonkEnvIds <$> getZonkEnv
       ; return (ty_env, ev_binds', binds', fords', specs', rules') }
 
@@ -1651,19 +1653,20 @@ zonkPats = traverse zonkPat
 -}
 
 zonkForeignDecls :: [LForeignDecl GhcTc]
-                   -> ZonkTcM [LForeignDecl GhcTc]
-zonkForeignDecls ls = mapM (wrapLocZonkMA zonkForeignDecl) ls
+                 -> ZonkBndrTcM [LForeignDecl GhcTc]
+zonkForeignDecls ls = mapM (wrapLocZonkBndrMA zonkForeignDecl) ls
 
-zonkForeignDecl :: ForeignDecl GhcTc -> ZonkTcM (ForeignDecl GhcTc)
+zonkForeignDecl :: ForeignDecl GhcTc -> ZonkBndrTcM (ForeignDecl GhcTc)
 -- Zonk foreign decls, even though they are closed, to turn TcTyVars into TyVars
 zonkForeignDecl fd@(ForeignExport { fd_name = i, fd_e_ext = co })
-  = do { i'  <- zonkLIdOcc i
+  = noBinders $
+    do { i'  <- zonkLIdOcc i
        ; co' <- zonkCoToCo co
        ; return (fd { fd_name = i', fd_e_ext = co' }) }
-zonkForeignDecl fd@(ForeignImport { fd_name = i, fd_i_ext = co })
-  = do { i'  <- zonkLIdOcc i
-       ; co' <- zonkCoToCo co
-       ; return (fd { fd_name = i', fd_i_ext = co' }) }
+zonkForeignDecl fd@(ForeignImport { fd_name = L loc i, fd_i_ext = co })
+  = do { i'  <- zonkIdBndrX i
+       ; co' <- noBinders $ zonkCoToCo co
+       ; return (fd { fd_name = L loc i', fd_i_ext = co' }) }
 
 zonkRules :: [LRuleDecl GhcTc] -> ZonkTcM [LRuleDecl GhcTc]
 zonkRules rs = mapM (wrapLocZonkMA zonkRule) rs



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2df7352c3ce859c2a2377f01623bdedeb1a16aa8

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2df7352c3ce859c2a2377f01623bdedeb1a16aa8
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/20241102/b1928bb9/attachment-0001.html>