[Git][ghc/ghc][wip/T24725] Wibble

[Simon Peyton Jones (@simonpj)]

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


Commits:
38275e18 by Simon Peyton Jones at 2024-06-16T23:37:39+01:00
Wibble

- - - - -


1 changed file:

- compiler/GHC/Core/TyCo/Compare.hs


Changes:

=====================================
compiler/GHC/Core/TyCo/Compare.hs
=====================================
@@ -266,11 +266,13 @@ inline_generic_eq_type_x syn_flag mult_flag mb_env
 
     -------------------
     go_with_kc :: Type -> Type -> EqTyRes
+    -- Returns a boolean because it does its own kind-check
     {-# INLINE go_with_kc #-}
-    go_with_kc ty1 ty2 = case go ty1 ty2 of
-                           NotEq    -> NotEq
-                           IsEq     -> IsEq
-                           IsEqCast -> go (typeKind ty1) (typeKind ty2)
+    go_with_kc ty1 ty2
+      = case go ty1 ty2 of
+          NotEq    -> NotEq
+          IsEq     -> IsEq
+          IsEqCast -> go (typeKind ty1) (typeKind ty2)
 
     -------------------
     inline_go !t1 !t2 | 1# <- reallyUnsafePtrEquality# t1 t2 = IsEq
@@ -297,11 +299,12 @@ inline_generic_eq_type_x syn_flag mult_flag mb_env
     -- See Note [Equality on FunTys] in GHC.Core.TyCo.Rep: we must check
     -- kinds here
     inline_go (FunTy _ w1 arg1 res1) (FunTy _ w2 arg2 res2)
-      =   go_with_kc arg1 arg2
-      &=& go_with_kc res1 res2
-      &=& (case mult_flag of
-            RespectMultiplicities -> go w1 w2
-            IgnoreMultiplicities  -> IsEq)
+      =   killEqCast $  -- All kind checking is done explicitly
+          go_with_kc arg1 arg2
+          &=& go_with_kc res1 res2
+          &=& (case mult_flag of
+                  RespectMultiplicities -> go w1 w2
+                  IgnoreMultiplicities  -> IsEq)
 
       -- See Note [Equality on AppTys] in GHC.Core.Type
     inline_go (AppTy s1 t1) ty2
@@ -347,6 +350,10 @@ addEqCast :: EqTyRes -> EqTyRes
 addEqCast NotEq = NotEq
 addEqCast _     = IsEqCast
 
+killEqCast :: EqTyRes -> EqTyRes
+killEqCast IsEqCast = IsEq
+killEqCast x        = x
+
 boolEqTyRes :: Bool -> EqTyRes
 boolEqTyRes True  = IsEq
 boolEqTyRes False = NotEq
@@ -579,6 +586,7 @@ comparing type variables is nondeterministic, note the call to nonDetCmpVar in
 nonDetCmpTypeX.
 See Note [Unique Determinism] for more details.
 -}
+
 nonDetCmpType :: Type -> Type -> Ordering
 {-# INLINE nonDetCmpType #-}
 nonDetCmpType !t1 !t2



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/38275e18011840c72fddbe4811c3f86872e766b5
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/20240616/7e25593f/attachment-0001.html>