Hi.hs

{-# LANGUAGE MagicHash#-}

module Hi where

import GHC.Exts
import Data.Bits
import Data.Char

newtype Unique = MkUnique Int

{-# INLINE uNIQUE_BITS #-}
uNIQUE_BITS :: Int
uNIQUE_BITS = finiteBitSize (0 :: Int) - 8

uniqueMask :: Int
uniqueMask = (1 `shiftL` uNIQUE_BITS) - 1

unpkUnique      :: Unique -> (Char, Int)        -- The reverse
unpkUnique (MkUnique u)
  = let
        -- as long as the Char may have its eighth bit set, we
        -- really do need the logical right-shift here!
        tag = chr (u `shiftR` uNIQUE_BITS)
        i   = u .&. uniqueMask
    in
    (tag, i)

showUnique :: Unique -> String
showUnique uniq
  = case unpkUnique uniq of
      (tag, u) -> finish_show tag u (iToBase62 u)

finish_show :: Char -> Int -> String -> String
finish_show 't' u _pp_u | u < 26
  = -- Special case to make v common tyvars, t1, t2, ...
    -- come out as a, b, ... (shorter, easier to read)
    [chr (ord 'a' + u)]
finish_show tag _ pp_u = tag : pp_u

iToBase62 :: Int -> String
iToBase62 n_
  = go n_ ""
  where
    go n cs | n < 62
            = let !c = chooseChar62 n in c : cs
            | otherwise
            = go q (c : cs) where (q, r) = quotRem n 62
                                  !c = chooseChar62 r

    chooseChar62 :: Int -> Char
    {-# INLINE chooseChar62 #-}
    chooseChar62 (I# n) = C# (indexCharOffAddr# chars62 n)
    chars62 = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"#