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

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

    -- * Run
  , run
  ) where

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

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 :: forall a. 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 :: forall a. 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 :: forall a. 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 :: forall a. 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 :: forall a. 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 :: forall a. 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#