    {-# LANGUAGE CPP #-}
    {-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples, MultiWayIf #-}
    {-# OPTIONS_GHC -O2 -fno-warn-name-shadowing #-}
    -- We always optimise this, otherwise performance of a non-optimised
    -- compiler is severely affected. This module used to live in the `ghc`
    -- package but has been moved to `ghc-boot` because the definition
    -- of the package database (needed in both ghc and in ghc-pkg) lives in
    -- `ghc-boot` and uses ShortText, which in turn depends on this module.

    -- -----------------------------------------------------------------------------
    --
    -- (c) The University of Glasgow, 1997-2006
    --
    -- Character encodings
    --
    -- -----------------------------------------------------------------------------

    module GHC.Utils.Encoding (
            -- * UTF-8
            module GHC.Utils.Encoding.UTF8,

            -- * Z-encoding
            UserString,
            EncodedString,
            zEncodeString,
            zDecodeString,

            -- * Base62-encoding
            toBase62,
            toBase62Padded
      ) where

    import Prelude

    import Foreign
    import Data.Char
    import qualified Data.Char as Char
    import Numeric

    import GHC.Utils.Encoding.UTF8

    -- -----------------------------------------------------------------------------
    -- Note [Z-Encoding]
    -- ~~~~~~~~~~~~~~~~~

    {-
    This is the main name-encoding and decoding function.  It encodes any
    string into a string that is acceptable as a C name.  This is done
    right before we emit a symbol name into the compiled C or asm code.
    Z-encoding of strings is cached in the FastString interface, so we
    never encode the same string more than once.

    The basic encoding scheme is this.

    * Tuples (,,,) are coded as Z3T

    * Alphabetic characters (upper and lower) and digits
            all translate to themselves;
            except 'Z', which translates to 'ZZ'
            and    'z', which translates to 'zz'
      We need both so that we can preserve the variable/tycon distinction

    * Most other printable characters translate to 'zx' or 'Zx' for some
            alphabetic character x

    * The others translate as 'znnnU' where 'nnn' is the decimal number
            of the character

            Before          After
            --------------------------
            Trak            Trak
            foo_wib         foozuwib
            >               zg
            >1              zg1
            foo#            foozh
            foo##           foozhzh
            foo##1          foozhzh1
            fooZ            fooZZ
            :+              ZCzp
            ()              Z0T     0-tuple
            (,,,,)          Z5T     5-tuple
            (##)            Z0H     unboxed 0-tuple
            (#,,,,#)        Z5H     unboxed 5-tuple
    -}

    type UserString = String        -- As the user typed it
    type EncodedString = String     -- Encoded form

    zEncodeString :: UserString -> EncodedString
    zEncodeString :: UserString -> UserString
    zEncodeString UserString
    cs = case UserString -> Maybe UserString
    maybe_tuple UserString
    cs of
                    Just UserString
    n  -> UserString
    n            -- Tuples go to Z2T etc
                    Maybe UserString
    Nothing -> UserString -> UserString
    go UserString
    cs
              where
                    go :: UserString -> UserString
    go []     = []
                    go (Char
    c:UserString
    cs) = Char -> UserString
    encode_digit_ch Char
    c UserString -> UserString -> UserString
    forall a. [a] -> [a] -> [a]
    ++ UserString -> UserString
    go' UserString
    cs
                    go' :: UserString -> UserString
    go' []     = []
                    go' (Char
    c:UserString
    cs) = Char -> UserString
    encode_ch Char
    c UserString -> UserString -> UserString
    forall a. [a] -> [a] -> [a]
    ++ UserString -> UserString
    go' UserString
    cs

    unencodedChar :: Char -> Bool   -- True for chars that don't need encoding
    unencodedChar :: Char -> Bool
    unencodedChar Char
    'Z' = Bool
    False
    unencodedChar Char
    'z' = Bool
    False
    unencodedChar Char
    c   =  Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Char
    'a' Bool -> Bool -> Bool
    && Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Char
    'z'
                      Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Char
    'A' Bool -> Bool -> Bool
    && Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Char
    'Z'
                      Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Char
    '0' Bool -> Bool -> Bool
    && Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Char
    '9'

    -- If a digit is at the start of a symbol then we need to encode it.
    -- Otherwise package names like 9pH-0.1 give linker errors.
    encode_digit_ch :: Char -> EncodedString
    encode_digit_ch :: Char -> UserString
    encode_digit_ch Char
    c | Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Char
    '0' Bool -> Bool -> Bool
    && Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Char
    '9' = Char -> UserString
    encode_as_unicode_char Char
    c
    encode_digit_ch Char
    c | Bool
    otherwise            = Char -> UserString
    encode_ch Char
    c

    encode_ch :: Char -> EncodedString
    encode_ch :: Char -> UserString
    encode_ch Char
    c | Char -> Bool
    unencodedChar Char
    c = [Char
    c]     -- Common case first

    -- Constructors
    encode_ch Char
    '('  = UserString
    "ZL"   -- Needed for things like (,), and (->)
    encode_ch Char
    ')'  = UserString
    "ZR"   -- For symmetry with (
    encode_ch Char
    '['  = UserString
    "ZM"
    encode_ch Char
    ']'  = UserString
    "ZN"
    encode_ch Char
    ':'  = UserString
    "ZC"
    encode_ch Char
    'Z'  = UserString
    "ZZ"

    -- Variables
    encode_ch Char
    'z'  = UserString
    "zz"
    encode_ch Char
    '&'  = UserString
    "za"
    encode_ch Char
    '|'  = UserString
    "zb"
    encode_ch Char
    '^'  = UserString
    "zc"
    encode_ch Char
    '$'  = UserString
    "zd"
    encode_ch Char
    '='  = UserString
    "ze"
    encode_ch Char
    '>'  = UserString
    "zg"
    encode_ch Char
    '#'  = UserString
    "zh"
    encode_ch Char
    '.'  = UserString
    "zi"
    encode_ch Char
    '<'  = UserString
    "zl"
    encode_ch Char
    '-'  = UserString
    "zm"
    encode_ch Char
    '!'  = UserString
    "zn"
    encode_ch Char
    '+'  = UserString
    "zp"
    encode_ch Char
    '\'' = UserString
    "zq"
    encode_ch Char
    '\\' = UserString
    "zr"
    encode_ch Char
    '/'  = UserString
    "zs"
    encode_ch Char
    '*'  = UserString
    "zt"
    encode_ch Char
    '_'  = UserString
    "zu"
    encode_ch Char
    '%'  = UserString
    "zv"
    encode_ch Char
    c    = Char -> UserString
    encode_as_unicode_char Char
    c

    encode_as_unicode_char :: Char -> EncodedString
    encode_as_unicode_char :: Char -> UserString
    encode_as_unicode_char Char
    c = Char
    'z' Char -> UserString -> UserString
    forall a. a -> [a] -> [a]
    : case UserString
    hex_str of
      Char
    hd : UserString
    _
        | Char -> Bool
    isDigit Char
    hd -> UserString
    hex_str
      UserString
    _ -> Char
    '0' Char -> UserString -> UserString
    forall a. a -> [a] -> [a]
    : UserString
    hex_str
      where hex_str :: UserString
    hex_str = Int -> UserString -> UserString
    forall a. Integral a => a -> UserString -> UserString
    showHex (Char -> Int
    ord Char
    c) UserString
    "U"
      -- ToDo: we could improve the encoding here in various ways.
      -- eg. strings of unicode characters come out as 'z1234Uz5678U', we
      -- could remove the 'U' in the middle (the 'z' works as a separator).

    zDecodeString :: EncodedString -> UserString
    zDecodeString :: UserString -> UserString
    zDecodeString [] = []
    zDecodeString (Char
    'Z' : Char
    d : UserString
    rest)
      | Char -> Bool
    isDigit Char
    d = Char -> UserString -> UserString
    decode_tuple   Char
    d UserString
    rest
      | Bool
    otherwise = Char -> Char
    decode_upper   Char
    d Char -> UserString -> UserString
    forall a. a -> [a] -> [a]
    : UserString -> UserString
    zDecodeString UserString
    rest
    zDecodeString (Char
    'z' : Char
    d : UserString
    rest)
      | Char -> Bool
    isDigit Char
    d = Char -> UserString -> UserString
    decode_num_esc Char
    d UserString
    rest
      | Bool
    otherwise = Char -> Char
    decode_lower   Char
    d Char -> UserString -> UserString
    forall a. a -> [a] -> [a]
    : UserString -> UserString
    zDecodeString UserString
    rest
    zDecodeString (Char
    c   : UserString
    rest) = Char
    c Char -> UserString -> UserString
    forall a. a -> [a] -> [a]
    : UserString -> UserString
    zDecodeString UserString
    rest

    decode_upper, decode_lower :: Char -> Char

    decode_upper :: Char -> Char
    decode_upper Char
    'L' = Char
    '('
    decode_upper Char
    'R' = Char
    ')'
    decode_upper Char
    'M' = Char
    '['
    decode_upper Char
    'N' = Char
    ']'
    decode_upper Char
    'C' = Char
    ':'
    decode_upper Char
    'Z' = Char
    'Z'
    decode_upper Char
    ch  = {-pprTrace "decode_upper" (char ch)-} Char
    ch

    decode_lower :: Char -> Char
    decode_lower Char
    'z' = Char
    'z'
    decode_lower Char
    'a' = Char
    '&'
    decode_lower Char
    'b' = Char
    '|'
    decode_lower Char
    'c' = Char
    '^'
    decode_lower Char
    'd' = Char
    '$'
    decode_lower Char
    'e' = Char
    '='
    decode_lower Char
    'g' = Char
    '>'
    decode_lower Char
    'h' = Char
    '#'
    decode_lower Char
    'i' = Char
    '.'
    decode_lower Char
    'l' = Char
    '<'
    decode_lower Char
    'm' = Char
    '-'
    decode_lower Char
    'n' = Char
    '!'
    decode_lower Char
    'p' = Char
    '+'
    decode_lower Char
    'q' = Char
    '\''
    decode_lower Char
    'r' = Char
    '\\'
    decode_lower Char
    's' = Char
    '/'
    decode_lower Char
    't' = Char
    '*'
    decode_lower Char
    'u' = Char
    '_'
    decode_lower Char
    'v' = Char
    '%'
    decode_lower Char
    ch  = {-pprTrace "decode_lower" (char ch)-} Char
    ch

    -- Characters not having a specific code are coded as z224U (in hex)
    decode_num_esc :: Char -> EncodedString -> UserString
    decode_num_esc :: Char -> UserString -> UserString
    decode_num_esc Char
    d UserString
    rest
      = Int -> UserString -> UserString
    go (Char -> Int
    digitToInt Char
    d) UserString
    rest
      where
        go :: Int -> UserString -> UserString
    go Int
    n (Char
    c : UserString
    rest) | Char -> Bool
    isHexDigit Char
    c = Int -> UserString -> UserString
    go (Int
    16Int -> Int -> Int
    forall a. Num a => a -> a -> a
    *Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Char -> Int
    digitToInt Char
    c) UserString
    rest
        go Int
    n (Char
    'U' : UserString
    rest)           = Int -> Char
    chr Int
    n Char -> UserString -> UserString
    forall a. a -> [a] -> [a]
    : UserString -> UserString
    zDecodeString UserString
    rest
        go Int
    n UserString
    other = UserString -> UserString
    forall a. HasCallStack => UserString -> a
    error (UserString
    "decode_num_esc: " UserString -> UserString -> UserString
    forall a. [a] -> [a] -> [a]
    ++ Int -> UserString
    forall a. Show a => a -> UserString
    show Int
    n UserString -> UserString -> UserString
    forall a. [a] -> [a] -> [a]
    ++  Char
    ' 'Char -> UserString -> UserString
    forall a. a -> [a] -> [a]
    :UserString
    other)

    decode_tuple :: Char -> EncodedString -> UserString
    decode_tuple :: Char -> UserString -> UserString
    decode_tuple Char
    d UserString
    rest
      = Int -> UserString -> UserString
    go (Char -> Int
    digitToInt Char
    d) UserString
    rest
      where
            -- NB. recurse back to zDecodeString after decoding the tuple, because
            -- the tuple might be embedded in a longer name.
        go :: Int -> UserString -> UserString
    go Int
    n (Char
    c : UserString
    rest) | Char -> Bool
    isDigit Char
    c = Int -> UserString -> UserString
    go (Int
    10Int -> Int -> Int
    forall a. Num a => a -> a -> a
    *Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Char -> Int
    digitToInt Char
    c) UserString
    rest
        go Int
    0 (Char
    'T':UserString
    rest)     = UserString
    "()" UserString -> UserString -> UserString
    forall a. [a] -> [a] -> [a]
    ++ UserString -> UserString
    zDecodeString UserString
    rest
        go Int
    n (Char
    'T':UserString
    rest)     = Char
    '(' Char -> UserString -> UserString
    forall a. a -> [a] -> [a]
    : Int -> Char -> UserString
    forall a. Int -> a -> [a]
    replicate (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) Char
    ',' UserString -> UserString -> UserString
    forall a. [a] -> [a] -> [a]
    ++ UserString
    ")" UserString -> UserString -> UserString
    forall a. [a] -> [a] -> [a]
    ++ UserString -> UserString
    zDecodeString UserString
    rest
        go Int
    n (Char
    'H':UserString
    rest)     = Char
    '(' Char -> UserString -> UserString
    forall a. a -> [a] -> [a]
    : Char
    '#' Char -> UserString -> UserString
    forall a. a -> [a] -> [a]
    : Int -> Char -> UserString
    forall a. Int -> a -> [a]
    replicate (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) Char
    ',' UserString -> UserString -> UserString
    forall a. [a] -> [a] -> [a]
    ++ UserString
    "#)" UserString -> UserString -> UserString
    forall a. [a] -> [a] -> [a]
    ++ UserString -> UserString
    zDecodeString UserString
    rest
        go Int
    n UserString
    other = UserString -> UserString
    forall a. HasCallStack => UserString -> a
    error (UserString
    "decode_tuple: " UserString -> UserString -> UserString
    forall a. [a] -> [a] -> [a]
    ++ Int -> UserString
    forall a. Show a => a -> UserString
    show Int
    n UserString -> UserString -> UserString
    forall a. [a] -> [a] -> [a]
    ++ Char
    ' 'Char -> UserString -> UserString
    forall a. a -> [a] -> [a]
    :UserString
    other)

    {-
    Tuples are encoded as
            Z3T or Z3H
    for 3-tuples or unboxed 3-tuples respectively.  No other encoding starts
            Z<digit>

    * "(##)" is the tycon for an unboxed 0-tuple

    * "()" is the tycon for a boxed 0-tuple
    -}

    maybe_tuple :: UserString -> Maybe EncodedString

    maybe_tuple :: UserString -> Maybe UserString
    maybe_tuple UserString
    "(##)" = UserString -> Maybe UserString
    forall a. a -> Maybe a
    Just(UserString
    "Z0H")
    maybe_tuple (Char
    '(' : Char
    '#' : UserString
    cs) = case Int -> UserString -> (Int, UserString)
    count_commas (Int
    0::Int) UserString
    cs of
                                     (Int
    n, Char
    '#' : Char
    ')' : UserString
    _) -> UserString -> Maybe UserString
    forall a. a -> Maybe a
    Just (Char
    'Z' Char -> UserString -> UserString
    forall a. a -> [a] -> [a]
    : Int -> UserString -> UserString
    forall a. Show a => a -> UserString -> UserString
    shows (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) UserString
    "H")
                                     (Int, UserString)
    _                  -> Maybe UserString
    forall a. Maybe a
    Nothing
    maybe_tuple UserString
    "()" = UserString -> Maybe UserString
    forall a. a -> Maybe a
    Just(UserString
    "Z0T")
    maybe_tuple (Char
    '(' : UserString
    cs)       = case Int -> UserString -> (Int, UserString)
    count_commas (Int
    0::Int) UserString
    cs of
                                     (Int
    n, Char
    ')' : UserString
    _) -> UserString -> Maybe UserString
    forall a. a -> Maybe a
    Just (Char
    'Z' Char -> UserString -> UserString
    forall a. a -> [a] -> [a]
    : Int -> UserString -> UserString
    forall a. Show a => a -> UserString -> UserString
    shows (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) UserString
    "T")
                                     (Int, UserString)
    _            -> Maybe UserString
    forall a. Maybe a
    Nothing
    maybe_tuple UserString
    _                = Maybe UserString
    forall a. Maybe a
    Nothing

    count_commas :: Int -> String -> (Int, String)
    count_commas :: Int -> UserString -> (Int, UserString)
    count_commas Int
    n (Char
    ',' : UserString
    cs) = Int -> UserString -> (Int, UserString)
    count_commas (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) UserString
    cs
    count_commas Int
    n UserString
    cs         = (Int
    n,UserString
    cs)

    {-
    ************************************************************************
    *                                                                      *
                            Base 62
    *                                                                      *
    ************************************************************************

    Note [Base 62 encoding 128-bit integers]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Instead of base-62 encoding a single 128-bit integer
    (ceil(21.49) characters), we'll base-62 a pair of 64-bit integers
    (2 * ceil(10.75) characters).  Luckily for us, it's the same number of
    characters!
    -}

    --------------------------------------------------------------------------
    -- Base 62

    -- The base-62 code is based off of 'locators'
    -- ((c) Operational Dynamics Consulting, BSD3 licensed)

    -- | Size of a 64-bit word when written as a base-62 string
    word64Base62Len :: Int
    word64Base62Len :: Int
    word64Base62Len = Int
    11

    -- | Converts a 64-bit word into a base-62 string
    toBase62Padded :: Word64 -> String
    toBase62Padded :: Word64 -> UserString
    toBase62Padded Word64
    w = UserString
    pad UserString -> UserString -> UserString
    forall a. [a] -> [a] -> [a]
    ++ UserString
    str
      where
        pad :: UserString
    pad = Int -> Char -> UserString
    forall a. Int -> a -> [a]
    replicate Int
    len Char
    '0'
        len :: Int
    len = Int
    word64Base62Len Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - UserString -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length UserString
    str -- 11 == ceil(64 / lg 62)
        str :: UserString
    str = Word64 -> UserString
    toBase62 Word64
    w

    toBase62 :: Word64 -> String
    toBase62 :: Word64 -> UserString
    toBase62 Word64
    w = Word64 -> (Int -> Char) -> Word64 -> UserString -> UserString
    forall a.
    Integral a =>
    a -> (Int -> Char) -> a -> UserString -> UserString
    showIntAtBase Word64
    62 Int -> Char
    represent Word64
    w UserString
    ""
      where
        represent :: Int -> Char
        represent :: Int -> Char
    represent Int
    x
            | Int
    x Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    10 = Int -> Char
    Char.chr (Int
    48 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    x)
            | Int
    x Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    36 = Int -> Char
    Char.chr (Int
    65 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    x Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    10)
            | Int
    x Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    62 = Int -> Char
    Char.chr (Int
    97 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    x Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    36)
            | Bool
    otherwise = UserString -> Char
    forall a. HasCallStack => UserString -> a
    error UserString
    "represent (base 62): impossible!"