80d0b93 · rowtype-yoga/purescript-arraybuffer-builder

git.iko.soy/rowtype-yoga/purescript-arraybuffer-builder

Stack-safe foldl, foldM

commit80d0b93d2c84e5e0363da960df61b40ae2028a8f authorJames Brock <jamesbrock@gmail.com> dateTue 19 Apr 2022, 23:37 (4 years ago) parent37eeab5

7 files changed+103−50

compare with master

unifiedsplit

CHANGELOG.md+5−1 README.md+40−21 spago.dhall+4 src/Data/ArrayBuffer/Builder.purs+4−3 src/Data/ArrayBuffer/Internal.purs+25−9 test.dhall+5−2 test/Main.purs+20−14

CHANGELOG.md+5−1

@@ -1,8 +1,12 @@

11# Changelog

3−## v3.0.0 2022-04-13

3+## v3.0.0 2022-04-21

55Build for PureScript v0.15.

7+Added `MonadRec` constraint to `execPut`, `execPutM`, `foldl`, `foldM`,

8+they are now stack-safe.

610## v2.1.0 2021-07-22

711

812Renamed `Data.ArrayBuffer.Internal.Bytes` and exported

README.md+40−21

@@ -3,25 +3,18 @@

33[![CI](https://github.com/jamesdbrock/purescript-arraybuffer-builder/workflows/CI/badge.svg?branch=master)](https://github.com/jamesdbrock/purescript-arraybuffer-builder/actions)

44[![Pursuit](http://pursuit.purescript.org/packages/purescript-arraybuffer-builder/badge)](http://pursuit.purescript.org/packages/purescript-arraybuffer-builder/)

6−`ArrayBuffer` serialization in the “builder monoid” and “builder monad” style.

7−In this style, we build up serialized data structures by `append`ing to

8−a monoid in a Writer monad with do-notation. This style of serialization

7+[`ArrayBuffer`](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/ArrayBuffer)

8+serialization in the “builder monoid” and “builder monad” style.

9+In this style, we build up serialized data structures by `tell`ing to

10+a `Writer` monad with `do`-notation. This style of serialization

911has been used for a long time and we [insist that it works really well](https://wiki.haskell.org/Do_notation_considered_harmful#Library_design).

1012

1113This package provides a `Builder` monoid and a `PutM` monad which are roughly

1214equivalent to types of the same name in the Haskell

13−[`Data.Binary.Put`](https://hackage.haskell.org/package/binary/docs/Data-Binary-Put.html)

15+[__Data.Binary.Put__](https://hackage.haskell.org/package/binary/docs/Data-Binary-Put.html)

1416module.

1517

16−This package defines

17−[no typeclasses](http://code.slipthrough.net/2018/03/13/thoughts-on-typeclass-codecs/).

18−Typeclass-based

19−serialization/deserialization generally assumes that we are round-tripping

20−some data structures out to storage and then back into our program.

21−This package is designed for the case in which we are serializing some data

22−to be sent to another program which expects a serialization format

23−that we don't control.

24−

2518## Usage Examples

2619

2720All `ArrayBuffer` building must occur in `Effect`.

@@ -45,7 +38,7 @@ IEEE-754 double-precision floats.

4538import Data.ArrayBuffer.Builder (execPut, putFloat64be)

4639

4740do

48− arraybuffer :: ArrayBuffer <- execPut $ do

41+ arraybuffer :: ArrayBuffer <- execPut do

4942 putFloat64be 1.0

5043 putFloat64be 2.0

5144 putFloat64be 3.0

@@ -65,7 +58,7 @@ import Data.ArrayBuffer.Typed (buffer)

6558import Data.TextEncoding (encodeUtf8)

6659import Data.ArrayBuffer.ArrayBuffer (byteLength)

6760

68−putStringUtf8 :: forall m. (MonadEffect m) => String -> PutM m Unit

61+putStringUtf8 :: forall m. MonadEffect m => String -> PutM m Unit

6962putStringUtf8 s = do

7063 let stringbuf = buffer $ encodeUtf8 s

7164 -- Put a 32-bit big-endian length prefix for the length of the utf8 string, in bytes.

@@ -90,7 +83,7 @@ import Data.ArrayBuffer.Builder (execPut, putInt32be)

9083import Data.Foldable (traverse_)

9184import Data.Array (length)

9285

93−putArrayInt32 :: forall m. (MonadEffect m) => Array Int -> PutM m Unit

86+putArrayInt32 :: forall m. MonadEffect m => Array Int -> PutM m Unit

9487putArrayInt32 xs = do

9588 -- Put a 64-bit big-endian length prefix for the length of the array.

9689 putInt32be 0

@@ -101,6 +94,28 @@ do

10194 arraybuffer <- execPut $ putArrayInt32 [1,2,3]

10295```

10396

97+### Serialize an `Array Int` stack-safe

98+

99+Stack-safe version of the `putArrayInt32` function above. For stack-safety

100+we use `foldRecM` instead of `traverse_` because `foldRecM` has a `MonadRec`

101+constraint which makes it stack-safe.

102+

103+```purescript

104+import Data.Array (foldRecM)

105+

106+putArrayInt32 :: forall m. MonadEffect m => MonadRec m => Array Int -> PutM m Unit

107+putArrayInt32 xs = do

108+ -- Put a 64-bit big-endian length prefix for the length of the array.

109+ putInt32be 0

110+ putInt32be $ length xs

111+ foldRecM (\_ x -> putInt32be x) unit xs

112+```

113+

114+## Stack-safety

115+

116+This package will always be stack-safe if all of the functions called inside

117+of the `PutM` builder expression are stack-safe.

118+

104119## Deserialization

105120

106121This package is only for writing `ArrayBuffer`s, not reading them.

@@ -108,13 +123,17 @@ See

108123[__purescript-parsing-dataview__](https://pursuit.purescript.org/packages/purescript-parsing-dataview/)

109124for a way to deserialize from `ArrayBuffer` back to Purescript data.

110125

111−## References

112−

113−* [MDN `ArrayBuffer`](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/ArrayBuffer)

114−

115126## Alternative packages for serializing to an `ArrayBuffer`

116127

117128* [__dynamic-buffers__](https://pursuit.purescript.org/packages/purescript-dynamic-buffers)

118129* [__node-buffer__](https://pursuit.purescript.org/packages/purescript-node-buffer)

119130* [__arraybuffer-class__](https://pursuit.purescript.org/packages/purescript-arraybuffer-class)

120−* [__bytestrings__](https://pursuit.purescript.org/packages/purescript-bytestrings/)

131+* [__bytestrings__](https://pursuit.purescript.org/packages/purescript-bytestrings/)

132+

133+## Development

134+

135+To run the tests,

136+

137+```shell

138+spago -x test.dhall test

139+```

spago.dhall+4

@@ -4,12 +4,16 @@

44, dependencies =

55 [ "effect"

66 , "float32"

7+ , "identity"

8+ , "lists"

79 , "maybe"

10+ , "newtype"

811 , "prelude"

912 , "transformers"

1013 , "uint"

1114 , "arraybuffer-types"

1215 , "arraybuffer"

16+ , "tailrec"

1317 ]

1418, packages = ./packages.dhall

1519, sources = [ "src/**/*.purs" ]

src/Data/ArrayBuffer/Builder.purs+4−3

@@ -38,6 +38,7 @@ where

3838

3939import Prelude

4040

41+import Control.Monad.Rec.Class (class MonadRec)

4142import Control.Monad.Writer.Trans (WriterT, execWriterT, tell, lift)

4243import Data.ArrayBuffer.Builder.Internal (Builder, DataBuff(..), length, toView, (<>>))

4344import Data.ArrayBuffer.Builder.Internal as Internal

@@ -58,11 +59,11 @@ type PutM = WriterT Builder

5859-- | The `PutM` type reified to `Effect`, in other words `WriterT Builder Effect`.

5960type Put = PutM Effect

6061

61−-- | Build an `ArrayBuffer` with do-notation in any `MonadEffect`. *O(n)*

62−execPutM :: forall m. MonadEffect m => PutM m Unit -> m ArrayBuffer

62+-- | Build an `ArrayBuffer` with do-notation in any `MonadEffect`. *O(n)* Stack-safe.

63+execPutM :: forall m. MonadEffect m => MonadRec m => PutM m Unit -> m ArrayBuffer

6364execPutM = Internal.execBuilder <=< execWriterT

6465

65−-- | Build an `ArrayBuffer` with do-notation in `Effect`. *O(n)*

66+-- | Build an `ArrayBuffer` with do-notation in `Effect`. *O(n)* Stack-safe.

6667execPut :: Put Unit -> Effect ArrayBuffer

6768execPut = execPutM

6869

src/Data/ArrayBuffer/Internal.purs+25−9

@@ -109,12 +109,16 @@ where

109109

110110import Prelude

111111

112+import Control.Monad.Rec.Class (class MonadRec, Step(..), tailRecM)

112113import Data.ArrayBuffer.ArrayBuffer as AB

113114import Data.ArrayBuffer.DataView as DV

114115import Data.ArrayBuffer.Typed as AT

115116import Data.ArrayBuffer.Types (ArrayBuffer, ByteLength, DataView, Uint8Array)

116117import Data.Float32 (Float32)

118+import Data.Identity (Identity)

119+import Data.List (List(..), uncons, (:))

117120import Data.Maybe (Maybe(..))

121+import Data.Newtype (unwrap)

118122import Data.UInt (UInt)

119123import Effect (Effect)

120124import Effect.Class (class MonadEffect, liftEffect)

@@ -198,15 +202,27 @@ infixl 5 append as <>>

198202instance monoidBuilder :: Monoid Builder where

199203 mempty = Null

200204

201−-- | `Builder` is not an instance of `Foldable` because `Builder` is monomorphic.

202−foldl :: forall b. (b -> DataBuff -> b) -> b -> Builder -> b

203−foldl _ a Null = a

204−foldl f a (Node l x r) = foldl f (f (foldl f a l) x) r

205+-- | Stack-safe `foldl` over a `Builder`. *O(n)*

206+foldl :: forall a. (a -> DataBuff -> a) -> a -> Builder -> a

207+foldl f a0 b = (unwrap :: Identity a -> a) $ foldM (\a' b' -> pure (f a' b')) a0 b

205208

206−-- | Monomorphic foldM copied from

207−-- | [`Data.Foldable.foldM`](https://pursuit.purescript.org/packages/purescript-foldable-traversable/4.1.1/docs/Data.Foldable#v:foldM)

208−foldM :: forall b m. (Monad m) => (b -> DataBuff -> m b) -> b -> Builder -> m b

209−foldM f a0 = foldl (\ma b -> ma >>= flip f b) (pure a0)

209+-- | Stack-safe `foldM` over a `Builder`. *O(n)*.

210+foldM :: forall m a. MonadRec m => (a -> DataBuff -> m a) -> a -> Builder -> m a

211+-- The Art of Computer Programming 2.3.1

212+-- Inorder traversal using a stack

213+-- https://yuyuan.org/MorrisAlgorithm/

214+foldM f a0 b = tailRecM outer {p: b, stack: Nil, accum: a0}

215+ where

216+ outer {p,stack,accum} = do

217+ stack' <- tailRecM inner {p_:p,stack_:stack}

218+ case uncons stack' of

219+ Nothing -> pure $ Done accum

220+ Just {head: Node _ x r, tail} -> do

221+ accum' <- f accum x

222+ pure $ Loop {p: r, stack: tail, accum: accum'}

223+ Just {head:Null} -> pure $ Done accum

224+ inner {p_:Null,stack_} = pure $ Done stack_

225+ inner {p_: n@(Node l _ _), stack_} = pure $ Loop {p_: l, stack_: n:stack_}

210226

211227-- | Construct a `Builder` with a single `DataBuff`. *O(1)*

212228singleton :: DataBuff -> Builder

@@ -229,7 +245,7 @@ snoc :: Builder -> DataBuff -> Builder

229245snoc bs x = Node bs x Null

230246

231247-- | Build a single `ArrayBuffer` from a `Builder`. *O(n)*

232−execBuilder :: forall m. (MonadEffect m) => Builder -> m ArrayBuffer

248+execBuilder :: forall m. MonadEffect m => MonadRec m => Builder -> m ArrayBuffer

233249execBuilder bldr = do

234250 let buflen = length bldr

235251 -- Allocate the final ArrayBuffer

test.dhall+5−2

@@ -12,5 +12,8 @@ let conf = ./spago.dhall

1212

1313in conf //

1414 { sources = conf.sources # [ "test/**/*.purs" ]

15− , dependencies = conf.dependencies # [ "assert" ]

16− }

15+ , dependencies = conf.dependencies #

16+ [ "assert"

17+ , "arrays"

18+ ]

19+ }

test/Main.purs+20−14

@@ -1,15 +1,18 @@

11module Test.Main where

3−import Data.ArrayBuffer.Builder

3+import Prelude

5+import Control.Monad.Rec.Class (Step(..), tailRecM)

56import Control.Monad.Writer.Trans (tell)

7+import Data.Array (foldRecM)

8+import Data.Array as Array

9+import Data.ArrayBuffer.Builder (Builder, DataBuff(..), PutM, execPut, putInt16be, putInt32le, putInt8, subBuilder)

610import Data.ArrayBuffer.Builder.Internal (cons, encodeInt8, execBuilder, length, singleton, (<>>))

711import Data.ArrayBuffer.DataView as DV

812import Data.ArrayBuffer.Typed as AT

913import Data.ArrayBuffer.Types (ArrayBuffer, Uint8Array)

1014import Data.UInt as UInt

1115import Effect (Effect)

12−import Prelude (Unit, bind, pure, discard, map, negate, ($), (<$>), (=<<), (<>))

1316import Test.Assert (assertEqual')

1417

1518asBytes :: ArrayBuffer -> Effect (Array Int)

@@ -29,39 +32,39 @@ buildTest label expected bldr = do

2932

3033main :: Effect Unit

3134main = do

32− putTest "Test 0" [6,7,8] $ do

35+ putTest "Test 0" [6,7,8] do

3336 putInt8 6

3437 putInt8 7

3538 putInt8 8

3639

37− putTest "Test 1" [255,254] $ do

40+ putTest "Test 1" [255,254] do

3841 putInt16be (-2)

3942

40− putTest "Test 3" [3,0,0,0] $ do

43+ putTest "Test 3" [3,0,0,0] do

4144 putInt32le 3

4245

43− buildTest "Test 4" [1,2,3,4] $ do

46+ buildTest "Test 4" [1,2,3,4] do

4447 b1 <- Buff <$> encodeInt8 1

4548 b2 <- Buff <$> encodeInt8 2

4649 b3 <- Buff <$> encodeInt8 3

4750 b4 <- Buff <$> encodeInt8 4

4851 pure $ singleton b1 <> singleton b2 <> singleton b3 <> singleton b4

4952

50− buildTest "Test 5" [1,2,3,4] $ do

53+ buildTest "Test 5" [1,2,3,4] do

5154 b1 <- Buff <$> encodeInt8 1

5255 b2 <- Buff <$> encodeInt8 2

5356 b3 <- Buff <$> encodeInt8 3

5457 b4 <- Buff <$> encodeInt8 4

5558 pure $ singleton b1 <>> singleton b2 <>> singleton b3 <>> singleton b4

5659

57− buildTest "Test 6" [1,2,3,4] $ do

60+ buildTest "Test 6" [1,2,3,4] do

5861 b1 <- Buff <$> encodeInt8 1

5962 b2 <- Buff <$> encodeInt8 2

6063 b3 <- Buff <$> encodeInt8 3

6164 b4 <- Buff <$> encodeInt8 4

6265 pure $ singleton b1 <> (singleton b2 <> singleton b3) <> singleton b4

6366

64− buildTest "Test 6" [1,2,3,4,5,6,7,8] $ do

67+ buildTest "Test 6" [1,2,3,4,5,6,7,8] do

6568 b1 <- Buff <$> encodeInt8 1

6669 b2 <- Buff <$> encodeInt8 2

6770 b3 <- Buff <$> encodeInt8 3

@@ -73,7 +76,7 @@ main = do

7376 pure $ singleton b1 <> (singleton b2 <> singleton b3) <> singleton b4

7477 <> singleton b5 <> (singleton b6 <> singleton b7) <> singleton b8

7578

76− buildTest "Test 7" [1,2,3,4,5,6,7,8] $ do

79+ buildTest "Test 7" [1,2,3,4,5,6,7,8] do

7780 b1 <- Buff <$> encodeInt8 1

7881 b2 <- Buff <$> encodeInt8 2

7982 b3 <- Buff <$> encodeInt8 3

@@ -85,15 +88,15 @@ main = do

8588 pure $ ((singleton b1 <> singleton b2) <> (singleton b3 <> singleton b4))

8689 <> ((singleton b5 <> singleton b6) <> (singleton b7 <> singleton b8))

8790

88− buildTest "Test 8" [1,2,3,4] $ do

91+ buildTest "Test 8" [1,2,3,4] do

8992 b1 <- Buff <$> encodeInt8 1

9093 b2 <- Buff <$> encodeInt8 2

9194 b3 <- Buff <$> encodeInt8 3

9295 b4 <- Buff <$> encodeInt8 4

9396 pure $ (cons b1 (singleton b2)) <> (cons b3 (singleton b4))

9497

95− putTest "Test 9" [1,2,2,3,4] $ do

96− x <- subBuilder $ do

98+ putTest "Test 9" [1,2,2,3,4] do

99+ x <- subBuilder do

97100 putInt8 3

98101 putInt8 4

99102 putInt8 1

@@ -101,7 +104,7 @@ main = do

101104 putInt8 $ length x

102105 tell x

103106

104− buildTest "Test 10" [1,2,3,4,5,6,7,8] $ do

107+ buildTest "Test 10" [1,2,3,4,5,6,7,8] do

105108 b1 <- View <$> DV.whole <$> encodeInt8 1

106109 b2 <- View <$> DV.whole <$> encodeInt8 2

107110 b3 <- View <$> DV.whole <$> encodeInt8 3

@@ -113,3 +116,6 @@ main = do

113116 pure $ ((singleton b1 <> singleton b2) <> (singleton b3 <> singleton b4))

114117 <> ((singleton b5 <> singleton b6) <> (singleton b7 <> singleton b8))

115118

119+ let stackblower = Array.replicate 20000 2

120+ putTest "Stack test" stackblower do

121+ foldRecM (\_ x -> putInt8 x) unit stackblower