{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}

-- This is a non-exposed internal module
--
-- The code in this module has been ripped from containers-0.5.5.1:Data.Map.Base [1] almost
-- verbatimely to avoid a dependency of 'template-haskell' on the containers package.
--
-- [1] see https://hackage.haskell.org/package/containers-0.5.5.1
--
-- The original code is BSD-licensed and copyrighted by Daan Leijen, Andriy Palamarchuk, et al.

module Language.Haskell.TH.Lib.Map
    ( Map
    , empty
    , insert
    , Language.Haskell.TH.Lib.Map.lookup
    ) where

import Prelude

data Map k a  = Bin {-# UNPACK #-} !Size !k a !(Map k a) !(Map k a)
              | Tip

type Size     = Int

empty :: Map k a
empty :: forall k a. Map k a
empty = forall k a. Map k a
Tip
{-# INLINE empty #-}

singleton :: k -> a -> Map k a
singleton :: forall k a. k -> a -> Map k a
singleton k
k a
x = forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
1 k
k a
x forall k a. Map k a
Tip forall k a. Map k a
Tip
{-# INLINE singleton #-}

size :: Map k a -> Int
size :: forall k a. Map k a -> Size
size Map k a
Tip              = Size
0
size (Bin Size
sz k
_ a
_ Map k a
_ Map k a
_) = Size
sz
{-# INLINE size #-}

lookup :: Ord k => k -> Map k a -> Maybe a
lookup :: forall k a. Ord k => k -> Map k a -> Maybe a
lookup = forall k a. Ord k => k -> Map k a -> Maybe a
go
  where
    go :: t -> Map t a -> Maybe a
go t
_ Map t a
Tip = forall a. Maybe a
Nothing
    go !t
k (Bin Size
_ t
kx a
x Map t a
l Map t a
r) = case forall a. Ord a => a -> a -> Ordering
compare t
k t
kx of
      Ordering
LT -> t -> Map t a -> Maybe a
go t
k Map t a
l
      Ordering
GT -> t -> Map t a -> Maybe a
go t
k Map t a
r
      Ordering
EQ -> forall a. a -> Maybe a
Just a
x
{-# INLINABLE lookup #-}


insert :: Ord k => k -> a -> Map k a -> Map k a
insert :: forall k a. Ord k => k -> a -> Map k a -> Map k a
insert = forall k a. Ord k => k -> a -> Map k a -> Map k a
go
  where
    go :: Ord k => k -> a -> Map k a -> Map k a
    go :: forall k a. Ord k => k -> a -> Map k a -> Map k a
go !k
kx a
x Map k a
Tip = forall k a. k -> a -> Map k a
singleton k
kx a
x
    go !k
kx a
x (Bin Size
sz k
ky a
y Map k a
l Map k a
r) =
        case forall a. Ord a => a -> a -> Ordering
compare k
kx k
ky of
            Ordering
LT -> forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
ky a
y (forall k a. Ord k => k -> a -> Map k a -> Map k a
go k
kx a
x Map k a
l) Map k a
r
            Ordering
GT -> forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
ky a
y Map k a
l (forall k a. Ord k => k -> a -> Map k a -> Map k a
go k
kx a
x Map k a
r)
            Ordering
EQ -> forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
sz k
kx a
x Map k a
l Map k a
r
{-# INLINABLE insert #-}

balanceL :: k -> a -> Map k a -> Map k a -> Map k a
balanceL :: forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceL k
k a
x Map k a
l Map k a
r = case Map k a
r of
  Map k a
Tip -> case Map k a
l of
           Map k a
Tip -> forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
1 k
k a
x forall k a. Map k a
Tip forall k a. Map k a
Tip
           (Bin Size
_ k
_ a
_ Map k a
Tip Map k a
Tip) -> forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
2 k
k a
x Map k a
l forall k a. Map k a
Tip
           (Bin Size
_ k
lk a
lx Map k a
Tip (Bin Size
_ k
lrk a
lrx Map k a
_ Map k a
_)) -> forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
3 k
lrk a
lrx (forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
1 k
lk a
lx forall k a. Map k a
Tip forall k a. Map k a
Tip) (forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
1 k
k a
x forall k a. Map k a
Tip forall k a. Map k a
Tip)
           (Bin Size
_ k
lk a
lx ll :: Map k a
ll@(Bin Size
_ k
_ a
_ Map k a
_ Map k a
_) Map k a
Tip) -> forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
3 k
lk a
lx Map k a
ll (forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
1 k
k a
x forall k a. Map k a
Tip forall k a. Map k a
Tip)
           (Bin Size
ls k
lk a
lx ll :: Map k a
ll@(Bin Size
lls k
_ a
_ Map k a
_ Map k a
_) lr :: Map k a
lr@(Bin Size
lrs k
lrk a
lrx Map k a
lrl Map k a
lrr))
             | Size
lrs forall a. Ord a => a -> a -> Bool
< Size
ratioforall a. Num a => a -> a -> a
*Size
lls -> forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Size
1forall a. Num a => a -> a -> a
+Size
ls) k
lk a
lx Map k a
ll (forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Size
1forall a. Num a => a -> a -> a
+Size
lrs) k
k a
x Map k a
lr forall k a. Map k a
Tip)
             | Bool
otherwise -> forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Size
1forall a. Num a => a -> a -> a
+Size
ls) k
lrk a
lrx (forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Size
1forall a. Num a => a -> a -> a
+Size
llsforall a. Num a => a -> a -> a
+forall k a. Map k a -> Size
size Map k a
lrl) k
lk a
lx Map k a
ll Map k a
lrl) (forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Size
1forall a. Num a => a -> a -> a
+forall k a. Map k a -> Size
size Map k a
lrr) k
k a
x Map k a
lrr forall k a. Map k a
Tip)

  (Bin Size
rs k
_ a
_ Map k a
_ Map k a
_) -> case Map k a
l of
           Map k a
Tip -> forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Size
1forall a. Num a => a -> a -> a
+Size
rs) k
k a
x forall k a. Map k a
Tip Map k a
r

           (Bin Size
ls k
lk a
lx Map k a
ll Map k a
lr)
              | Size
