[Git][ghc/ghc][wip/T22010] Work around #23537

Jaro Reinders (@Noughtmare) gitlab at gitlab.haskell.org
Tue Jun 20 10:38:49 UTC 2023



Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC


Commits:
14c189a0 by Jaro Reinders at 2023-06-20T12:38:36+02:00
Work around #23537

- - - - -


5 changed files:

- compiler/GHC/HsToCore/Match/Literal.hs
- compiler/GHC/StgToCmm/Ticky.hs
- compiler/GHC/Tc/Deriv/Utils.hs
- compiler/GHC/Tc/Utils/Instantiate.hs
- compiler/GHC/Tc/Utils/TcType.hs


Changes:

=====================================
compiler/GHC/HsToCore/Match/Literal.hs
=====================================
@@ -369,6 +369,10 @@ warnAboutOverflowedLiterals dflags lit
       where
         bounds = Just (MinBound minB, MaxBound maxB)
 
+    -- Work around #23537
+    {-# NOINLINE (==) #-}
+    (==) = (GHC.Prelude.==)
+
 warnAboutEmptyEnumerations :: FamInstEnvs -> DynFlags -> LHsExpr GhcTc
                            -> Maybe (LHsExpr GhcTc)
                            -> LHsExpr GhcTc -> DsM ()
@@ -396,6 +400,10 @@ warnAboutEmptyEnumerations fam_envs dflags fromExpr mThnExpr toExpr
             to   = wrap @a to'
             mThn = fmap (wrap @a . fst) mThn'
 
+        -- Work around #23537
+        {-# NOINLINE (==) #-}
+        (==) = (GHC.Prelude.==)
+
       platform <- targetPlatform <$> getDynFlags
          -- Be careful to use target Int/Word sizes! cf #17336
       if | tc == intTyConName     -> case platformWordSize platform of


=====================================
compiler/GHC/StgToCmm/Ticky.hs
=====================================
@@ -884,7 +884,9 @@ showTypeCategory ty
   | otherwise = case tcSplitTyConApp_maybe ty of
   Nothing -> '.'
   Just (tycon, _) ->
-    let anyOf us = getUnique tycon `elem` us in
+    let -- Work around #23537
+        {-# NOINLINE anyOf #-}
+        anyOf us = getUnique tycon `elem` us in
     case () of
       _ | anyOf [fUNTyConKey] -> '>'
         | anyOf [charTyConKey] -> 'C'


=====================================
compiler/GHC/Tc/Deriv/Utils.hs
=====================================
@@ -931,6 +931,10 @@ stockSideConditions deriv_ctxt cls
     cond_vanilla = cond_stdOK deriv_ctxt True
       -- Vanilla data constructors but allow no data cons or polytype arguments
 
+    -- Work around #23537
+    {-# NOINLINE (==) #-}
+    (==) = (GHC.Prelude.==)
+
 type Condition
    = DynFlags
 


=====================================
compiler/GHC/Tc/Utils/Instantiate.hs
=====================================
@@ -806,6 +806,10 @@ hasFixedRuntimeRepRes std_nm user_expr ty = mapM_ do_check mb_arity
      | otherwise
      = Nothing
 
+   -- Work around #23537
+   {-# NOINLINE (==) #-}
+   (==) = (GHC.Prelude.==)
+
 {-
 ************************************************************************
 *                                                                      *


=====================================
compiler/GHC/Tc/Utils/TcType.hs
=====================================
@@ -2255,19 +2255,23 @@ marshalableTyCon dflags tc
 
 boxedMarshalableTyCon :: TyCon -> Validity' TypeCannotBeMarshaledReason
 boxedMarshalableTyCon tc
-   | getUnique tc `elem` [ intTyConKey, int8TyConKey, int16TyConKey
-                         , int32TyConKey, int64TyConKey
-                         , wordTyConKey, word8TyConKey, word16TyConKey
-                         , word32TyConKey, word64TyConKey
-                         , floatTyConKey, doubleTyConKey
-                         , ptrTyConKey, funPtrTyConKey
-                         , charTyConKey
-                         , stablePtrTyConKey
-                         , boolTyConKey
-                         ]
+  | anyOf [ intTyConKey, int8TyConKey, int16TyConKey
+          , int32TyConKey, int64TyConKey
+          , wordTyConKey, word8TyConKey, word16TyConKey
+          , word32TyConKey, word64TyConKey
+          , floatTyConKey, doubleTyConKey
+          , ptrTyConKey, funPtrTyConKey
+          , charTyConKey
+          , stablePtrTyConKey
+          , boolTyConKey
+          ]
   = IsValid
 
   | otherwise = NotValid NotABoxedMarshalableTyCon
+ where
+  -- Work around #23537
+  {-# NOINLINE anyOf #-}
+  anyOf x = getUnique tc `elem` x
 
 legalFIPrimArgTyCon :: DynFlags -> TyCon -> Validity' TypeCannotBeMarshaledReason
 -- Check args of 'foreign import prim', only allow simple unlifted types.



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/14c189a0f9cbd1d02996250b2c6a65d07b13619f
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/20230620/d618fbdf/attachment-0001.html>


More information about the ghc-commits mailing list