[Git][ghc/ghc][wip/T24978] Wibbles

[Simon Peyton Jones (@simonpj)]

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


Commits:
c2f2f171 by Simon Peyton Jones at 2024-06-12T16:21:32+01:00
Wibbles

- - - - -


5 changed files:

- compiler/GHC/Core/Coercion/Opt.hs
- testsuite/tests/pmcheck/should_compile/T11195.hs
- testsuite/tests/tcplugins/CtIdPlugin.hs
- testsuite/tests/tcplugins/RewritePlugin.hs
- testsuite/tests/tcplugins/TyFamPlugin.hs


Changes:

=====================================
compiler/GHC/Core/Coercion/Opt.hs
=====================================
@@ -526,6 +526,10 @@ in GHC.Core.Coercion.
 -- | Optimize a phantom coercion. The input coercion may not necessarily
 -- be a phantom, but the output sure will be.
 opt_phantom :: LiftingContext -> SymFlag -> Coercion -> NormalCo
+opt_phantom env sym (UnivCo { uco_prov = prov, uco_lty = t1
+                            , uco_rty = t2, uco_deps = deps })
+  = opt_univ env sym prov deps Phantom t1 t2
+
 opt_phantom env sym co
   = opt_univ env sym PhantomProv [mkKindCo co] Phantom ty1 ty2
   where


=====================================
testsuite/tests/pmcheck/should_compile/T11195.hs
=====================================
@@ -76,7 +76,7 @@ opt_trans_rule is in_co1@(InstCo co1 ty1) in_co2@(InstCo co2 ty2)
   , co1 `compatible_co` co2 = undefined
 
 opt_trans_rule is (UnivCo { uco_prov = p1 })
-                  (UnivCo ( uco_prov = p2 })
+                  (UnivCo { uco_prov = p2 })
   | p1 == p2 = undefined
     -- if the provenances are different, opt'ing will be very confusing
 


=====================================
testsuite/tests/tcplugins/CtIdPlugin.hs
=====================================
@@ -42,7 +42,7 @@ solver :: [String]
        -> PluginDefs -> EvBindsVar -> [Ct] -> [Ct]
        -> TcPluginM TcPluginSolveResult
 solver _args defs ev givens wanteds = do
-  let pluginCo = mkUnivCo (PluginProv "CtIdPlugin") emptyUniqDSet Representational  -- Empty is fine. This plugin does not use "givens".
+  let pluginCo = mkUnivCo (PluginProv "CtIdPlugin") [] Representational  -- Empty is fine. This plugin does not use "givens".
   let substEvidence ct ct' =
         evCast (ctEvExpr $ ctEvidence ct') $ pluginCo (ctPred ct') (ctPred ct)
 


=====================================
testsuite/tests/tcplugins/RewritePlugin.hs
=====================================
@@ -87,5 +87,5 @@ mkTyFamReduction :: TyCon -> [ Type ] -> Type -> Reduction
 mkTyFamReduction tyCon args res = Reduction co res
   where
     co :: Coercion
-    co = mkUnivCo ( PluginProv "RewritePlugin") emptyUniqDSet Nominal  -- Empty is fine. This plugin does not use "givens".
+    co = mkUnivCo ( PluginProv "RewritePlugin") [] Nominal  -- Empty is fine. This plugin does not use "givens".
            ( mkTyConApp tyCon args ) res


=====================================
testsuite/tests/tcplugins/TyFamPlugin.hs
=====================================
@@ -80,6 +80,6 @@ solveCt ( PluginDefs {..} ) ct@( classifyPredType . ctPred -> EqPred NomEq lhs r
   , let
       evTerm :: EvTerm
       evTerm = EvExpr . Coercion
-             $ mkUnivCo ( PluginProv "TyFamPlugin") emptyUniqDSet Nominal lhs rhs  -- Empty is fine. This plugin does not use "givens".
+             $ mkUnivCo ( PluginProv "TyFamPlugin") [] Nominal lhs rhs  -- Empty is fine. This plugin does not use "givens".
   = pure $ Just ( evTerm, ct )
 solveCt _ ct = pure Nothing



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c2f2f17111f808fb0af473ed153310d2fc37d5e0
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/20240612/6f6132ba/attachment-0001.html>