{-# 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 )
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
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 :: Unique -> SDoc
pprUniqueAlways :: Unique -> SDoc
pprUniqueAlways Unique
u
  = String -> SDoc
text (Unique -> String
showUnique Unique
u)
instance Outputable Unique where
    ppr :: Unique -> SDoc
ppr = Unique -> SDoc
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"#