{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns, MagicHash #-}
module GHC.Types.Unique (
Unique, Uniquable(..),
uNIQUE_BITS,
hasKey,
pprUniqueAlways,
mkUniqueGrimily,
getKey,
mkUnique, unpkUnique,
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.Panic.Plain
import GHC.Exts (indexCharOffAddr#, Char(..), Int(..))
import Data.Char ( chr, ord )
import Language.Haskell.Syntax.Module.Name
newtype Unique = MkUnique Int
{-# INLINE uNIQUE_BITS #-}
uNIQUE_BITS :: Int
uNIQUE_BITS :: Int
uNIQUE_BITS = Int -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (Int
0 :: Int) Int -> Int -> Int
forall a. Num a => a -> a -> a
- UNIQUE_TAG_BITS
unpkUnique :: Unique -> (Char, Int)
mkUniqueGrimily :: Int -> Unique
getKey :: Unique -> Int
incrUnique :: Unique -> Unique
stepUnique :: Unique -> Int -> Unique
newTagUnique :: Unique -> Char -> Unique
mkUniqueGrimily :: Int -> Unique
mkUniqueGrimily = Int -> Unique
MkUnique
{-# INLINE getKey #-}
getKey :: Unique -> Int
getKey (MkUnique Int
x) = Int
x
incrUnique :: Unique -> Unique
incrUnique (MkUnique Int
i) = Int -> Unique
MkUnique (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
stepUnique :: Unique -> Int -> Unique
stepUnique (MkUnique Int
i) Int
n = Int -> Unique
MkUnique (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)
mkLocalUnique :: Int -> Unique
mkLocalUnique :: Int -> Unique
mkLocalUnique Int
i = Char -> Int -> Unique
mkUnique Char
'X' Int
i
minLocalUnique :: Unique
minLocalUnique :: Unique
minLocalUnique = Int -> Unique
mkLocalUnique Int
0
maxLocalUnique :: Unique
maxLocalUnique :: Unique
maxLocalUnique = Int -> Unique
mkLocalUnique Int
uniqueMask
newTagUnique :: Unique -> Char -> Unique
newTagUnique Unique
u Char
c = Char -> Int -> Unique
mkUnique Char
c Int
i where (Char
_,Int
i) = Unique -> (Char, Int)
unpkUnique Unique
u
uniqueMask :: Int
uniqueMask :: Int
uniqueMask = (Int
1 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
uNIQUE_BITS) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
mkUnique :: Char -> Int -> Unique
mkUnique :: Char -> Int -> Unique
mkUnique Char
c Int
i
= Int -> Unique
MkUnique (Int
tag Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
bits)
where
tag :: Int
tag = Char -> Int
ord Char
c Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
uNIQUE_BITS
bits :: Int
bits = Int
i Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
uniqueMask
unpkUnique :: Unique -> (Char, Int)
unpkUnique (MkUnique Int
u)
= let
tag :: Char
tag = Int -> Char
chr (Int
u Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
uNIQUE_BITS)
i :: Int
i = Int
u Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
uniqueMask
in
(Char
tag, Int
i)
isValidKnownKeyUnique :: Unique -> Bool
isValidKnownKeyUnique :: Unique -> Bool
isValidKnownKeyUnique Unique
u =
case Unique -> (Char, Int)
unpkUnique Unique
u of
(Char
c, Int
x) -> Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0xff Bool -> Bool -> Bool
&& Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= (Int
1 Int -> Int -> Int
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
mkUniqueGrimily (FastString -> Int
uniqueOfFS FastString
fs)
instance Uniquable Int where
getUnique :: Int -> Unique
getUnique Int
i = Int -> Unique
mkUniqueGrimily Int
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 Int
u1) (MkUnique Int
u2) = Int
u1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
u2
ltUnique :: Unique -> Unique -> Bool
ltUnique :: Unique -> Unique -> Bool
ltUnique (MkUnique Int
u1) (MkUnique Int
u2) = Int
u1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
u2
nonDetCmpUnique :: Unique -> Unique -> Ordering
nonDetCmpUnique :: Unique -> Unique -> Ordering
nonDetCmpUnique (MkUnique Int
u1) (MkUnique Int
u2)
= if Int
u1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
u2 then Ordering
EQ else if Int
u1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
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, Int)
unpkUnique Unique
uniq of
(Char
tag, Int
u) -> Char
tag Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String
iToBase62 Int
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
iToBase62 :: Int -> String
iToBase62 :: Int -> String
iToBase62 Int
n_
= Bool -> String -> String
forall a. HasCallStack => Bool -> a -> a
assert (Int
n_ Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
go Int
n_ String
""
where
go :: Int -> String -> String
go Int
n String
cs | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
62
= let !c :: Char
c = Int -> Char
chooseChar62 Int
n in Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String
cs
| Bool
otherwise
= Int -> String -> String
go Int
q (Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String
cs) where (!Int
q, Int
r) = Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
quotRem Int
n Int
62
!c :: Char
c = Int -> Char
chooseChar62 Int
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"#