ls forall a. Ord a => a -> a -> Bool
> Size
deltaforall a. Num a => a -> a -> a
*Size
rs  -> case (Map k a
ll, Map k a
lr) of
                   (Bin Size
lls k
_ a
_ Map k a
_ Map k a
_, Bin Size
lrs k
lrk a
lrx Map k a
lrl Map k a
lrr)
                     | Size
lrs forall a. Ord a => a -> a -> Bool
< Size
ratioforall a. Num a => a -> a -> a
*Size
lls -> forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Size
1forall a. Num a => a -> a -> a
+Size
lsforall a. Num a => a -> a -> a
+Size
rs) k
lk a
lx Map k a
ll (forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Size
1forall a. Num a => a -> a -> a
+Size
rsforall a. Num a => a -> a -> a
+Size
lrs) k
k a
x Map k a
lr Map k a
r)
                     | Bool
otherwise -> forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Size
1forall a. Num a => a -> a -> a
+Size
lsforall a. Num a => a -> a -> a
+Size
rs) k
lrk a
lrx (forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Size
1forall a. Num a => a -> a -> a
+Size
llsforall a. Num a => a -> a -> a
+forall k a. Map k a -> Size
size Map k a
lrl) k
lk a
lx Map k a
ll Map k a
lrl) (forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Size
1forall a. Num a => a -> a -> a
+Size
rsforall a. Num a => a -> a -> a
+forall k a. Map k a -> Size
size Map k a
lrr) k
k a
x Map k a
lrr Map k a
r)
                   (Map k a
_, Map k a
_) -> forall a. HasCallStack => [Char] -> a
error [Char]
"Failure in Data.Map.balanceL"
              | Bool
