Skip to content

Commit 986e0e0

Browse files
andrewthadandrewthad
committed
Switch from Chunks to SmallArray in Object and Array
1 parent a786565 commit 986e0e0

4 files changed

Lines changed: 148 additions & 70 deletions

File tree

‎CHANGELOG.md‎

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,10 @@
11
# Revision history for json-syntax
22

3-
## 0.1.3.0 -- 2021-??-??
3+
## 0.2.0.0 -- 2021-??-??
44

5+
* Switch from `Chunks` to `SmallArray` in the `Object` and `Array` data
6+
constructors. This makes the library simpler to use but it a breaking
7+
change.
58
* Add `object(9|10|11|12)` as convenience helpers for construction.
69

710
## 0.1.2.0 -- 2020-11-18

‎json-syntax.cabal‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
cabal-version: 2.2
22
name: json-syntax
3-
version: 0.1.3.0
3+
version: 0.2.0.0
44
synopsis: High-performance JSON parser and encoder
55
description:
66
This library parses JSON into a @Value@ type that is consistent with the
@@ -36,6 +36,7 @@ library
3636
, bytesmith >=0.3.2 && <0.4
3737
, bytestring >=0.10.8 && <0.11
3838
, primitive >=0.7 && <0.8
39+
, run-st >=0.1.1 && <0.2
3940
, scientific-notation >=0.1.2 && <0.2
4041
, text-short >=0.1.3 && <0.2
4142
hs-source-dirs: src

‎src/Json.hs‎

Lines changed: 135 additions & 61 deletions
Original file line numberDiff line numberDiff line change
@@ -40,17 +40,16 @@ import Prelude hiding (Bool(True,False))
4040

