[Git][ghc/ghc][wip/T22010] Rename same to sameUnique & anyOf to anyOfUnique
Jaro Reinders (@Noughtmare)
gitlab at gitlab.haskell.org
Mon Jun 26 10:25:15 UTC 2023
Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC
Commits:
5da7cfaf by Jaro Reinders at 2023-06-26T12:25:06+02:00
Rename same to sameUnique & anyOf to anyOfUnique
- - - - -
6 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
- compiler/GHC/Utils/Unique.hs
Changes:
=====================================
compiler/GHC/HsToCore/Match/Literal.hs
=====================================
@@ -64,7 +64,7 @@ import GHC.Utils.Outputable as Outputable
import GHC.Utils.Misc
import GHC.Utils.Panic
import GHC.Utils.Panic.Plain
-import GHC.Utils.Unique (same)
+import GHC.Utils.Unique (sameUnique)
import GHC.Data.FastString
@@ -320,29 +320,29 @@ warnAboutOverflowedLiterals dflags lit
, Just (i, tc) <- lit
= if
-- These only show up via the 'HsOverLit' route
- | same tc intTyConName -> check i tc minInt maxInt
- | same tc wordTyConName -> check i tc minWord maxWord
- | same tc int8TyConName -> check i tc (min' @Int8) (max' @Int8)
- | same tc int16TyConName -> check i tc (min' @Int16) (max' @Int16)
- | same tc int32TyConName -> check i tc (min' @Int32) (max' @Int32)
- | same tc int64TyConName -> check i tc (min' @Int64) (max' @Int64)
- | same tc word8TyConName -> check i tc (min' @Word8) (max' @Word8)
- | same tc word16TyConName -> check i tc (min' @Word16) (max' @Word16)
- | same tc word32TyConName -> check i tc (min' @Word32) (max' @Word32)
- | same tc word64TyConName -> check i tc (min' @Word64) (max' @Word64)
- | same tc naturalTyConName -> checkPositive i tc
+ | sameUnique tc intTyConName -> check i tc minInt maxInt
+ | sameUnique tc wordTyConName -> check i tc minWord maxWord
+ | sameUnique tc int8TyConName -> check i tc (min' @Int8) (max' @Int8)
+ | sameUnique tc int16TyConName -> check i tc (min' @Int16) (max' @Int16)
+ | sameUnique tc int32TyConName -> check i tc (min' @Int32) (max' @Int32)
+ | sameUnique tc int64TyConName -> check i tc (min' @Int64) (max' @Int64)
+ | sameUnique tc word8TyConName -> check i tc (min' @Word8) (max' @Word8)
+ | sameUnique tc word16TyConName -> check i tc (min' @Word16) (max' @Word16)
+ | sameUnique tc word32TyConName -> check i tc (min' @Word32) (max' @Word32)
+ | sameUnique tc word64TyConName -> check i tc (min' @Word64) (max' @Word64)
+ | sameUnique tc naturalTyConName -> checkPositive i tc
-- These only show up via the 'HsLit' route
- | same tc intPrimTyConName -> check i tc minInt maxInt
- | same tc wordPrimTyConName -> check i tc minWord maxWord
- | same tc int8PrimTyConName -> check i tc (min' @Int8) (max' @Int8)
- | same tc int16PrimTyConName -> check i tc (min' @Int16) (max' @Int16)
- | same tc int32PrimTyConName -> check i tc (min' @Int32) (max' @Int32)
- | same tc int64PrimTyConName -> check i tc (min' @Int64) (max' @Int64)
- | same tc word8PrimTyConName -> check i tc (min' @Word8) (max' @Word8)
- | same tc word16PrimTyConName -> check i tc (min' @Word16) (max' @Word16)
- | same tc word32PrimTyConName -> check i tc (min' @Word32) (max' @Word32)
- | same tc word64PrimTyConName -> check i tc (min' @Word64) (max' @Word64)
+ | sameUnique tc intPrimTyConName -> check i tc minInt maxInt
+ | sameUnique tc wordPrimTyConName -> check i tc minWord maxWord
+ | sameUnique tc int8PrimTyConName -> check i tc (min' @Int8) (max' @Int8)
+ | sameUnique tc int16PrimTyConName -> check i tc (min' @Int16) (max' @Int16)
+ | sameUnique tc int32PrimTyConName -> check i tc (min' @Int32) (max' @Int32)
+ | sameUnique tc int64PrimTyConName -> check i tc (min' @Int64) (max' @Int64)
+ | sameUnique tc word8PrimTyConName -> check i tc (min' @Word8) (max' @Word8)
+ | sameUnique tc word16PrimTyConName -> check i tc (min' @Word16) (max' @Word16)
+ | sameUnique tc word32PrimTyConName -> check i tc (min' @Word32) (max' @Word32)
+ | sameUnique tc word64PrimTyConName -> check i tc (min' @Word64) (max' @Word64)
| otherwise -> return ()
@@ -399,22 +399,22 @@ warnAboutEmptyEnumerations fam_envs dflags fromExpr mThnExpr toExpr
platform <- targetPlatform <$> getDynFlags
-- Be careful to use target Int/Word sizes! cf #17336
- if | same tc intTyConName -> case platformWordSize platform of
- PW4 -> check @Int32
- PW8 -> check @Int64
- | same tc wordTyConName -> case platformWordSize platform of
- PW4 -> check @Word32
- PW8 -> check @Word64
- | same tc int8TyConName -> check @Int8
- | same tc int16TyConName -> check @Int16
- | same tc int32TyConName -> check @Int32
- | same tc int64TyConName -> check @Int64
- | same tc word8TyConName -> check @Word8
- | same tc word16TyConName -> check @Word16
- | same tc word32TyConName -> check @Word32
- | same tc word64TyConName -> check @Word64
- | same tc integerTyConName -> check @Integer
- | same tc naturalTyConName -> check @Integer
+ if | sameUnique tc intTyConName -> case platformWordSize platform of
+ PW4 -> check @Int32
+ PW8 -> check @Int64
+ | sameUnique tc wordTyConName -> case platformWordSize platform of
+ PW4 -> check @Word32
+ PW8 -> check @Word64
+ | sameUnique tc int8TyConName -> check @Int8
+ | sameUnique tc int16TyConName -> check @Int16
+ | sameUnique tc int32TyConName -> check @Int32
+ | sameUnique tc int64TyConName -> check @Int64
+ | sameUnique tc word8TyConName -> check @Word8
+ | sameUnique tc word16TyConName -> check @Word16
+ | sameUnique tc word32TyConName -> check @Word32
+ | sameUnique tc word64TyConName -> check @Word64
+ | sameUnique tc integerTyConName -> check @Integer
+ | sameUnique tc naturalTyConName -> check @Integer
-- We use 'Integer' because otherwise a negative 'Natural' literal
-- could cause a compile time crash (instead of a runtime one).
-- See the T10930b test case for an example of where this matters.
=====================================
compiler/GHC/StgToCmm/Ticky.hs
=====================================
@@ -157,7 +157,7 @@ import GHC.Types.Id.Info
import GHC.StgToCmm.Env (getCgInfo_maybe)
import Data.Coerce (coerce)
import GHC.Utils.Json
-import GHC.Utils.Unique (anyOf)
+import GHC.Utils.Unique (anyOfUnique)
-----------------------------------------------------------------------------
--
@@ -886,18 +886,18 @@ showTypeCategory ty
Nothing -> '.'
Just (tycon, _) ->
case () of
- _ | anyOf tycon [fUNTyConKey] -> '>'
- | anyOf tycon [charTyConKey] -> 'C'
- | anyOf tycon [charPrimTyConKey] -> 'c'
- | anyOf tycon [doubleTyConKey] -> 'D'
- | anyOf tycon [doublePrimTyConKey] -> 'd'
- | anyOf tycon [floatTyConKey] -> 'F'
- | anyOf tycon [floatPrimTyConKey] -> 'f'
- | anyOf tycon [intTyConKey, int8TyConKey, int16TyConKey, int32TyConKey, int64TyConKey] -> 'I'
- | anyOf tycon [intPrimTyConKey, int8PrimTyConKey, int16PrimTyConKey, int32PrimTyConKey, int64PrimTyConKey] -> 'i'
- | anyOf tycon [wordTyConKey, word8TyConKey, word16TyConKey, word32TyConKey, word64TyConKey] -> 'W'
- | anyOf tycon [wordPrimTyConKey, word8PrimTyConKey, word16PrimTyConKey, word32PrimTyConKey, word64PrimTyConKey] -> 'w'
- | anyOf tycon [listTyConKey] -> 'L'
+ _ | anyOfUnique tycon [fUNTyConKey] -> '>'
+ | anyOfUnique tycon [charTyConKey] -> 'C'
+ | anyOfUnique tycon [charPrimTyConKey] -> 'c'
+ | anyOfUnique tycon [doubleTyConKey] -> 'D'
+ | anyOfUnique tycon [doublePrimTyConKey] -> 'd'
+ | anyOfUnique tycon [floatTyConKey] -> 'F'
+ | anyOfUnique tycon [floatPrimTyConKey] -> 'f'
+ | anyOfUnique tycon [intTyConKey, int8TyConKey, int16TyConKey, int32TyConKey, int64TyConKey] -> 'I'
+ | anyOfUnique tycon [intPrimTyConKey, int8PrimTyConKey, int16PrimTyConKey, int32PrimTyConKey, int64PrimTyConKey] -> 'i'
+ | anyOfUnique tycon [wordTyConKey, word8TyConKey, word16TyConKey, word32TyConKey, word64TyConKey] -> 'W'
+ | anyOfUnique tycon [wordPrimTyConKey, word8PrimTyConKey, word16PrimTyConKey, word32PrimTyConKey, word64PrimTyConKey] -> 'w'
+ | anyOfUnique tycon [listTyConKey] -> 'L'
| isUnboxedTupleTyCon tycon -> 't'
| isTupleTyCon tycon -> 'T'
| isPrimTyCon tycon -> 'P'
=====================================
compiler/GHC/Tc/Deriv/Utils.hs
=====================================
@@ -66,7 +66,7 @@ import GHC.Builtin.Names.TH (liftClassKey)
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.Error
-import GHC.Utils.Unique (same)
+import GHC.Utils.Unique (sameUnique)
import Control.Monad.Trans.Reader
import Data.Foldable (traverse_)
@@ -894,36 +894,36 @@ classArgsErr cls cls_tys = DerivErrNotAClass (mkClassPred cls cls_tys)
-- class for which stock deriving isn't possible.
stockSideConditions :: DerivContext -> Class -> Maybe Condition
stockSideConditions deriv_ctxt cls
- | same cls_key eqClassKey = Just (cond_std `andCond` cond_args cls)
- | same cls_key ordClassKey = Just (cond_std `andCond` cond_args cls)
- | same cls_key showClassKey = Just (cond_std `andCond` cond_args cls)
- | same cls_key readClassKey = Just (cond_std `andCond` cond_args cls)
- | same cls_key enumClassKey = Just (cond_std `andCond` cond_isEnumeration)
- | same cls_key ixClassKey = Just (cond_std `andCond` cond_enumOrProduct cls)
- | same cls_key boundedClassKey = Just (cond_std `andCond` cond_enumOrProduct cls)
- | same cls_key dataClassKey = Just (checkFlag LangExt.DeriveDataTypeable `andCond`
- cond_vanilla `andCond`
- cond_args cls)
- | same cls_key functorClassKey = Just (checkFlag LangExt.DeriveFunctor `andCond`
- cond_vanilla `andCond`
- cond_functorOK True False)
- | same cls_key foldableClassKey = Just (checkFlag LangExt.DeriveFoldable `andCond`
- cond_vanilla `andCond`
- cond_functorOK False True)
- -- Functor/Fold/Trav works ok
- -- for rank-n types
- | same cls_key traversableClassKey = Just (checkFlag LangExt.DeriveTraversable `andCond`
- cond_vanilla `andCond`
- cond_functorOK False False)
- | same cls_key genClassKey = Just (checkFlag LangExt.DeriveGeneric `andCond`
- cond_vanilla `andCond`
- cond_RepresentableOk)
- | same cls_key gen1ClassKey = Just (checkFlag LangExt.DeriveGeneric `andCond`
- cond_vanilla `andCond`
- cond_Representable1Ok)
- | same cls_key liftClassKey = Just (checkFlag LangExt.DeriveLift `andCond`
- cond_vanilla `andCond`
- cond_args cls)
+ | sameUnique cls_key eqClassKey = Just (cond_std `andCond` cond_args cls)
+ | sameUnique cls_key ordClassKey = Just (cond_std `andCond` cond_args cls)
+ | sameUnique cls_key showClassKey = Just (cond_std `andCond` cond_args cls)
+ | sameUnique cls_key readClassKey = Just (cond_std `andCond` cond_args cls)
+ | sameUnique cls_key enumClassKey = Just (cond_std `andCond` cond_isEnumeration)
+ | sameUnique cls_key ixClassKey = Just (cond_std `andCond` cond_enumOrProduct cls)
+ | sameUnique cls_key boundedClassKey = Just (cond_std `andCond` cond_enumOrProduct cls)
+ | sameUnique cls_key dataClassKey = Just (checkFlag LangExt.DeriveDataTypeable `andCond`
+ cond_vanilla `andCond`
+ cond_args cls)
+ | sameUnique cls_key functorClassKey = Just (checkFlag LangExt.DeriveFunctor `andCond`
+ cond_vanilla `andCond`
+ cond_functorOK True False)
+ | sameUnique cls_key foldableClassKey = Just (checkFlag LangExt.DeriveFoldable `andCond`
+ cond_vanilla `andCond`
+ cond_functorOK False True)
+ -- Functor/Fold/Trav works ok
+ -- for rank-n types
+ | sameUnique cls_key traversableClassKey = Just (checkFlag LangExt.DeriveTraversable `andCond`
+ cond_vanilla `andCond`
+ cond_functorOK False False)
+ | sameUnique cls_key genClassKey = Just (checkFlag LangExt.DeriveGeneric `andCond`
+ cond_vanilla `andCond`
+ cond_RepresentableOk)
+ | sameUnique cls_key gen1ClassKey = Just (checkFlag LangExt.DeriveGeneric `andCond`
+ cond_vanilla `andCond`
+ cond_Representable1Ok)
+ | sameUnique cls_key liftClassKey = Just (checkFlag LangExt.DeriveLift `andCond`
+ cond_vanilla `andCond`
+ cond_args cls)
| otherwise = Nothing
where
cls_key = getUnique cls
=====================================
compiler/GHC/Tc/Utils/Instantiate.hs
=====================================
@@ -89,7 +89,7 @@ import GHC.Utils.Misc
import GHC.Utils.Panic
import GHC.Utils.Panic.Plain
import GHC.Utils.Outputable
-import GHC.Utils.Unique (same)
+import GHC.Utils.Unique (sameUnique)
import GHC.Unit.State
import GHC.Unit.External
@@ -792,17 +792,17 @@ hasFixedRuntimeRepRes std_nm user_expr ty = mapM_ do_check mb_arity
in hasFixedRuntimeRep_syntactic (FRRArrow $ ArrowFun user_expr) res_ty
mb_arity :: Maybe Arity
mb_arity -- arity of the arrow operation, counting type-level arguments
- | same std_nm arrAName -- result used as an argument in, e.g., do_premap
+ | sameUnique std_nm arrAName -- result used as an argument in, e.g., do_premap
= Just 3
- | same std_nm composeAName -- result used as an argument in, e.g., dsCmdStmt/BodyStmt
+ | sameUnique std_nm composeAName -- result used as an argument in, e.g., dsCmdStmt/BodyStmt
= Just 5
- | same std_nm firstAName -- result used as an argument in, e.g., dsCmdStmt/BodyStmt
+ | sameUnique std_nm firstAName -- result used as an argument in, e.g., dsCmdStmt/BodyStmt
= Just 4
- | same std_nm appAName -- result used as an argument in, e.g., dsCmd/HsCmdArrApp/HsHigherOrderApp
+ | sameUnique std_nm appAName -- result used as an argument in, e.g., dsCmd/HsCmdArrApp/HsHigherOrderApp
= Just 2
- | same std_nm choiceAName -- result used as an argument in, e.g., HsCmdIf
+ | sameUnique std_nm choiceAName -- result used as an argument in, e.g., HsCmdIf
= Just 5
- | same std_nm loopAName -- result used as an argument in, e.g., HsCmdIf
+ | sameUnique std_nm loopAName -- result used as an argument in, e.g., HsCmdIf
= Just 4
| otherwise
= Nothing
=====================================
compiler/GHC/Tc/Utils/TcType.hs
=====================================
@@ -249,7 +249,7 @@ import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.Panic.Plain
import GHC.Utils.Error( Validity'(..) )
-import GHC.Utils.Unique( anyOf )
+import GHC.Utils.Unique( anyOfUnique )
import qualified GHC.LanguageExtensions as LangExt
import Data.IORef ( IORef )
@@ -2256,16 +2256,16 @@ marshalableTyCon dflags tc
boxedMarshalableTyCon :: TyCon -> Validity' TypeCannotBeMarshaledReason
boxedMarshalableTyCon tc
- | anyOf tc [ intTyConKey, int8TyConKey, int16TyConKey
- , int32TyConKey, int64TyConKey
- , wordTyConKey, word8TyConKey, word16TyConKey
- , word32TyConKey, word64TyConKey
- , floatTyConKey, doubleTyConKey
- , ptrTyConKey, funPtrTyConKey
- , charTyConKey
- , stablePtrTyConKey
- , boolTyConKey
- ]
+ | anyOfUnique tc [ intTyConKey, int8TyConKey, int16TyConKey
+ , int32TyConKey, int64TyConKey
+ , wordTyConKey, word8TyConKey, word16TyConKey
+ , word32TyConKey, word64TyConKey
+ , floatTyConKey, doubleTyConKey
+ , ptrTyConKey, funPtrTyConKey
+ , charTyConKey
+ , stablePtrTyConKey
+ , boolTyConKey
+ ]
= IsValid
| otherwise = NotValid NotABoxedMarshalableTyCon
=====================================
compiler/GHC/Utils/Unique.hs
=====================================
@@ -2,34 +2,34 @@
{- Work around #23537
-On 32 bit systems, GHC's code gen around 64 bit numbers is not quite
+On 32 bit systems, GHC's codegen around 64 bit numbers is not quite
complete. This led to panics mentioning missing cases in iselExpr64.
Now that GHC uses Word64 for its uniques, these panics have started
popping up whenever a unique is compared to many other uniques in one
-function. As a work around we use these two functions which are not
+function. As a workaround we use these two functions which are not
inlined on 32 bit systems, thus preventing the panics.
-}
-module GHC.Utils.Unique (same, anyOf) where
+module GHC.Utils.Unique (sameUnique, anyOfUnique) where
#include "MachDeps.h"
-import GHC.Prelude.Basic ( Bool, Eq((==)), Foldable(elem) )
+import GHC.Prelude.Basic (Bool, Eq((==)), Foldable(elem))
import GHC.Types.Unique (Unique, Uniquable (getUnique))
#if WORD_SIZE_IN_BITS == 32
-{-# NOINLINE same #-}
+{-# NOINLINE sameUnique #-}
#else
-{-# INLINE same #-}
+{-# INLINE sameUnique #-}
#endif
-same :: Eq a => a -> a -> Bool
-same = (==)
+sameUnique :: Uniquable a => a -> a -> Bool
+sameUnique x y = getUnique x == getUnique y
#if WORD_SIZE_IN_BITS == 32
-{-# NOINLINE anyOf #-}
+{-# NOINLINE anyOfUnique #-}
#else
-{-# INLINE anyOf #-}
+{-# INLINE anyOfUnique #-}
#endif
-anyOf :: Uniquable a => a -> [Unique] -> Bool
-anyOf tc xs = getUnique tc `elem` xs
\ No newline at end of file
+anyOfUnique :: Uniquable a => a -> [Unique] -> Bool
+anyOfUnique tc xs = getUnique tc `elem` xs
\ No newline at end of file
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5da7cfaf00ef229c32832597b922e49bd919b668
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5da7cfaf00ef229c32832597b922e49bd919b668
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/20230626/1de25fd9/attachment-0001.html>
More information about the ghc-commits
mailing list