[Git][ghc/ghc][wip/T22010] Refactor mkUnique

Jaro Reinders (@Noughtmare) gitlab at gitlab.haskell.org
Wed Jun 14 12:49:59 UTC 2023



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


Commits:
f0c7bfd1 by Jaro Reinders at 2023-06-14T14:49:51+02:00
Refactor mkUnique

- - - - -


3 changed files:

- compiler/GHC/Builtin/Uniques.hs
- compiler/GHC/Types/Unique.hs
- compiler/GHC/Types/Unique/Supply.hs


Changes:

=====================================
compiler/GHC/Builtin/Uniques.hs
=====================================
@@ -117,14 +117,14 @@ mkSumTyConUnique arity =
     assertPpr (arity <= 0x3f) (ppr arity) $
               -- 0x3f since we only have 6 bits to encode the
               -- alternative
-    mkUnique 'z' (arity `shiftL` 8 .|. 0xfc)
+    mkUniqueInt 'z' (arity `shiftL` 8 .|. 0xfc)
 
 mkSumDataConUnique :: ConTagZ -> Arity -> Unique
 mkSumDataConUnique alt arity
   | alt >= arity
   = panic ("mkSumDataConUnique: " ++ show alt ++ " >= " ++ show arity)
   | otherwise
-  = mkUnique 'z' (arity `shiftL` 8 + alt `shiftL` 2) {- skip the tycon -}
+  = mkUniqueInt 'z' (arity `shiftL` 8 + alt `shiftL` 2) {- skip the tycon -}
 
 getUnboxedSumName :: Int -> Name
 getUnboxedSumName n
@@ -211,17 +211,17 @@ selector Uniques takes inspiration from the encoding for unboxed sum Uniques.
 -}
 
 mkCTupleTyConUnique :: Arity -> Unique
-mkCTupleTyConUnique a = mkUnique 'k' (2*a)
+mkCTupleTyConUnique a = mkUniqueInt 'k' (2*a)
 
 mkCTupleDataConUnique :: Arity -> Unique
-mkCTupleDataConUnique a = mkUnique 'm' (3*a)
+mkCTupleDataConUnique a = mkUniqueInt 'm' (3*a)
 
 mkCTupleSelIdUnique :: ConTagZ -> Arity -> Unique
 mkCTupleSelIdUnique sc_pos arity
   | sc_pos >= arity
   = panic ("mkCTupleSelIdUnique: " ++ show sc_pos ++ " >= " ++ show arity)
   | otherwise
-  = mkUnique 'j' (arity `shiftL` cTupleSelIdArityBits + sc_pos)
+  = mkUniqueInt 'j' (arity `shiftL` cTupleSelIdArityBits + sc_pos)
 
 getCTupleTyConName :: Int -> Name
 getCTupleTyConName n =
@@ -264,12 +264,12 @@ cTupleSelIdPosBitmask = 0xff
 -- Normal tuples
 
 mkTupleDataConUnique :: Boxity -> Arity -> Unique
-mkTupleDataConUnique Boxed          a = mkUnique '7' (3*a)    -- may be used in C labels
-mkTupleDataConUnique Unboxed        a = mkUnique '8' (3*a)
+mkTupleDataConUnique Boxed          a = mkUniqueInt '7' (3*a)    -- may be used in C labels
+mkTupleDataConUnique Unboxed        a = mkUniqueInt '8' (3*a)
 
 mkTupleTyConUnique :: Boxity -> Arity -> Unique
-mkTupleTyConUnique Boxed           a  = mkUnique '4' (2*a)
-mkTupleTyConUnique Unboxed         a  = mkUnique '5' (2*a)
+mkTupleTyConUnique Boxed           a  = mkUniqueInt '4' (2*a)
+mkTupleTyConUnique Unboxed         a  = mkUniqueInt '5' (2*a)
 
 -- | This function is an inverse of `mkTupleTyConUnique`
 isTupleTyConUnique :: Unique -> Maybe (Boxity, Arity)
@@ -361,27 +361,27 @@ mkPrimOpIdUnique       :: Int -> Unique
 mkPrimOpWrapperUnique  :: Int -> Unique
 mkPreludeMiscIdUnique  :: Int -> Unique
 
-mkAlphaTyVarUnique   i = mkUnique '1' i
-mkPreludeClassUnique i = mkUnique '2' i
+mkAlphaTyVarUnique   i = mkUniqueInt '1' i
+mkPreludeClassUnique i = mkUniqueInt '2' i
 
 --------------------------------------------------
-mkPrimOpIdUnique op         = mkUnique '9' (2*op)
-mkPrimOpWrapperUnique op    = mkUnique '9' (2*op+1)
-mkPreludeMiscIdUnique  i    = mkUnique '0' i
+mkPrimOpIdUnique op         = mkUniqueInt '9' (2*op)
+mkPrimOpWrapperUnique op    = mkUniqueInt '9' (2*op+1)
+mkPreludeMiscIdUnique  i    = mkUniqueInt '0' i
 
 mkPseudoUniqueE, mkBuiltinUnique :: Int -> Unique
 
-mkBuiltinUnique i = mkUnique 'B' i
-mkPseudoUniqueE i = mkUnique 'E' i -- used in NCG spiller to create spill VirtualRegs
+mkBuiltinUnique i = mkUniqueInt 'B' i
+mkPseudoUniqueE i = mkUniqueInt 'E' i -- used in NCG spiller to create spill VirtualRegs
 
 mkRegSingleUnique, mkRegPairUnique, mkRegSubUnique, mkRegClassUnique :: Int -> Unique
