{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
module GHC.Types.Unique (
Unique, Uniquable(..),
uNIQUE_BITS,
hasKey,
pprUniqueAlways,
mkTag,
mkUniqueGrimily,
mkUniqueIntGrimily,
getKey,
mkUnique, unpkUnique,
mkUniqueInt,
eqUnique, ltUnique,
incrUnique, stepUnique,
newTagUnique,
nonDetCmpUnique,
isValidKnownKeyUnique,
mkLocalUnique, minLocalUnique, maxLocalUnique,
) where
#include "Unique.h"
import GHC.Prelude
import GHC.Data.FastString
import GHC.Utils.Outputable
import GHC.Utils.Word64 (intToWord64, word64ToInt)
import GHC.Exts (indexCharOffAddr#, Char(..), Int(..))
import GHC.Word ( Word64 )
import Data.Char ( chr, ord )
import Language.Haskell.Syntax.Module.Name
newtype Unique = MkUnique Word64
{-# INLINE uNIQUE_BITS #-}
uNIQUE_BITS :: Int
uNIQUE_BITS :: Int
uNIQUE_BITS = Int
64 Int -> Int -> Int
forall a. Num a => a -> a -> a
- UNIQUE_TAG_BITS
unpkUnique :: Unique -> (Char, Word64)
mkUniqueGrimily :: Word64 -> Unique
getKey :: Unique -> Word64
incrUnique :: Unique -> Unique
stepUnique :: Unique -> Word64 -> Unique
newTagUnique :: Unique -> Char -> Unique
mkUniqueGrimily :: Word64 -> Unique
mkUniqueGrimily = Word64 -> Unique
MkUnique
{-# INLINE getKey #-}
getKey :: Unique -> Word64
getKey (MkUnique Word64
x) = Word64
x
incrUnique :: Unique -> Unique
incrUnique (MkUnique Word64
i) = Word64 -> Unique
MkUnique (Word64
i Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1)
stepUnique :: Unique -> Word64 -> Unique
stepUnique (MkUnique Word64
i) Word64
n = Word64 -> Unique
MkUnique (Word64
i Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
n)
mkLocalUnique :: Word64 -> Unique
mkLocalUnique :: Word64 -> Unique
mkLocalUnique Word64
i = Char -> Word64 -> Unique
mkUnique Char
'X' Word64
i
minLocalUnique :: Unique
minLocalUnique :: Unique
minLocalUnique = Word64 -> Unique
mkLocalUnique Word64
0
maxLocalUnique :: Unique
maxLocalUnique :: Unique
maxLocalUnique = Word64 -> Unique
mkLocalUnique Word64
uniqueMask
newTagUnique :: Unique -> Char -> Unique
newTagUnique Unique
u Char
c = Char -> Word64 -> Unique
mkUnique Char
c Word64
i where (Char
_,Word64
i) = Unique -> (Char, Word64)
unpkUnique Unique
u
uniqueMask :: Word64
uniqueMask :: Word64
uniqueMask = (Word64
1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
uNIQUE_BITS) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1
mkTag :: Char -> Word64
mkTag :: Char -> Word64
mkTag Char
c = Int -> Word64
HasDebugCallStack => Int -> Word64
intToWord64 (Char -> Int
ord Char
c) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
uNIQUE_BITS
mkUnique :: Char -> Word64 -> Unique
mkUnique :: Char -> Word64 -> Unique
mkUnique Char
c Word64
i
= Word64 -> Unique
MkUnique (Word64
tag Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
bits)
where
tag :: Word64
tag = Char -> Word64
mkTag Char
c
bits :: Word64
bits = Word64
i Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
uniqueMask
mkUniqueInt :: Char -> Int -> Unique
mkUniqueInt :: Char -> Int -> Unique
mkUniqueInt Char
c Int
i = Char -> Word64 -> Unique
mkUnique Char
c (Int -> Word64
HasDebugCallStack => Int -> Word64
intToWord64 Int
i)
mkUniqueIntGrimily :: Int -> Unique
mkUniqueIntGrimily :: Int -> Unique
mkUniqueIntGrimily = Word64 -> Unique
MkUnique (Word64 -> Unique) -> (Int -> Word64) -> Int -> Unique
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word64
HasDebugCallStack => Int -> Word64
intToWord64
unpkUnique :: Unique -> (Char, Word64)
unpkUnique (MkUnique Word64
u)
= let
tag :: Char
tag = Int -> Char
chr (Word64 -> Int
HasDebugCallStack => Word64 -> Int
word64ToInt (Word64
u Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
uNIQUE_BITS))
i :: Word64
i = Word64
u Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
uniqueMask
in
(Char
tag, Word64
i)
isValidKnownKeyUnique :: Unique -> Bool
isValidKnownKeyUnique :: Unique -> Bool
isValidKnownKeyUnique Unique
u =
case Unique -> (Char, Word64)
unpkUnique Unique
u of
(Char
c, Word64
x) -> Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0xff Bool -> Bool -> Bool
&& Word64
x Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= (Word64
1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
22)
class Uniquable a where
getUnique :: a -> Unique
hasKey :: Uniquable a => a -> Unique -> Bool
a
x hasKey :: forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
k = a -> Unique
forall a. Uniquable a => a -> Unique
getUnique a
x Unique -> Unique -> Bool
forall a. Eq a => a -> a -> Bool
== Unique
k
instance Uniquable FastString where
getUnique :: FastString -> Unique
getUnique FastString
fs = Int -> Unique
mkUniqueIntGrimily (FastString -> Int
uniqueOfFS FastString
fs)
instance Uniquable Int where
getUnique :: Int -> Unique
getUnique Int
i = Int -> Unique
mkUniqueIntGrimily Int
i
instance Uniquable Word64 where
getUnique :: Word64 -> Unique
getUnique Word64
i = Word64 -> Unique
mkUniqueGrimily Word64
i
instance Uniquable ModuleName where
getUnique :: ModuleName -> Unique
getUnique (ModuleName FastString
nm) = FastString -> Unique
forall a. Uniquable a => a -> Unique
getUnique FastString
nm
eqUnique :: Unique -> Unique -> Bool
eqUnique :: Unique -> Unique -> Bool
eqUnique (MkUnique Word64
u1) (MkUnique Word64
u2) = Word64
u1 Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
u2
ltUnique :: Unique -> Unique -> Bool
ltUnique :: Unique -> Unique -> Bool
ltUnique (MkUnique Word64
u1) (MkUnique Word64
u2) = Word64
u1 Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
u2
nonDetCmpUnique :: Unique -> Unique -> Ordering
nonDetCmpUnique :: Unique -> Unique -> Ordering
nonDetCmpUnique (MkUnique Word64
u1) (MkUnique Word64
u2)
= if Word64
u1 Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
u2 then Ordering
EQ else if Word64
u1 Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
u2 then Ordering
LT else Ordering
GT
instance Eq Unique where
Unique
a == :: Unique -> Unique -> Bool
== Unique
b = Unique -> Unique -> Bool
eqUnique Unique
a Unique
b
Unique
a /= :: Unique -> Unique -> Bool
/= Unique
b = Bool -> Bool
not (Unique -> Unique -> Bool
eqUnique Unique
a Unique
b)
instance Uniquable Unique where
getUnique :: Unique -> Unique
getUnique Unique
u = Unique
u
showUnique :: Unique -> String
showUnique :: Unique -> String
showUnique Unique
uniq
= case Unique -> (Char, Word64)
unpkUnique Unique
uniq of
(Char
tag, Word64
u) -> Char
tag Char -> String -> String
forall a. a -> [a] -> [a]
: Word64 -> String
w64ToBase62 Word64
u
pprUniqueAlways :: IsLine doc => Unique -> doc
pprUniqueAlways :: forall doc. IsLine doc => Unique -> doc
pprUniqueAlways Unique
u
= String -> doc
forall doc. IsLine doc => String -> doc
text (Unique -> String
showUnique Unique
u)
{-# SPECIALIZE pprUniqueAlways :: Unique -> SDoc #-}
{-# SPECIALIZE pprUniqueAlways :: Unique -> HLine #-}
instance Outputable Unique where
ppr :: Unique -> SDoc
ppr = Unique -> SDoc
forall doc. IsLine doc => Unique -> doc
pprUniqueAlways
instance Show Unique where
show :: Unique -> String
show Unique
uniq = Unique -> String
showUnique Unique
uniq
w64ToBase62 :: Word64 -> String
w64ToBase62 :: Word64 -> String
w64ToBase62 Word64
n_ = Word64 -> String -> String
go Word64
n_ String
""
where
go :: Word64 -> String -> String
go Word64
n String
cs | Word64
n Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
62
= let !c :: Char
c = Int -> Char
chooseChar62 (Word64 -> Int
HasDebugCallStack => Word64 -> Int
word64ToInt Word64
n) in Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String
cs
| Bool
otherwise
= Word64 -> String -> String
go Word64
q (Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String
cs) where (!Word64
q, Word64
r) = Word64 -> Word64 -> (Word64, Word64)
forall a. Integral a => a -> a -> (a, a)
quotRem Word64
n Word64
62
!c :: Char
c = Int -> Char
chooseChar62 (Word64 -> Int
HasDebugCallStack => Word64 -> Int
word64ToInt Word64
r)
chooseChar62 :: Int -> Char
{-# INLINE chooseChar62 #-}
chooseChar62 :: Int -> Char
chooseChar62 (I# Int#
n) = Char# -> Char
C# (Addr# -> Int# -> Char#
indexCharOffAddr# Addr#
chars62 Int#
n)
chars62 :: Addr#
chars62 = Addr#
"0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"#