[Git][ghc/ghc][wip/T22010] Replace fromIntegral with specialized versions
Jaro Reinders (@Noughtmare)
gitlab at gitlab.haskell.org
Wed Jun 28 14:55:46 UTC 2023
Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC
Commits:
718d3295 by Jaro Reinders at 2023-06-28T16:55:37+02:00
Replace fromIntegral with specialized versions
- - - - -
10 changed files:
- compiler/GHC/Builtin/Uniques.hs
- compiler/GHC/Cmm/CommonBlockElim.hs
- compiler/GHC/Cmm/Dominators.hs
- compiler/GHC/CmmToAsm/CFG/Dominators.hs
- compiler/GHC/StgToJS/Symbols.hs
- compiler/GHC/Types/Unique.hs
- + compiler/GHC/Utils/Word64.hs
- compiler/ghc.cabal.in
- testsuite/tests/count-deps/CountDepsAst.stdout
- testsuite/tests/count-deps/CountDepsParser.stdout
Changes:
=====================================
compiler/GHC/Builtin/Uniques.hs
=====================================
@@ -1,4 +1,4 @@
-{-# LANGUAGE TypeApplications #-}
+
-- | This is where we define a mapping from Uniques to their associated
-- known-key Names for things associated with tuples and sums. We use this
@@ -69,7 +69,7 @@ import GHC.Utils.Panic
import GHC.Utils.Panic.Plain (assert)
import Data.Maybe
-import Data.Word (Word64)
+import GHC.Utils.Word64 (word64ToInt, intToWord64)
-- | Get the 'Name' associated with a known-key 'Unique'.
knownUniqueName :: Unique -> Maybe Name
@@ -87,7 +87,7 @@ knownUniqueName u =
where
(tag, n') = unpkUnique u
-- Known unique names are guaranteed to fit in Int, so we don't need the whole Word64.
- n = assert (isValidKnownKeyUnique u) (fromIntegral @Word64 @Int n')
+ n = assert (isValidKnownKeyUnique u) (word64ToInt n')
{-
Note [Unique layout for unboxed sums]
@@ -284,8 +284,8 @@ isTupleTyConUnique u =
(tag, n) = unpkUnique u
(arity', i) = quotRem n 2
arity =
- assert (arity' <= fromIntegral @Int @Word64 (maxBound :: Int))
- (fromIntegral @Word64 @Int arity')
+ assert (arity' <= intToWord64 (maxBound :: Int))
+ (word64ToInt arity')
getTupleTyConName :: Boxity -> Int -> Name
getTupleTyConName boxity n =
=====================================
compiler/GHC/Cmm/CommonBlockElim.hs
=====================================
@@ -1,5 +1,4 @@
{-# LANGUAGE GADTs, BangPatterns, ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
module GHC.Cmm.CommonBlockElim
( elimCommonBlocks
@@ -27,6 +26,7 @@ import qualified Data.Map as M
import qualified GHC.Data.TrieMap as TM
import GHC.Types.Unique.FM
import GHC.Types.Unique
+import GHC.Utils.Word64 (truncateWord64ToWord32)
import Control.Arrow (first, second)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
@@ -186,7 +186,7 @@ hash_block block =
-- Since we are hashing, we can savely downcast Word64 to Word32 here.
-- Although a different hashing function may be more effective.
hash_unique :: Uniquable a => a -> Word32
- hash_unique = fromIntegral @Word64 @Word32 . getKey . getUnique
+ hash_unique = truncateWord64ToWord32 . getKey . getUnique
-- | Ignore these node types for equality
dont_care :: CmmNode O x -> Bool
=====================================
compiler/GHC/Cmm/Dominators.hs
=====================================
@@ -1,5 +1,4 @@
{-# LANGUAGE GADTs #-}
-{-# LANGUAGE TypeApplications #-}
module GHC.Cmm.Dominators
(
@@ -41,6 +40,7 @@ import GHC.Cmm
import GHC.Utils.Outputable( Outputable(..), text, int, hcat, (<+>))
import GHC.Utils.Misc
import GHC.Utils.Panic
+import GHC.Utils.Word64 (intToWord64)
import qualified GHC.Data.Word64Map as WM
import qualified GHC.Data.Word64Set as WS
@@ -151,7 +151,7 @@ graphWithDominators g = GraphWithDominators (reachable rpblocks g) dmap rpmap
blockIndex = labelIndex . entryLabel
bounds :: (Word64, Word64)
- bounds = (0, fromIntegral @Int @Word64 (length rpblocks - 1))
+ bounds = (0, intToWord64 (length rpblocks - 1))
ltGraph :: [Block node C C] -> LT.Graph
ltGraph [] = WM.empty
=====================================
compiler/GHC/CmmToAsm/CFG/Dominators.hs
=====================================
@@ -445,7 +445,7 @@ writes a xs = forM_ xs (\(i,x) -> (a.=x) i)
fromAdj :: [(Node, [Node])] -> Graph
fromAdj = WM.fromList . fmap (second WS.fromList)
-fromEdges :: [(Node,Node)] -> Graph
+fromEdges :: [Edge] -> Graph
fromEdges = collectW WS.union fst (WS.singleton . snd)
toAdj :: Graph -> [(Node, [Node])]
=====================================
compiler/GHC/StgToJS/Symbols.hs
=====================================
@@ -1,4 +1,3 @@
-{-# LANGUAGE TypeApplications #-}
-- | JS symbol generation
module GHC.StgToJS.Symbols
@@ -16,6 +15,7 @@ import GHC.Prelude
import GHC.Data.FastString
import GHC.Unit.Module
+import GHC.Utils.Word64 (intToWord64)
import Data.ByteString (ByteString)
import Data.Word (Word64)
import qualified Data.ByteString.Char8 as BSC
@@ -26,7 +26,7 @@ import qualified Data.ByteString.Lazy as BSL
--
-- Used for the sub indices.
intBS :: Int -> ByteString
-intBS = word64BS . fromIntegral @Int @Word64
+intBS = word64BS . intToWord64
-- | Hexadecimal representation of a 64-bit word
--
=====================================
compiler/GHC/Types/Unique.hs
=====================================
@@ -19,7 +19,6 @@ Haskell).
{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns, MagicHash #-}
-{-# LANGUAGE TypeApplications #-}
module GHC.Types.Unique (
-- * Main data types
@@ -56,6 +55,7 @@ import GHC.Prelude
import GHC.Data.FastString
import GHC.Utils.Outputable
+import GHC.Utils.Word64 (intToWord64, word64ToInt)
-- just for implementing a fast [0,61) -> Char function
import GHC.Exts (indexCharOffAddr#, Char(..), Int(..))
@@ -145,7 +145,7 @@ uniqueMask = (1 `shiftL` uNIQUE_BITS) - 1
-- This function is used in @`mkSplitUniqSupply`@ so that it can
-- precompute and share the tag part of the uniques it generates.
mkTag :: Char -> Word64
-mkTag c = fromIntegral @Int @Word64 (ord c) `shiftL` uNIQUE_BITS
+mkTag c = intToWord64 (ord c) `shiftL` uNIQUE_BITS
-- pop the Char in the top 8 bits of the Unique(Supply)
@@ -162,16 +162,16 @@ mkUnique c i
bits = i .&. uniqueMask
mkUniqueInt :: Char -> Int -> Unique
-mkUniqueInt c i = mkUnique c (fromIntegral @Int @Word64 i)
+mkUniqueInt c i = mkUnique c (intToWord64 i)
mkUniqueIntGrimily :: Int -> Unique
-mkUniqueIntGrimily = MkUnique . fromIntegral @Int @Word64
+mkUniqueIntGrimily = MkUnique . intToWord64
unpkUnique (MkUnique u)
= let
-- The potentially truncating use of fromIntegral here is safe
-- because the argument is just the tag bits after shifting.
- tag = chr (fromIntegral @Word64 @Int (u `shiftR` uNIQUE_BITS))
+ tag = chr (word64ToInt (u `shiftR` uNIQUE_BITS))
i = u .&. uniqueMask
in
(tag, i)
@@ -332,13 +332,13 @@ Code stolen from Lennart.
w64ToBase62 :: Word64 -> String
w64ToBase62 n_ = go n_ ""
where
- -- The uses of potentially truncating uses fromIntegral here are safe
+ -- The potentially truncating uses of fromIntegral here are safe
-- because the argument is guaranteed to be less than 62 in both cases.
go n cs | n < 62
- = let !c = chooseChar62 (fromIntegral @Word64 @Int n) in c : cs
+ = let !c = chooseChar62 (word64ToInt n) in c : cs
| otherwise
= go q (c : cs) where (!q, r) = quotRem n 62
- !c = chooseChar62 (fromIntegral @Word64 @Int r)
+ !c = chooseChar62 (word64ToInt r)
chooseChar62 :: Int -> Char
{-# INLINE chooseChar62 #-}
=====================================
compiler/GHC/Utils/Word64.hs
=====================================
@@ -0,0 +1,20 @@
+module GHC.Utils.Word64 (
+ intToWord64,
+ word64ToInt,
+ truncateWord64ToWord32,
+ ) where
+
+import GHC.Prelude
+import GHC.Utils.Panic.Plain (assert)
+
+import Data.Word
+import GHC.Stack
+
+intToWord64 :: HasCallStack => Int -> Word64
+intToWord64 x = assert (0 <= x) (fromIntegral x)
+
+word64ToInt :: HasCallStack => Word64 -> Int
+word64ToInt x = assert (x <= fromIntegral (maxBound :: Int)) (fromIntegral x)
+
+truncateWord64ToWord32 :: Word64 -> Word32
+truncateWord64ToWord32 = fromIntegral
\ No newline at end of file
=====================================
compiler/ghc.cabal.in
=====================================
@@ -901,6 +901,7 @@ Library
GHC.Utils.TmpFs
GHC.Utils.Trace
GHC.Utils.Unique
+ GHC.Utils.Word64
GHC.Wasm.ControlFlow
GHC.Wasm.ControlFlow.FromCmm
GHC.CmmToAsm.Wasm
=====================================
testsuite/tests/count-deps/CountDepsAst.stdout
=====================================
@@ -316,6 +316,7 @@ GHC.Utils.Ppr.Colour
GHC.Utils.TmpFs
GHC.Utils.Trace
GHC.Utils.Unique
+GHC.Utils.Word64
Language.Haskell.Syntax
Language.Haskell.Syntax.Basic
Language.Haskell.Syntax.Binds
=====================================
testsuite/tests/count-deps/CountDepsParser.stdout
=====================================
@@ -323,6 +323,7 @@ GHC.Utils.Ppr.Colour
GHC.Utils.TmpFs
GHC.Utils.Trace
GHC.Utils.Unique
+GHC.Utils.Word64
Language.Haskell.Syntax
Language.Haskell.Syntax.Basic
Language.Haskell.Syntax.Binds
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/718d3295febef15dca2f90789d1ff87cc44d35fe
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/718d3295febef15dca2f90789d1ff87cc44d35fe
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/20230628/d33f6557/attachment-0001.html>
More information about the ghc-commits
mailing list