{-# language RankNTypes #-}
{-# language BangPatterns #-}
{-# language UnboxedTuples #-}
{-# language MagicHash #-}

module Data.Builder
  ( -- * Builder
    Builder(..)
  , cons
  , singleton
  , doubleton
  , tripleton
    -- * Run
  , run
  ) where

import Compat (unsafeShrinkAndFreeze#)
import Data.Chunks (Chunks(ChunksNil,ChunksCons))
import Data.Primitive (SmallArray(SmallArray))
import GHC.Exts ((*#),(+#),(-#),(>#))
import GHC.Exts (SmallMutableArray#)
import GHC.Exts (State#,Int#,runRW#)
import GHC.Exts (newSmallArray#)
import GHC.Exts (writeSmallArray#,unsafeFreezeSmallArray#)

import qualified Data.Chunks as C

-- | Builder for an array of boxed elements.
newtype Builder a = Builder
  -- The chunks being built up are in reverse order.
  -- Consequently, functions that run a builder must
  -- reverse the chunks at the end.
  (forall s. SmallMutableArray# s a -> Int# -> Int# -> Chunks a -> State# s
   -> (# State# s, SmallMutableArray# s a, Int#, Int#, Chunks a #)
  )

run :: Builder a -> Chunks a
run :: Builder a -> Chunks a
run (Builder forall s.
SmallMutableArray# s a
-> Int#
-> Int#
-> Chunks a
-> State# s
-> (# State# s, SmallMutableArray# s a, Int#, Int#, Chunks a #)
f) = case (State# RealWorld -> (# State# RealWorld, Chunks a #))
-> (# State# RealWorld, Chunks a #)
forall o. (State# RealWorld -> o) -> o
runRW#
  -- The initial size of 16 elements is chosen somewhat
  -- arbitrarily. It is more than enough to saturate a
  -- cache line.
  (\State# RealWorld
s0 -> case Int#
-> a
-> State# RealWorld
-> (# State# RealWorld, SmallMutableArray# RealWorld a #)
forall a d.
Int# -> a -> State# d -> (# State# d, SmallMutableArray# d a #)
newSmallArray# Int#
16# a
forall a. a
errorThunk State# RealWorld
s0 of
    (# State# RealWorld
s1, SmallMutableArray# RealWorld a
marr0 #) -> case SmallMutableArray# RealWorld a
-> Int#
-> Int#
-> Chunks a
-> State# RealWorld
-> (# State# RealWorld, SmallMutableArray# RealWorld a, Int#, Int#,
      Chunks a #)
forall s.
SmallMutableArray# s a
-> Int#
-> Int#
-> Chunks a
-> State# s
-> (# State# s, SmallMutableArray# s a, Int#, Int#, Chunks a #)
f SmallMutableArray# RealWorld a
marr0 Int#
0# Int#
16# Chunks a
forall a. Chunks a
ChunksNil State# RealWorld
s1 of
      (# State# RealWorld
s2, SmallMutableArray# RealWorld a
marr, Int#
off, Int#
_, Chunks a
cs #) ->
        -- Recall that freezeSmallArray copies a slice.
        -- If resize functions ever become available for
        -- SmallArray, we should use that instead.
        case SmallMutableArray# RealWorld a
-> Int#
-> State# RealWorld
-> (# State# RealWorld, SmallArray# a #)
forall s a.
SmallMutableArray# s a
-> Int# -> State# s -> (# State# s, SmallArray# a #)
unsafeShrinkAndFreeze# SmallMutableArray# RealWorld a
marr Int#
off State# RealWorld
s2 of
          (# State# RealWorld
s3, SmallArray# a
arr #) ->
            let !r :: Chunks a
r = Chunks a -> Chunks a -> Chunks a
forall a. Chunks a -> Chunks a -> Chunks a
C.reverseOnto
                  (SmallArray a -> Chunks a -> Chunks a
forall a. SmallArray a -> Chunks a -> Chunks a
ChunksCons (SmallArray# a -> SmallArray a
forall a. SmallArray# a -> SmallArray a
SmallArray SmallArray# a
arr) Chunks a
forall a. Chunks a
ChunksNil)
                  Chunks a
cs
             in (# State# RealWorld
s3, Chunks a
r #)
  ) of (# State# RealWorld
_, Chunks a
cs #) -> Chunks a
cs

errorThunk :: a
{-# noinline errorThunk #-}
errorThunk :: a
errorThunk = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"array-builder:Data.Builder: error"

instance Monoid (Builder a) where
  {-# inline mempty #-}
  mempty :: Builder a
mempty = (forall s.
 SmallMutableArray# s a
 -> Int#
 -> Int#
 -> Chunks a
 -> State# s
 -> (# State# s, SmallMutableArray# s a, Int#, Int#, Chunks a #))
-> Builder a
forall a.
(forall s.
 SmallMutableArray# s a
 -> Int#
 -> Int#
 -> Chunks a
 -> State# s
 -> (# State# s, SmallMutableArray# s a, Int#, Int#, Chunks a #))
-> Builder a
Builder
    (\SmallMutableArray# s a
marr0 Int#
off0 Int#
len0 Chunks a
cs0 State# s
s0 ->
      (# State# s
s0, SmallMutableArray# s a
marr0, Int#
off0, Int#
len0, Chunks a
cs0 #)
    )

instance Semigroup (Builder a) where
  {-# inline (<>) #-}
  Builder forall s.
SmallMutableArray# s a
-> Int#
-> Int#
-> Chunks a
-> State# s
-> (# State# s, SmallMutableArray# s a, Int#, Int#, Chunks a #)
f <> :: Builder a -> Builder a -> Builder a
<> Builder forall s.
SmallMutableArray# s a
-> Int#
-> Int#
-> Chunks a
-> State# s
-> (# State# s, SmallMutableArray# s a, Int#, Int#, Chunks a #)
g = (forall s.
 SmallMutableArray# s a
 -> Int#
 -> Int#
 -> Chunks a
 -> State# s
 -> (# State# s, SmallMutableArray# s a, Int#, Int#, Chunks a #))
-> Builder a
forall a.
(forall s.
 SmallMutableArray# s a
 -> Int#
 -> Int#
 -> Chunks a
 -> State# s
 -> (# State# s, SmallMutableArray# s a, Int#, Int#, Chunks a #))
-> Builder a
Builder
    (\SmallMutableArray# s a
marr0 Int#
off0 Int#
len0 Chunks a
cs0 State# s
s0 -> case SmallMutableArray# s a
-> Int#
-> Int#
-> Chunks a
-> State# s
-> (# State# s, SmallMutableArray# s a, Int#, Int#, Chunks a #)
forall s.
SmallMutableArray# s a
-> Int#
-> Int#
-> Chunks a
-> State# s
-> (# State# s, SmallMutableArray# s a, Int#, Int#, Chunks a #)
f SmallMutableArray# s a
marr0 Int#
off0 Int#
len0 Chunks a
cs0 State# s
s0 of
      (# State# s
s1, SmallMutableArray# s a
marr1, Int#
off1, Int#
len1, Chunks a
cs1 #) ->
        SmallMutableArray# s a
-> Int#
-> Int#
-> Chunks a
-> State# s
-> (# State# s, SmallMutableArray# s a, Int#, Int#, Chunks a #)
forall s.
SmallMutableArray# s a
-> Int#
-> Int#
-> Chunks a
-> State# s
-> (# State# s, SmallMutableArray# s a, Int#, Int#, Chunks a #)
g SmallMutableArray# s a
marr1 Int#
off1 Int#
len1 Chunks a
cs1 State# s
s1
    )

cons :: a -> Builder a -> Builder a
{-# inline cons #-}
cons :: a -> Builder a -> Builder a
cons a
a Builder a
b = a -> Builder a
forall a. a -> Builder a
singleton a
a Builder a -> Builder a -> Builder a
forall a. Semigroup a => a -> a -> a
<> Builder a
b

-- | A builder with one element.
singleton :: a -> Builder a
{-# noinline singleton #-}
singleton :: a -> Builder a
singleton a
a = (forall s.
 SmallMutableArray# s a
 -> Int#
 -> Int#
 -> Chunks a
 -> State# s
 -> (# State# s, SmallMutableArray# s a, Int#, Int#, Chunks a #))
-> Builder a
forall a.
(forall s.
 SmallMutableArray# s a
 -> Int#
 -> Int#
 -> Chunks a
 -> State# s
 -> (# State# s, SmallMutableArray# s a, Int#, Int#, Chunks a #))
-> Builder a
Builder
  (\SmallMutableArray# s a
marr Int#
off Int#
len Chunks a
cs State# s
s0 -> case Int#
len Int# -> Int# -> Int#
># Int#
0# of
    Int#
1# -> case SmallMutableArray# s a -> Int# -> a -> State# s -> State# s
forall d a.
SmallMutableArray# d a -> Int# -> a -> State# d -> State# d
writeSmallArray# SmallMutableArray# s a
marr Int#
off a
a State# s
s0 of
      State# s
s1 -> (# State# s
s1, SmallMutableArray# s a
marr, Int#
off Int# -> Int# -> Int#
+# Int#
1#, Int#
len Int# -> Int# -> Int#
-# Int#
1#, Chunks a
cs #)
    Int#
_ -> case SmallMutableArray# s a -> State# s -> (# State# s, SmallArray# a #)
forall d a.
SmallMutableArray# d a -> State# d -> (# State# d, SmallArray# a #)
unsafeFreezeSmallArray# SmallMutableArray# s a
marr State# s
s0 of
      (# State# s
s1, SmallArray# a
arr #) -> let !lenNew :: Int#
lenNew = Int# -> Int#
nextLength Int#
off in
        -- Since we feed the element to newSmallArray#, we do not
        -- need to write it to the 0 index.
        case Int# -> a -> State# s -> (# State# s, SmallMutableArray# s a #)
forall a d.
Int# -> a -> State# d -> (# State# d, SmallMutableArray# d a #)
newSmallArray# Int#
lenNew a
a State# s
s1 of
          (# State# s
s2, SmallMutableArray# s a
marrNew #) ->
            let !csNew :: Chunks a
csNew = SmallArray a -> Chunks a -> Chunks a
forall a. SmallArray a -> Chunks a -> Chunks a
ChunksCons (SmallArray# a -> SmallArray a
forall a. SmallArray# a -> SmallArray a
SmallArray SmallArray# a
arr) Chunks a
cs in
              (# State# s
s2, SmallMutableArray# s a
marrNew, Int#
1#, Int#
lenNew Int# -> Int# -> Int#
-# Int#
1#, Chunks a
csNew #)
  )

-- | A builder with two elements.
--
-- @since 0.1.1.0
doubleton :: a -> a -> Builder a
{-# noinline doubleton #-}
doubleton :: a -> a -> Builder a
doubleton a
a a
b = (forall s.
 SmallMutableArray# s a
 -> Int#
 -> Int#
 -> Chunks a
 -> State# s
 -> (# State# s, SmallMutableArray# s a, Int#, Int#, Chunks a #))
-> Builder a
forall a.
(forall s.
 SmallMutableArray# s a
 -> Int#
 -> Int#
 -> Chunks a
 -> State# s
 -> (# State# s, SmallMutableArray# s a, Int#, Int#, Chunks a #))
-> Builder a
Builder
  (\SmallMutableArray# s a
marr Int#
off Int#
len Chunks a
cs State# s
s0 -> case Int#
len Int# -> Int# -> Int#
># Int#
1# of
    Int#
1# -> case SmallMutableArray# s a -> Int# -> a -> State# s -> State# s
forall d a.
SmallMutableArray# d a -> Int# -> a -> State# d -> State# d
writeSmallArray# SmallMutableArray# s a
marr Int#
off a
a State# s
s0 of
      State# s
s1 -> case SmallMutableArray# s a -> Int# -> a -> State# s -> State# s
forall d a.
SmallMutableArray# d a -> Int# -> a -> State# d -> State# d
writeSmallArray# SmallMutableArray# s a
marr (Int#
off Int# -> Int# -> Int#
+# Int#
1#) a
b State# s
s1 of
        State# s
s2 -> (# State# s
s2, SmallMutableArray# s a
marr, Int#
off Int# -> Int# -> Int#
+# Int#
2#, Int#
len Int# -> Int# -> Int#
-# Int#
2#, Chunks a
cs #)
    Int#
_ -> case SmallMutableArray# s a
-> Int# -> State# s -> (# State# s, SmallArray# a #)
forall s a.
SmallMutableArray# s a
-> Int# -> State# s -> (# State# s, SmallArray# a #)
unsafeShrinkAndFreeze# SmallMutableArray# s a
marr Int#
off State# s
s0 of
      (# State# s
s1, SmallArray# a
arr #) -> let !lenNew :: Int#
lenNew = Int# -> Int#
nextLength Int#
off in
        -- Since we feed the element to newSmallArray#, we do not
        -- need to write element a to the 0 index.
        case Int# -> a -> State# s -> (# State# s, SmallMutableArray# s a #)
forall a d.
Int# -> a -> State# d -> (# State# d, SmallMutableArray# d a #)
newSmallArray# Int#
lenNew a
a State# s
s1 of
          (# State# s
s2, SmallMutableArray# s a
marrNew #) -> case SmallMutableArray# s a -> Int# -> a -> State# s -> State# s
forall d a.
SmallMutableArray# d a -> Int# -> a -> State# d -> State# d
writeSmallArray# SmallMutableArray# s a
marrNew Int#
1# a
b State# s
s2 of
            State# s
s3 -> let !csNew :: Chunks a
csNew = SmallArray a -> Chunks a -> Chunks a
forall a. SmallArray a -> Chunks a -> Chunks a
ChunksCons (SmallArray# a -> SmallArray a
forall a. SmallArray# a -> SmallArray a
SmallArray SmallArray# a
arr) Chunks a
cs in
              (# State# s
s3, SmallMutableArray# s a
marrNew, Int#
2#, Int#
lenNew Int# -> Int# -> Int#
-# Int#
2#, Chunks a
csNew #)
  )

-- | A builder with three elements.
--
-- @since 0.1.1.0
tripleton :: a -> a -> a -> Builder a
{-# noinline tripleton #-}
tripleton :: a -> a -> a -> Builder a
tripleton a
a a
b a
c = (forall s.
 SmallMutableArray# s a
 -> Int#
 -> Int#
 -> Chunks a
 -> State# s
 -> (# State# s, SmallMutableArray# s a, Int#, Int#, Chunks a #))
-> Builder a
forall a.
(forall s.
 SmallMutableArray# s a
 -> Int#
 -> Int#
 -> Chunks a
 -> State# s
 -> (# State# s, SmallMutableArray# s a, Int#, Int#, Chunks a #))
-> Builder a
Builder
  (\SmallMutableArray# s a
marr Int#
off Int#
len Chunks a
cs State# s
s0 -> case Int#
len Int# -> Int# -> Int#
># Int#
1# of
    Int#
1# -> case SmallMutableArray# s a -> Int# -> a -> State# s -> State# s
forall d a.
SmallMutableArray# d a -> Int# -> a -> State# d -> State# d
writeSmallArray# SmallMutableArray# s a
marr Int#
off a
a State# s
s0 of
      State# s
s1 -> case SmallMutableArray# s a -> Int# -> a -> State# s -> State# s
forall d a.
SmallMutableArray# d a -> Int# -> a -> State# d -> State# d
writeSmallArray# SmallMutableArray# s a
marr (Int#
off Int# -> Int# -> Int#
+# Int#
1#) a
b State# s
s1 of
        State# s
s2 -> case SmallMutableArray# s a -> Int# -> a -> State# s -> State# s
forall d a.
SmallMutableArray# d a -> Int# -> a -> State# d -> State# d
writeSmallArray# SmallMutableArray# s a
marr (Int#
off Int# -> Int# -> Int#
+# Int#
2#) a
c State# s
s2 of
          State# s
s3 -> (# State# s
s3, SmallMutableArray# s a
marr, Int#
off Int# -> Int# -> Int#
+# Int#
3#, Int#
len Int# -> Int# -> Int#
-# Int#
3#, Chunks a
cs #)
    Int#
_ -> case SmallMutableArray# s a
-> Int# -> State# s -> (# State# s, SmallArray# a #)
forall s a.
SmallMutableArray# s a
-> Int# -> State# s -> (# State# s, SmallArray# a #)
unsafeShrinkAndFreeze# SmallMutableArray# s a
marr Int#
off State# s
s0 of
      (# State# s
s1, SmallArray# a
arr #) -> let !lenNew :: Int#
lenNew = Int# -> Int#
nextLength Int#
off in
        -- Since we feed the element to newSmallArray#, we do not
        -- need to write element a to the 0 index.
        case Int# -> a -> State# s -> (# State# s, SmallMutableArray# s a #)
forall a d.
Int# -> a -> State# d -> (# State# d, SmallMutableArray# d a #)
newSmallArray# Int#
lenNew a
a State# s
s1 of
          (# State# s
s2, SmallMutableArray# s a
marrNew #) -> case SmallMutableArray# s a -> Int# -> a -> State# s -> State# s
forall d a.
SmallMutableArray# d a -> Int# -> a -> State# d -> State# d
writeSmallArray# SmallMutableArray# s a
marrNew Int#
1# a
b State# s
s2 of
            State# s
s3 -> case SmallMutableArray# s a -> Int# -> a -> State# s -> State# s
forall d a.
SmallMutableArray# d a -> Int# -> a -> State# d -> State# d
writeSmallArray# SmallMutableArray# s a
marrNew Int#
2# a
c State# s
s3 of
              State# s
s4 -> let !csNew :: Chunks a
csNew = SmallArray a -> Chunks a -> Chunks a
forall a. SmallArray a -> Chunks a -> Chunks a
ChunksCons (SmallArray# a -> SmallArray a
forall a. SmallArray# a -> SmallArray a
SmallArray SmallArray# a
arr) Chunks a
cs in
                (# State# s
s4, SmallMutableArray# s a
marrNew, Int#
3#, Int#
lenNew Int# -> Int# -> Int#
-# Int#
3#, Chunks a
csNew #)
  )

nextLength :: Int# -> Int#
{-# inline nextLength #-}
nextLength :: Int# -> Int#
nextLength Int#
i = Int#
i Int# -> Int# -> Int#
*# Int#
2#