[Git][ghc/ghc][wip/T21623] Wibbles

[Simon Peyton Jones (@simonpj)]

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


Commits:
c94b50dd by Simon Peyton Jones at 2022-10-16T23:28:41+01:00
Wibbles

- - - - -


3 changed files:

- compiler/GHC/Core/Coercion/Opt.hs
- testsuite/tests/partial-sigs/should_compile/T16728.stderr
- testsuite/tests/partial-sigs/should_compile/T21667.stderr


Changes:

=====================================
compiler/GHC/Core/Coercion/Opt.hs
=====================================
@@ -125,8 +125,19 @@ optCoercion :: OptCoercionOpts -> Subst -> Coercion -> NormalCo
 -- ^ optCoercion applies a substitution to a coercion,
 --   *and* optimises it to reduce its size
 optCoercion opts env co
-  | optCoercionEnabled opts = optCoercion' env co
-  | otherwise               = substCo env co
+  | optCoercionEnabled opts
+  = optCoercion' env co
+{-
+  = pprTrace "optCoercion {" (text "Co:" <+> ppr co) $
+    let result = optCoercion' env co in
+    pprTrace "optCoercion }" (vcat [ text "Co:" <+> ppr co
+                                   , text "Optco:" <+> ppr result ]) $
+    result
+-}
+
+  | otherwise
+  = substCo env co
+
 
 optCoercion' :: Subst -> Coercion -> NormalCo
 optCoercion' env co
@@ -197,9 +208,12 @@ opt_co3 env sym _                       r co = opt_co4_wrap env sym False r co
 
 -- See Note [Optimising coercion optimisation]
 -- | Optimize a non-phantom coercion.
-opt_co4, opt_co4_wrap :: LiftingContext -> SymFlag -> ReprFlag -> Role -> Coercion -> NormalCo
-
+opt_co4, opt_co4_wrap :: LiftingContext -> SymFlag -> ReprFlag
+                      -> Role -> Coercion -> NormalCo
+-- Precondition: In every call (opt_co4 lc sym rep role co)
+--               we should have role = coercionRole co
 opt_co4_wrap = opt_co4
+
 {-
 opt_co4_wrap env sym rep r co
   = pprTrace "opt_co4_wrap {"
@@ -207,12 +221,13 @@ opt_co4_wrap env sym rep r co
            , text "Rep:" <+> ppr rep
            , text "Role:" <+> ppr r
            , text "Co:" <+> ppr co ]) $
-    assert (r == coercionRole co )
+    assert (r == coercionRole co )    $
     let result = opt_co4 env sym rep r co in
     pprTrace "opt_co4_wrap }" (ppr co $$ text "---" $$ ppr result) $
     result
 -}
 
+
 opt_co4 env _   rep r (Refl ty)
   = assertPpr (r == Nominal)
               (text "Expected role:" <+> ppr r    $$
@@ -340,9 +355,10 @@ opt_co4 env sym rep r (TransCo co1 co2)
     in_scope = lcInScopeSet env
 
 opt_co4 env _sym rep r (SelCo n co)
-  | Just (ty, co_role) <- isReflCo_maybe co
-  = assert (r == co_role ) $
-    liftCoSubst (chooseRole rep r) env (getNthFromType n ty)
+  | Just (ty, _co_role) <- isReflCo_maybe co
+  = liftCoSubst (chooseRole rep r) env (getNthFromType n ty)
+    -- NB: it is /not/ true that r = _co_role
+    --     Rather, r = coercionRole (SelCo n co)
 
 opt_co4 env sym rep r (SelCo (SelTyCon n r1) (TyConAppCo _ _ cos))
   = assert (r == r1 )


=====================================
testsuite/tests/partial-sigs/should_compile/T16728.stderr
=====================================
@@ -1,9 +1,12 @@
 
-T16728.hs:8:37: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefault)]
+T16728.hs:8:37: warning: [GHC-88464] [-Wpartial-type-signatures]
     • Found type wildcard ‘_’ standing for ‘k’
       Where: ‘k’ is a rigid type variable bound by
                the inferred type of f :: Proxy x
                at T16728.hs:8:13
     • In the kind ‘_’
       In the first argument of ‘Proxy’, namely ‘(x :: _)’
-      In the type ‘Proxy (x :: _)’
+      In the type signature: f :: forall k (x :: k). Proxy (x :: _)
+  |
+8 | f :: forall k (x :: k). Proxy (x :: _)
+  |                                     ^


=====================================
testsuite/tests/partial-sigs/should_compile/T21667.stderr
=====================================
@@ -1,6 +1,8 @@
 
-T21667.hs:46:40: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefault)]
+T21667.hs:46:40: warning: [GHC-88464] [-Wpartial-type-signatures]
     • Found type wildcard ‘_’ standing for ‘"1" :: Symbol’
     • In the second argument of ‘ExoticTraversal'’, namely ‘_’
-      In the type ‘ExoticTraversal' a _ f’
       In the type signature: test :: forall a f. ExoticTraversal' a _ f
+   |
+46 | test :: forall a f. ExoticTraversal' a _ f
+   |                                        ^



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c94b50dd4b76458379cf2e36bc15e271d4f98cd2
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/20221016/a5bade1a/attachment-0001.html>