{-# LANGUAGE PatternSynonyms #-}
module Data.RRBVector.Internal.Debug
( showTree
, fromListUnbalanced
, pattern Empty, pattern Root
, Tree, Shift
, pattern Balanced, pattern Unbalanced, pattern Leaf
) where
import Control.Monad.ST (runST)
import Data.Foldable (toList)
import Data.List (intercalate)
import Data.Primitive.PrimArray (PrimArray, primArrayToList)
import Data.RRBVector.Internal hiding (Empty, Root, Balanced, Unbalanced, Leaf)
import qualified Data.RRBVector.Internal as RRB
import Data.RRBVector.Internal.Array (Array)
import qualified Data.RRBVector.Internal.Buffer as Buffer
showTree :: (Show a) => Vector a -> String
showTree :: forall a. Show a => Vector a -> String
showTree Vector a
Empty = String
"Empty"
showTree (Root Int
size Int
sh Tree a
tree) = String
"Root {size = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
size forall a. [a] -> [a] -> [a]
++ String
", shift = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
sh forall a. [a] -> [a] -> [a]
++ String
", tree = " forall a. [a] -> [a] -> [a]
++ forall {a}. Show a => Tree a -> String
debugShowTree Tree a
tree forall a. [a] -> [a] -> [a]
++ String
"}"
where
debugShowTree :: Tree a -> String
debugShowTree (Balanced Array (Tree a)
arr) = String
"Balanced " forall a. [a] -> [a] -> [a]
++ Array (Tree a) -> String
debugShowArray Array (Tree a)
arr
debugShowTree (Unbalanced Array (Tree a)
arr PrimArray Int
sizes) = String
"Unbalanced " forall a. [a] -> [a] -> [a]
++ Array (Tree a) -> String
debugShowArray Array (Tree a)
arr forall a. [a] -> [a] -> [a]
++ String
" (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. Prim a => PrimArray a -> [a]
primArrayToList PrimArray Int
sizes) forall a. [a] -> [a] -> [a]
++ String
")"
debugShowTree (Leaf Array a
arr) = String
"Leaf " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array a
arr)
debugShowArray :: Array (Tree a) -> String
debugShowArray Array (Tree a)
arr = String
"[" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
"," (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Tree a -> String
debugShowTree (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array (Tree a)
arr)) forall a. [a] -> [a] -> [a]
++ String
"]"
fromListUnbalanced :: [a] -> Vector a
fromListUnbalanced :: forall a. [a] -> Vector a
fromListUnbalanced [] = forall a. Vector a
RRB.Empty
fromListUnbalanced [a
x] = forall a. a -> Vector a
singleton a
x
fromListUnbalanced [a]
ls = case forall {a} {a}. (Array a -> a) -> [a] -> [a]
nodes forall a. Array a -> Tree a
RRB.Leaf [a]
ls of
[Tree a
tree] -> forall a. Int -> Int -> Tree a -> Vector a
RRB.Root (forall a. Int -> Tree a -> Int
treeSize Int
0 Tree a
tree) Int
0 Tree a
tree
[Tree a]
ls' -> forall {a}. Int -> [Tree a] -> Vector a
iterateNodes Int
blockShift [Tree a]
ls'
where
n :: Int
n = Int
blockSize forall a. Num a => a -> a -> a
- Int
1
nodes :: (Array a -> a) -> [a] -> [a]
nodes Array a -> a
f [a]
trees = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
Buffer s a
buffer <- forall s a. Int -> ST s (Buffer s a)
Buffer.new Int
n
let loop :: [a] -> ST s [a]
loop [] = do
Array a
result <- forall s a. Buffer s a -> ST s (Array a)
Buffer.get Buffer s a
buffer
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Array a -> a
f Array a
result]
loop (a
t : [a]
ts) = do
Int
size <- forall s a. Buffer s a -> ST s Int
Buffer.size Buffer s a
buffer
if Int
size forall a. Eq a => a -> a -> Bool
== Int
n then do
Array a
result <- forall s a. Buffer s a -> ST s (Array a)
Buffer.get Buffer s a
buffer
forall s a. Buffer s a -> a -> ST s ()
Buffer.push Buffer s a
buffer a
t
[a]
rest <- [a] -> ST s [a]
loop [a]
ts
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Array a -> a
f Array a
result forall a. a -> [a] -> [a]
: [a]
rest)
else do
forall s a. Buffer s a -> a -> ST s ()
Buffer.push Buffer s a
buffer a
t
[a] -> ST s [a]
loop [a]
ts
[a] -> ST s [a]
loop [a]
trees
{-# INLINE nodes #-}
iterateNodes :: Int -> [Tree a] -> Vector a
iterateNodes Int
sh [Tree a]
trees = case forall {a} {a}. (Array a -> a) -> [a] -> [a]
nodes (forall a. Int -> Array (Tree a) -> Tree a
computeSizes Int
sh) [Tree a]
trees of
[Tree a
tree] -> forall a. Int -> Int -> Tree a -> Vector a
RRB.Root (forall a. Int -> Tree a -> Int
treeSize Int
sh Tree a
tree) Int
sh Tree a
tree
[Tree a]
trees' -> Int -> [Tree a] -> Vector a
iterateNodes (Int -> Int
up Int
sh) [Tree a]
trees'
pattern Empty :: Vector a
pattern $mEmpty :: forall {r} {a}. Vector a -> ((# #) -> r) -> ((# #) -> r) -> r
Empty <- RRB.Empty
pattern Root :: Int -> Shift -> Tree a -> Vector a
pattern $mRoot :: forall {r} {a}.
Vector a -> (Int -> Int -> Tree a -> r) -> ((# #) -> r) -> r
Root size sh tree <- RRB.Root size sh tree
{-# COMPLETE Empty, Root #-}
pattern Balanced :: Array (Tree a) -> Tree a
pattern $mBalanced :: forall {r} {a}.
Tree a -> (Array (Tree a) -> r) -> ((# #) -> r) -> r
Balanced arr <- RRB.Balanced arr
pattern Unbalanced :: Array (Tree a) -> PrimArray Int -> Tree a
pattern $mUnbalanced :: forall {r} {a}.
Tree a
-> (Array (Tree a) -> PrimArray Int -> r) -> ((# #) -> r) -> r
Unbalanced arr sizes <- RRB.Unbalanced arr sizes
pattern Leaf :: Array a -> Tree a
pattern $mLeaf :: forall {r} {a}. Tree a -> (Array a -> r) -> ((# #) -> r) -> r
Leaf arr <- RRB.Leaf arr
{-# COMPLETE Balanced, Unbalanced, Leaf #-}