4141
import Control.Exception (Exception)
4242
import Control.Monad.ST (ST)
43+
import Control.Monad.ST.Run (runSmallArrayST)
4344
import Data.Bits ((.&.),(.|.),unsafeShiftR)
4445
import Data.Builder.ST (Builder)
4546
import Data.Bytes.Parser (Parser)
4647
import Data.Bytes.Types (Bytes(..))
4748
import Data.Char (ord)
48-
import Data.Chunks (Chunks(ChunksNil,ChunksCons))
4949
import Data.Number.Scientific (Scientific)
50-
import Data.Primitive (ByteArray,MutableByteArray)
50+
import Data.Primitive (ByteArray,MutableByteArray,SmallArray)
5151
import Data.Text.Short (ShortText)
52-
import GHC.Exts (SmallArray#,Char(C#),Int(I#),gtWord#,ltWord#,word2Int#,chr#)
53-
import GHC.Exts (sizeofSmallArray#,indexSmallArray#)
52+
import GHC.Exts (Char(C#),Int(I#),gtWord#,ltWord#,word2Int#,chr#)
5453
import GHC.Word (Word8(W8#),Word16(W16#))
5554

5655
import qualified Prelude
@@ -82,8 +81,8 @@ import qualified Data.Bytes.Parser.Unsafe as Unsafe
8281
-- there are functions in @Data.Chunks@ that efficently perform other
8382
-- operations.
8483
data Value
85-
= Object !(Chunks Member)
86-
| Array !(Chunks Value)
84+
= Object !(SmallArray Member)
85+
| Array !(SmallArray Value)
8786
| String {-# UNPACK #-} !ShortText
8887
| Number {-# UNPACK #-} !Scientific
8988
| Null
@@ -124,11 +123,11 @@ data Member = Member
124123

125124
emptyArrayValue :: Value
126125
{-# noinline emptyArrayValue #-}
127-
emptyArrayValue = Array ChunksNil
126+
emptyArrayValue = Array mempty
128127

129128
emptyObjectValue :: Value
130129
{-# noinline emptyObjectValue #-}
131-
emptyObjectValue = Object ChunksNil
130+
emptyObjectValue = Object mempty
132131

133132
isSpace :: Word8 -> Prelude.Bool
134133
{-# inline isSpace #-}
@@ -155,36 +154,28 @@ encode = \case
155154
Null -> BLDR.ascii4 'n' 'u' 'l' 'l'
156155
String s -> BLDR.shortTextJsonString s
157156
Number n -> SCI.builderUtf8 n
158-
Array ys -> case unconsNonempty ys of
159-
(# (# #) | #) -> BLDR.ascii2 '[' ']'
160-
(# | (# x, xs #) #) ->
161-
BLDR.ascii '['
162-
<>
163-
encode (case indexSmallArray# x 0# of {(# z #) -> z})
164-
<>
165-
foldrTail
166-
( \v b -> BLDR.ascii ',' <> encode v <> b
167-
)
168-
( foldr
169-
( \v b -> BLDR.ascii ',' <> encode v <> b
170-
) (BLDR.ascii ']') xs
171-
)
172-
(PM.SmallArray x)
173-
Object ys -> case unconsNonempty ys of
174-
(# (# #) | #) -> BLDR.ascii2 '{' '}'
175-
(# | (# x,xs #) #) ->
176-
BLDR.ascii '{'
177-
<>
178-
encodeMember (case indexSmallArray# x 0# of {(# z #) -> z})
179-
<>
180-
foldrTail
181-
( \mbr b -> BLDR.ascii ',' <> encodeMember mbr <> b
182-
)
183-
( foldr
184-
( \mbr b -> BLDR.ascii ',' <> encodeMember mbr <> b
185-
) (BLDR.ascii '}') xs
186-
)
187-
(PM.SmallArray x)
157+
Array ys -> case PM.sizeofSmallArray ys of
158+
0 -> BLDR.ascii2 '[' ']'
159+
_ ->
160+
let !(# z #) = PM.indexSmallArray## ys 0
161+
in BLDR.ascii '['
162+
<>
163+
encode z
164+
<>
165+
foldrTail
166+
( \v b -> BLDR.ascii ',' <> encode v <> b
167+
) (BLDR.ascii ']') ys
168+
Object ys -> case PM.sizeofSmallArray ys of
169+
0 -> BLDR.ascii2 '{' '}'
170+
_ ->
171+
let !(# z #) = PM.indexSmallArray## ys 0
172+
in BLDR.ascii '{'
173+
<>
174+
encodeMember z
175+
<>
176+
foldrTail
177+
( \v b -> BLDR.ascii ',' <> encodeMember v <> b
178+
) (BLDR.ascii '}') ys
188179

189180
encodeMember :: Member -> BLDR.Builder
190181
encodeMember Member{key,value} =
@@ -203,15 +194,6 @@ foldrTail f z !ary = go 1 where
203194
| (# x #) <- PM.indexSmallArray## ary i
204195
= f x (go (i+1))
205196

206-
-- Get the first non-empty SmallArray from the Chunks.
207-
unconsNonempty :: Chunks a -> (# (# #) | (# SmallArray# a, Chunks a #) #)
208-
{-# inline unconsNonempty #-}
209-
unconsNonempty = go where
210-
go ChunksNil = (# (# #) | #)
211-
go (ChunksCons (PM.SmallArray x) xs) = case sizeofSmallArray# x of
212-
0# -> go xs
213-
_ -> (# | (# x, xs #) #)
214-
215197
-- Precondition: skip over all space before calling this.
216198
-- It will not skip leading space for you. It does
217199
parser :: Char -> Parser SyntaxException s Value
@@ -274,7 +256,8 @@ objectStep !b = do
274256
P.effect (B.push mbr b) >>= objectStep
275257
'}' -> do
276258
!r <- P.effect (B.freeze b)
277-
pure (Object r)
259+
let !arr = Chunks.concat r
260+
pure (Object arr)
278261
_ -> P.fail ExpectedCommaOrRightBracket
279262

280263
-- This eats all the space at the front of the input. There
@@ -315,7 +298,8 @@ arrayStep !b = do
315298
P.effect (B.push val b) >>= arrayStep
316299
']' -> do
317300
!r <- P.effect (B.freeze b)
318-
pure (Array r)
301+
let !arr = Chunks.concat r
302+
pure (Array arr)
319303
_ -> P.fail ExpectedCommaOrRightBracket
320304

321305
c2w :: Char -> Word8
@@ -441,63 +425,153 @@ pattern key :-> value = Member{key,value}
441425
-- | Construct a JSON object with one member.
442426
object1 :: Member -> Value
443427
{-# inline object1 #-}
444-
object1 a = Object (Chunks.singleton a)
428+
object1 a = Object $ runSmallArrayST $ do
429+
dst <- PM.newSmallArray 1 a
430+
PM.unsafeFreezeSmallArray dst
445431

446432
-- | Construct a JSON object with two members.
447433
object2 :: Member -> Member -> Value
448434
{-# inline object2 #-}
449-
object2 a b = Object (Chunks.doubleton a b)
435+
object2 a b = Object $ runSmallArrayST $ do
436+
dst <- PM.newSmallArray 2 a
437+
PM.writeSmallArray dst 1 b
438+
PM.unsafeFreezeSmallArray dst
450439

451440
-- | Construct a JSON object with three members.
452441
object3 :: Member -> Member -> Member -> Value
453442
{-# inline object3 #-}
454-
object3 a b c = Object (Chunks.tripleton a b c)
443+
object3 a b c = Object $ runSmallArrayST $ do
444+
dst <- PM.newSmallArray 3 a
445+
PM.writeSmallArray dst 1 b
446+
PM.writeSmallArray dst 2 c
447+
PM.unsafeFreezeSmallArray dst
455448

456449
-- | Construct a JSON object with four members.
457450
object4 :: Member -> Member -> Member -> Member -> Value
458451
{-# inline object4 #-}
459-
object4 a b c d = Object (Chunks.quadrupleton a b c d)
452+
object4 a b c d = Object $ runSmallArrayST $ do
453+
dst <- PM.newSmallArray 4 a
454+
PM.writeSmallArray dst 1 b
455+
PM.writeSmallArray dst 2 c
456+
PM.writeSmallArray dst 3 d
457+
PM.unsafeFreezeSmallArray dst
460458

461459
-- | Construct a JSON object with five members.
462460
object5 :: Member -> Member -> Member -> Member -> Member -> Value
463461
{-# inline object5 #-}
464-
object5 a b c d e = Object (Chunks.quintupleton a b c d e)
462+
object5 a b c d e = Object $ runSmallArrayST $ do
463+
dst <- PM.newSmallArray 5 a
464+
PM.writeSmallArray dst 1 b
465+
PM.writeSmallArray dst 2 c
466+
PM.writeSmallArray dst 3 d
467+
PM.writeSmallArray dst 4 e
468+
PM.unsafeFreezeSmallArray dst
465469

466470
-- | Construct a JSON object with six members.
467471
object6 :: Member -> Member -> Member -> Member -> Member -> Member -> Value
468472
{-# inline object6 #-}
469-
object6 a b c d e f = Object (Chunks.sextupleton a b c d e f)
473+
object6 a b c d e f = Object $ runSmallArrayST $ do
474+
dst <- PM.newSmallArray 6 a
475+
PM.writeSmallArray dst 1 b
476+
PM.writeSmallArray dst 2 c
477+
PM.writeSmallArray dst 3 d
478+
PM.writeSmallArray dst 4 e
479+
PM.writeSmallArray dst 5 f
480+
PM.unsafeFreezeSmallArray dst
470481

471482
-- | Construct a JSON object with seven members.
472483
object7 :: Member -> Member -> Member -> Member -> Member -> Member -> Member -> Value
473484
{-# inline object7 #-}
474-
object7 a b c d e f g = Object (Chunks.septupleton a b c d e f g)
485+
object7 a b c d e f g = Object $ runSmallArrayST $ do
486+
dst <- PM.newSmallArray 7 a
487+
PM.writeSmallArray dst 1 b
488+
PM.writeSmallArray dst 2 c
489+
PM.writeSmallArray dst 3 d
490+
PM.writeSmallArray dst 4 e
491+
PM.writeSmallArray dst 5 f
492+
PM.writeSmallArray dst 6 g
493+
PM.unsafeFreezeSmallArray dst
475494

476495
-- | Construct a JSON object with nine members.
477496
object8 :: Member -> Member -> Member -> Member -> Member -> Member -> Member -> Member -> Value
478497
{-# inline object8 #-}
479-
object8 a b c d e f g h = Object (Chunks.octupleton a b c d e f g h)
498+
object8 a b c d e f g h = Object $ runSmallArrayST $ do
499+
dst <- PM.newSmallArray 8 a
500+
PM.writeSmallArray dst 1 b
501+
PM.writeSmallArray dst 2 c
502+
PM.writeSmallArray dst 3 d
503+
PM.writeSmallArray dst 4 e
504+
PM.writeSmallArray dst 5 f
505+
PM.writeSmallArray dst 6 g
506+
PM.writeSmallArray dst 7 h
507+
PM.unsafeFreezeSmallArray dst
480508

481509
-- | Construct a JSON object with nine members.
482510
object9 :: Member -> Member -> Member -> Member -> Member -> Member -> Member -> Member -> Member
483511
-> Value
484512
{-# inline object9 #-}
485-
object9 a b c d e f g h i = Object (Chunks.nonupleton a b c d e f g h i)
513+
object9 a b c d e f g h i = Object $ runSmallArrayST $ do
514+
dst <- PM.newSmallArray 9 a
515+
PM.writeSmallArray dst 1 b
516+
PM.writeSmallArray dst 2 c
517+
PM.writeSmallArray dst 3 d
518+
PM.writeSmallArray dst 4 e
519+
PM.writeSmallArray dst 5 f
520+
PM.writeSmallArray dst 6 g
521+
PM.writeSmallArray dst 7 h
522+
PM.writeSmallArray dst 8 i
523+
PM.unsafeFreezeSmallArray dst
486524

487525
-- | Construct a JSON object with ten members.
488526
object10 :: Member -> Member -> Member -> Member -> Member -> Member -> Member -> Member
489527
-> Member -> Member -> Value
490528
{-# inline object10 #-}
491-
object10 a b c d e f g h i j = Object (Chunks.decupleton a b c d e f g h i j)
529+
object10 a b c d e f g h i j = Object $ runSmallArrayST $ do
530+
dst <- PM.newSmallArray 10 a
531+
PM.writeSmallArray dst 1 b
532+
PM.writeSmallArray dst 2 c
533+
PM.writeSmallArray dst 3 d
534+
PM.writeSmallArray dst 4 e
535+
PM.writeSmallArray dst 5 f
536+
PM.writeSmallArray dst 6 g
537+
PM.writeSmallArray dst 7 h
538+
PM.writeSmallArray dst 8 i
539+
PM.writeSmallArray dst 9 j
540+
PM.unsafeFreezeSmallArray dst
492541

493542
-- | Construct a JSON object with eleven members.
494543
object11 :: Member -> Member -> Member -> Member -> Member -> Member -> Member -> Member
495544
-> Member -> Member -> Member -> Value
496545
{-# inline object11 #-}
497-
object11 a b c d e f g h i j k = Object (Chunks.undecupleton a b c d e f g h i j k)
546+
object11 a b c d e f g h i j k = Object $ runSmallArrayST $ do
547+
dst <- PM.newSmallArray 11 a
548+
PM.writeSmallArray dst 1 b
549+
PM.writeSmallArray dst 2 c
550+
PM.writeSmallArray dst 3 d
551+
PM.writeSmallArray dst 4 e
552+
PM.writeSmallArray dst 5 f
553+
PM.writeSmallArray dst 6 g
554+
PM.writeSmallArray dst 7 h
555+
PM.writeSmallArray dst 8 i
556+
PM.writeSmallArray dst 9 j
557+
PM.writeSmallArray dst 10 k
558+
PM.unsafeFreezeSmallArray dst
498559

499560
-- | Construct a JSON object with eleven members.
500561
object12 :: Member -> Member -> Member -> Member -> Member -> Member -> Member -> Member
501562
-> Member -> Member -> Member -> Member -> Value
502563
{-# inline object12 #-}
503-
object12 a b c d e f g h i j k l = Object (Chunks.duodecupleton a b c d e f g h i j k l)
564+
object12 a b c d e f g h i j k l = Object $ runSmallArrayST $ do
565+
dst <- PM.newSmallArray 12 a
566+
PM.writeSmallArray dst 1 b
567+
PM.writeSmallArray dst 2 c
568+
PM.writeSmallArray dst 3 d
569+
PM.writeSmallArray dst 4 e
570+
PM.writeSmallArray dst 5 f
571+
PM.writeSmallArray dst 6 g
572+
PM.writeSmallArray dst 7 h
573+
PM.writeSmallArray dst 8 i
574+
PM.writeSmallArray dst 9 j
575+
PM.writeSmallArray dst 10 k
576+
PM.writeSmallArray dst 11 l
577+
PM.unsafeFreezeSmallArray dst

‎test/Main.hs‎

Lines changed: 7 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -34,27 +34,27 @@ tests = testGroup "Tests"
3434
@=?
3535
J.decode (Bytes.fromAsciiString "{}")
3636
, THU.testCase "B" $
37-
Right (J.Object (Exts.fromList [Exts.fromList [J.Member "foo" J.True]]))
37+
Right (J.Object (Exts.fromList [J.Member "foo" J.True]))
3838
@=?
3939
J.decode (Bytes.fromAsciiString "{\"foo\" : true}")
4040
, THU.testCase "C" $
41-
Right (J.Array (Exts.fromList [Exts.fromList [J.String "bar"]]))
41+
Right (J.Array (Exts.fromList [J.String "bar"]))
4242
@=?
4343
J.decode (Bytes.fromAsciiString "[\"bar\"]")
4444
, THU.testCase "D" $
45-
Right (J.Object (Exts.fromList [Exts.fromList [J.Member "foo" J.True, J.Member "bar" J.False]]))
45+
Right (J.Object (Exts.fromList [J.Member "foo" J.True, J.Member "bar" J.False]))
4646
@=?
4747
J.decode (Bytes.fromAsciiString "{\"foo\" : true, \"bar\": false }")
4848
, THU.testCase "E" $
4949
Right (J.String "Smile: 😂")
5050
@=?
5151
J.decode (shortTextToBytes "\"Smile: 😂\"")
5252
, THU.testCase "F" $
53-
Right (J.Array (Exts.fromList [Exts.fromList [ J.Object mempty, J.Object mempty, J.Null ]]))
53+
Right (J.Array (Exts.fromList [ J.Object mempty, J.Object mempty, J.Null ]))
5454
@=?
5555
J.decode (shortTextToBytes " [ {} , { } , null ] ")
5656
, THU.testCase "G" $ case J.decode (shortTextToBytes " [ 55e2 , 1 ] ") of
57-
Right (J.Array xs) -> case Exts.toList (Chunks.concat xs) of
57+
Right (J.Array xs) -> case Exts.toList xs of
5858
[J.Number a, J.Number b] -> do
5959
SCI.toWord32 a @=? Just 5500
6060
SCI.toWord32 b @=? Just 1
@@ -64,11 +64,11 @@ tests = testGroup "Tests"
6464
Left _ -> pure ()
6565
Right _ -> fail "this was not supposed parse"
6666
, THU.testCase "I" $
67-
BChunks.concat (Builder.run 1 (J.encode (J.Array (ChunksCons mempty ChunksNil))))
67+
BChunks.concat (Builder.run 1 (J.encode (J.Array mempty)))
6868
@=?
6969
Bytes.fromLatinString "[]"
7070
, THU.testCase "J" $
71-
BChunks.concat (Builder.run 1 (J.encode (J.Array ChunksNil)))
71+
BChunks.concat (Builder.run 1 (J.encode (J.Array mempty)))
7272
@=?
7373
Bytes.fromLatinString "[]"
7474
, THU.testCase "Twitter100" $

0 commit comments

Comments
 (0)