otherwise -> forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Size
1forall a. Num a => a -> a -> a
+Size
lsforall a. Num a => a -> a -> a
+Size
rs) k
k a
x Map k a
l Map k a
r
{-# NOINLINE balanceL #-}

balanceR :: k -> a -> Map k a -> Map k a -> Map k a
balanceR :: forall k a. k -> a -> Map k a -> Map k a -> Map k a
balanceR k
k a
x Map k a
l Map k a
r = case Map k a
l of
  Map k a
Tip -> case Map k a
r of
           Map k a
Tip -> forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
1 k
k a
x forall k a. Map k a
Tip forall k a. Map k a
Tip
           (Bin Size
_ k
_ a
_ Map k a
Tip Map k a
Tip) -> forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
2 k
k a
x forall k a. Map k a
Tip Map k a
r
           (Bin Size
_ k
rk a
rx Map k a
Tip rr :: Map k a
rr@(Bin Size
_ k
_ a
_ Map k a
_ Map k a
_)) -> forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
3 k
rk a
rx (forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
1 k
k a
x forall k a. Map k a
Tip forall k a. Map k a
Tip) Map k a
rr
           (Bin Size
_ k
rk a
rx (Bin Size
_ k
rlk a
rlx Map k a
_ Map k a
_) Map k a
Tip) -> forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
3 k
rlk a
rlx (forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
1 k
k a
x forall k a. Map k a
Tip forall k a. Map k a
Tip) (forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin Size
1 k
rk a
rx forall k a. Map k a
Tip forall k a. Map k a
Tip)
           (Bin Size
rs k
rk a
rx rl :: Map k a
rl@(Bin Size
rls k
rlk a
rlx Map k a
rll Map k a
rlr) rr :: Map k a
rr@(Bin Size
rrs k
_ a
_ Map k a
_ Map k a
_))
             | Size
rls forall a. Ord a => a -> a -> Bool
< Size
ratioforall a. Num a => a -> a -> a
*Size
rrs -> forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Size
1forall a. Num a => a -> a -> a
+Size
rs) k
rk a
rx (forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Size
1forall a. Num a => a -> a -> a
+Size
rls) k
k a
x forall k a. Map k a
Tip Map k a
rl) Map k a
rr
             | Bool
otherwise -> forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Size
1forall a. Num a => a -> a -> a
+Size
rs) k
rlk a
rlx (forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Size
1forall a. Num a => a -> a -> a
+forall k a. Map k a -> Size
size Map k a
rll) k
k a
x forall k a. Map k a
Tip Map k a
rll) (forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Size
1forall a. Num a => a -> a -> a
+Size
rrsforall a. Num a => a -> a -> a
+forall k a. Map k a -> Size
size Map k a
rlr) k
rk a
rx Map k a
rlr Map k a
rr)

  (Bin Size
ls k
_ a
_ Map k a
_ Map k a
_) -> case Map k a
r of
           Map k a
Tip -> forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Size
1forall a. Num a => a -> a -> a
+Size
ls) k
k a
x Map k a
l forall k a. Map k a
Tip

           (Bin Size
rs k
rk a
rx Map k a
rl Map k a
rr)
              | Size
rs forall a. Ord a => a -> a -> Bool
> Size
deltaforall a. Num a => a -> a -> a
*Size
ls  -> case (Map k a
rl, Map k a
rr) of
                   (Bin Size
rls k
rlk a
rlx Map k a
rll Map k a
rlr, Bin Size
rrs k
_ a
_ Map k a
_ Map k a
_)
                     | Size
rls forall a. Ord a => a -> a -> Bool
< Size
ratioforall a. Num a => a -> a -> a
*Size
rrs -> forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Size
1forall a. Num a => a -> a -> a
+Size
lsforall a. Num a => a -> a -> a
+Size
rs) k
rk a
rx (forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Size
1forall a. Num a => a -> a -> a
+Size
lsforall a. Num a => a -> a -> a
+Size
rls) k
k a
x Map k a
l Map k a
rl) Map k a
rr
                     | Bool
otherwise -> forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Size
1forall a. Num a => a -> a -> a
+Size
lsforall a. Num a => a -> a -> a
+Size
rs) k
rlk a
rlx (forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Size
1forall a. Num a => a -> a -> a
+Size
lsforall a. Num a => a -> a -> a
+forall k a. Map k a -> Size
size Map k a
rll) k
k a
x Map k a
l Map k a
rll) (forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Size
1forall a. Num a => a -> a -> a
+Size
rrsforall a. Num a => a -> a -> a
+forall k a. Map k a -> Size
size Map k a
rlr) k
rk a
rx Map k a
rlr Map k a
rr)
                   (Map k a
_, Map k a
_) -> forall a. HasCallStack => [Char] -> a
error [Char]
"Failure in Data.Map.balanceR"
              | Bool
otherwise -> forall k a. Size -> k -> a -> Map k a -> Map k a -> Map k a
Bin (Size
1forall a. Num a => a -> a -> a
+Size
lsforall a. Num a => a -> a -> a
+Size
rs) k
k a
x Map k a
l Map k a
r
{-# NOINLINE balanceR #-}

delta,ratio :: Int
delta :: Size
delta = Size
3
ratio :: Size
ratio = Size
2