-mkRegSingleUnique = mkUnique 'R'
-mkRegSubUnique    = mkUnique 'S'
-mkRegPairUnique   = mkUnique 'P'
-mkRegClassUnique  = mkUnique 'L'
+mkRegSingleUnique = mkUniqueInt 'R'
+mkRegSubUnique    = mkUniqueInt 'S'
+mkRegPairUnique   = mkUniqueInt 'P'
+mkRegClassUnique  = mkUniqueInt 'L'
 
 mkCostCentreUnique :: Int -> Unique
-mkCostCentreUnique = mkUnique 'C'
+mkCostCentreUnique = mkUniqueInt 'C'
 
 varNSUnique, dataNSUnique, tvNSUnique, tcNSUnique :: Unique
 varNSUnique    = mkUnique 'i' 0
@@ -390,7 +390,7 @@ tvNSUnique     = mkUnique 'v' 0
 tcNSUnique     = mkUnique 'c' 0
 
 mkFldNSUnique :: FastString -> Unique
-mkFldNSUnique fs = mkUnique 'f' (uniqueOfFS fs)
+mkFldNSUnique fs = mkUniqueInt 'f' (uniqueOfFS fs)
 
 isFldNSUnique :: Unique -> Bool
 isFldNSUnique uniq = case unpkUnique uniq of
@@ -404,7 +404,7 @@ initExitJoinUnique = mkUnique 's' 0
 -- See Note [Related uniques for wired-in things]
 
 mkPreludeTyConUnique   :: Int -> Unique
-mkPreludeTyConUnique i = mkUnique '3' (2*i)
+mkPreludeTyConUnique i = mkUniqueInt '3' (2*i)
 
 tyConRepNameUnique :: Unique -> Unique
 tyConRepNameUnique  u = incrUnique u
@@ -414,7 +414,7 @@ tyConRepNameUnique  u = incrUnique u
 -- See Note [Related uniques for wired-in things]
 
 mkPreludeDataConUnique :: Int -> Unique
-mkPreludeDataConUnique i = mkUnique '6' (3*i)    -- Must be alphabetic
+mkPreludeDataConUnique i = mkUniqueInt '6' (3*i)    -- Must be alphabetic
 
 dataConTyRepNameUnique, dataConWorkerUnique :: Unique -> Unique
 dataConWorkerUnique  u = incrUnique u
@@ -440,7 +440,7 @@ dataConTyRepNameUnique u = stepUnique u 2
 -- A little delicate!
 
 mkBoxingTyConUnique :: Int -> Unique
-mkBoxingTyConUnique i = mkUnique 'b' (5*i)
+mkBoxingTyConUnique i = mkUniqueInt 'b' (5*i)
 
 boxingDataConUnique :: Unique -> Unique
 boxingDataConUnique u = stepUnique u 2


=====================================
compiler/GHC/Types/Unique.hs
=====================================
@@ -32,7 +32,8 @@ module GHC.Types.Unique (
 
         mkUniqueGrimily,
         getKey,
-        mkUnique, mkUnique64, unpkUnique,
+        mkUnique, unpkUnique,
+        mkUniqueInt,
         eqUnique, ltUnique,
         incrUnique, stepUnique,
 
@@ -121,7 +122,7 @@ incrUnique (MkUnique i) = MkUnique (i + 1)
 stepUnique (MkUnique i) n = MkUnique (i + n)
 
 mkLocalUnique :: Word64 -> Unique
-mkLocalUnique i = mkUnique64 'X' i
+mkLocalUnique i = mkUnique 'X' i
 
 minLocalUnique :: Unique
 minLocalUnique = mkLocalUnique 0
@@ -130,7 +131,7 @@ maxLocalUnique :: Unique
 maxLocalUnique = mkLocalUnique uniqueMask
 
 -- newTagUnique changes the "domain" of a unique to a different char
-newTagUnique u c = mkUnique64 c i where (_,i) = unpkUnique u
+newTagUnique u c = mkUnique c i where (_,i) = unpkUnique u
 
 -- | How many bits are devoted to the unique index (as opposed to the class
 -- character).
@@ -143,7 +144,7 @@ uniqueMask = (1 `shiftL` uNIQUE_BITS) - 1
 
 -- and as long as the Char fits in 8 bits, which we assume anyway!
 
-mkUnique :: Char -> Int -> Unique       -- Builds a unique from pieces
+mkUnique :: Char -> Word64 -> Unique       -- Builds a unique from pieces
 -- EXPORTED and used only in GHC.Builtin.Uniques
 mkUnique c i
   = MkUnique (tag .|. bits)
@@ -151,12 +152,8 @@ mkUnique c i
     tag  = fromIntegral (ord c) `shiftL` uNIQUE_BITS
     bits = fromIntegral i .&. uniqueMask
 
-mkUnique64 :: Char -> Word64 -> Unique
-mkUnique64 c i
-  = MkUnique (tag .|. bits)
-  where
-    tag  = fromIntegral (ord c) `shiftL` uNIQUE_BITS
-    bits = i .&. uniqueMask
+mkUniqueInt :: Char -> Int -> Unique
+mkUniqueInt c i = mkUnique c (fromIntegral i)
 
 unpkUnique (MkUnique u)
   = let


=====================================
compiler/GHC/Types/Unique/Supply.hs
=====================================
@@ -265,7 +265,7 @@ initUniqSupply counter inc = do
 uniqFromMask :: Char -> IO Unique
 uniqFromMask !mask
   = do { uqNum <- genSym
-       ; return $! mkUnique64 mask uqNum }
+       ; return $! mkUnique mask uqNum }
 {-# NOINLINE uniqFromMask #-} -- We'll unbox everything, but we don't want to inline it
 
 splitUniqSupply :: UniqSupply -> (UniqSupply, UniqSupply)



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f0c7bfd16f5d98c69c0ae9628260557671147e46
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/20230614/5226710a/attachment-0001.html>


More information about the ghc-commits mailing list