diff --git a/basis/json/reader/reader.factor b/basis/json/reader/reader.factor index 8ebe2ee67f..4990bc16ab 100644 --- a/basis/json/reader/reader.factor +++ b/basis/json/reader/reader.factor @@ -1,66 +1,77 @@ ! Copyright (C) 2008 Peter Burns, 2009 Philipp Winkler ! See http://factorcode.org/license.txt for BSD license. -USING: arrays assocs combinators fry hashtables io -io.streams.string json kernel make math math.parser namespaces -prettyprint sequences strings vectors ; +USING: accessors arrays assocs combinators fry hashtables io +io.streams.string json kernel kernel.private make math +math.parser namespaces prettyprint sequences sequences.private +strings vectors ; IN: json.reader number ] dip ; DEFER: j-string% -: j-escape% ( -- ) - read1 { +: j-escape% ( stream -- ) + dup stream-read1 { { CHAR: b [ 8 ] } { CHAR: f [ 12 ] } { CHAR: n [ CHAR: \n ] } { CHAR: r [ CHAR: \r ] } { CHAR: t [ CHAR: \t ] } - { CHAR: u [ 4 read hex> ] } + { CHAR: u [ 4 over stream-read hex> ] } [ ] - } case [ , j-string% ] when* ; + } case [ , j-string% ] [ drop ] if* ; -: j-string% ( -- ) - "\\\"" read-until [ % ] dip - CHAR: \" = [ j-escape% ] unless ; +: j-string% ( stream -- ) + "\\\"" over stream-read-until [ % ] dip + CHAR: \" = [ drop ] [ j-escape% ] if ; -: j-string ( -- str ) - "\\\"" read-until CHAR: \" = - [ [ % j-escape% ] "" make ] unless ; +: j-string ( stream -- str ) + "\\\"" over stream-read-until CHAR: \" = + [ nip ] [ [ % j-escape% ] "" make ] if ; -: second-last ( seq -- second-last ) - [ length 2 - ] [ nth ] bi ; inline +: second-last-unsafe ( seq -- second-last ) + [ length 2 - ] [ nth-unsafe ] bi ; inline + +: pop-unsafe ( seq -- elt ) + [ length 1 - ] keep [ nth-unsafe ] [ shorten ] 2bi ; inline ERROR: json-error ; : check-length ( seq n -- seq ) - [ dup length ] [ >= ] bi* [ json-error ] unless ; + [ dup length ] [ >= ] bi* [ json-error ] unless + { vector } declare ; inline : v-over-push ( vec -- vec' ) - 2 check-length dup [ pop ] [ last ] bi push ; + 2 check-length dup [ pop-unsafe ] [ last-unsafe ] bi + push ; : v-pick-push ( vec -- vec' ) - 3 check-length dup [ pop ] [ second-last ] bi push ; + 3 check-length dup [ pop-unsafe ] [ second-last-unsafe ] bi + push ; : (close) ( accum -- accum' ) + { vector } declare dup last V{ } = not [ v-over-push ] when ; : (close-array) ( accum -- accum' ) + { vector } declare (close) dup pop >array suffix! ; : (close-hash) ( accum -- accum' ) - (close) dup dup [ pop ] bi@ swap zip >hashtable suffix! ; + { vector } declare + (close) dup dup [ pop ] bi@ 2dup min-length + [ [ set-at ] curry 2each ] keep suffix! ; -: scan ( accum char -- accum ) +: scan ( stream accum char -- stream accum ) ! 2dup 1string swap . . ! Great for debug... { - { CHAR: \" [ j-string suffix! ] } + { CHAR: \" [ over j-string suffix! ] } { CHAR: [ [ V{ } clone suffix! ] } { CHAR: , [ v-over-push ] } { CHAR: ] [ (close-array) ] } @@ -71,17 +82,20 @@ ERROR: json-error ; { CHAR: \t [ ] } { CHAR: \r [ ] } { CHAR: \n [ ] } - { CHAR: t [ 3 read drop t suffix! ] } - { CHAR: f [ 4 read drop f suffix! ] } - { CHAR: n [ 3 read drop json-null suffix! ] } - [ value [ suffix! ] dip [ scan ] when* ] + { CHAR: t [ 3 pick stream-read drop t suffix! ] } + { CHAR: f [ 4 pick stream-read drop f suffix! ] } + { CHAR: n [ 3 pick stream-read drop json-null suffix! ] } + [ pick value [ suffix! ] dip [ scan ] when* ] } case ; +: stream-json-read ( stream -- objects ) + V{ } clone over '[ _ stream-read1 dup ] + [ scan ] while drop nip ; + PRIVATE> : read-jsons ( -- objects ) - V{ } clone input-stream get - '[ _ stream-read1 dup ] [ scan ] while drop ; + input-stream get stream-json-read ; : json> ( string -- object ) [ read-jsons first ] with-string-reader ; diff --git a/basis/json/writer/writer.factor b/basis/json/writer/writer.factor index 165bd86387..df02e43608 100644 --- a/basis/json/writer/writer.factor +++ b/basis/json/writer/writer.factor @@ -6,41 +6,45 @@ prettyprint hashtables mirrors tr json fry combinators ; IN: json.writer #! Writes the object out to a stream in JSON format -GENERIC: json-print ( obj -- ) +GENERIC# stream-json-print 1 ( obj stream -- ) + +: json-print ( obj -- ) + output-stream get stream-json-print ; : >json ( obj -- string ) #! Returns a string representing the factor object in JSON format [ json-print ] with-string-writer ; -M: f json-print ( f -- ) - drop "false" write ; +M: f stream-json-print + [ drop "false" ] [ stream-write ] bi* ; -M: t json-print ( t -- ) - drop "true" write ; +M: t stream-json-print + [ drop "true" ] [ stream-write ] bi* ; -M: json-null json-print ( null -- ) - drop "null" write ; +M: json-null stream-json-print + [ drop "null" ] [ stream-write ] bi* ; -M: string json-print ( obj -- ) - CHAR: " write1 [ +M: string stream-json-print + CHAR: " over stream-write1 swap [ { - { CHAR: " [ "\\\"" write ] } + { CHAR: " [ "\\\"" over stream-write ] } { CHAR: \r [ ] } - { CHAR: \n [ "\\r\\n" write ] } - [ write1 ] + { CHAR: \n [ "\\r\\n" over stream-write ] } + [ over stream-write1 ] } case - ] each CHAR: " write1 ; + ] each CHAR: " swap stream-write1 ; -M: integer json-print ( num -- ) - number>string write ; +M: integer stream-json-print + [ number>string ] [ stream-write ] bi* ; -M: real json-print ( num -- ) - >float number>string write ; +M: real stream-json-print + [ >float number>string ] [ stream-write ] bi* ; -M: sequence json-print ( array -- ) - CHAR: [ write1 [ - [ CHAR: , write1 ] [ json-print ] interleave - ] unless-empty CHAR: ] write1 ; +M: sequence stream-json-print + CHAR: [ over stream-write1 swap [ + over '[ CHAR: , _ stream-write1 ] + pick '[ _ stream-json-print ] interleave + ] unless-empty CHAR: ] swap stream-write1 ; SYMBOL: jsvar-encode? t jsvar-encode? set-global @@ -48,31 +52,33 @@ TR: jsvar-encode "-" "_" ; alist [ +: json-print-assoc ( assoc stream -- ) + CHAR: { over stream-write1 swap >alist [ jsvar-encode? get [ - [ CHAR: , write1 ] - [ + over '[ CHAR: , _ stream-write1 ] + pick dup '[ first2 - [ jsvar-encode json-print ] - [ CHAR: : write1 json-print ] + [ jsvar-encode _ stream-json-print ] + [ _ CHAR: : over stream-write1 stream-json-print ] bi* ] interleave ] [ - [ CHAR: , write1 ] - [ + over '[ CHAR: , _ stream-write1 ] + pick dup '[ first2 - [ json-print ] - [ CHAR: : write1 json-print ] + [ _ stream-json-print ] + [ _ CHAR: : over stream-write1 stream-json-print ] bi* ] interleave ] if - ] unless-empty CHAR: } write1 ; + ] unless-empty CHAR: } swap stream-write1 ; PRIVATE> -M: tuple json-print ( tuple -- ) json-print-assoc ; +M: tuple stream-json-print + [ ] dip json-print-assoc ; -M: hashtable json-print ( hashtable -- ) json-print-assoc ; +M: hashtable stream-json-print json-print-assoc ; -M: word json-print name>> json-print ; +M: word stream-json-print + [ name>> ] dip stream-json-print ;