steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

json.reader: cleanup and speed up when handling heavily escaped strings.

db4
John Benediktsson 2011-09-15 07:59:17 -07:00
parent 27e0071105
commit 4726757d95
1 changed files with 43 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

66
basis/json/reader/reader.factor
View File

@ -1,19 +1,22 @@
! Copyright (C) 2008 Peter Burns, 2009 Philipp Winkler ! Copyright (C) 2008 Peter Burns, 2009 Philipp Winkler
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays assocs combinators io io.streams.string json
kernel math math.parser prettyprint sequences strings vectors ; USING: arrays assocs combinators hashtables io io.streams.string
json kernel make math math.parser prettyprint sequences strings
vectors ;
IN: json.reader IN: json.reader
<PRIVATE <PRIVATE
: value ( char -- num char ) : value ( char -- num char )
1string " \t\r\n,:}]" read-until 1string " \t\r\n,:}]" read-until
[ append string>number ] dip ; [ append string>number ] dip ;
DEFER: j-string DEFER: j-string%
: convert-string ( str -- str ) : j-escape% ( -- )
read1 read1 {
{
{ CHAR: b [ 8 ] } { CHAR: b [ 8 ] }
{ CHAR: f [ 12 ] } { CHAR: f [ 12 ] }
{ CHAR: n [ CHAR: \n ] } { CHAR: n [ CHAR: \n ] }
@ -21,55 +24,41 @@ DEFER: j-string
{ CHAR: t [ CHAR: \t ] } { CHAR: t [ CHAR: \t ] }
{ CHAR: u [ 4 read hex> ] } { CHAR: u [ 4 read hex> ] }
[ ] [ ]
} case } case [ , j-string% ] when* ;
dup
[ 1string append j-string append ] : j-string% ( -- )
[ drop ] if ; "\\\"" read-until [ % ] dip
CHAR: \" = [ j-escape% ] unless ;
: j-string ( -- str ) : j-string ( -- str )
"\\\"" read-until CHAR: \" = "\\\"" read-until CHAR: \" =
[ convert-string ] unless ; [ [ % j-escape% ] "" make ] unless ;
: second-last ( seq -- second-last ) : second-last ( seq -- second-last )
[ length 2 - ] keep nth ; inline [ length 2 - ] [ nth ] bi ; inline
: third-last ( seq -- third-last ) ERROR: json-error ;
[ length 3 - ] keep nth ; inline
: last2 ( seq -- second-last last ) : check-length ( seq n -- seq )
[ second-last ] [ last ] bi ; inline [ dup length ] [ >= ] bi* [ json-error ] unless ;
: last3 ( seq -- third-last second-last last )
[ third-last ] [ last2 ] bi ; inline
: v-over-push ( vec -- vec' ) : v-over-push ( vec -- vec' )
dup length 2 >= 2 check-length dup [ pop ] [ last ] bi push ;
[
dup
[ pop ]
[ last ] bi push
] when ;
: v-pick-push ( vec -- vec' ) : v-pick-push ( vec -- vec' )
dup length 3 >= 3 check-length dup [ pop ] [ second-last ] bi push ;
[
dup : (close) ( accum -- accum' )
[ pop ] dup last V{ } = not [ v-over-push ] when ;
[ second-last ] bi push
] when ;
: (close-array) ( accum -- accum' ) : (close-array) ( accum -- accum' )
dup last vector? [ v-over-push ] unless (close) dup pop >array over push ;
dup pop >array over push ;
: (close-hash) ( accum -- accum' ) : (close-hash) ( accum -- accum' )
dup [ length 3 >= ] [ last V{ } = not ] bi@ and [ v-over-push ] when (close) dup dup [ pop ] bi@ swap zip >hashtable over push ;
dup dup [ pop ] bi@ swap
zip H{ } assoc-clone-like over push ;
: scan ( accum char -- accum ) : scan ( accum char -- accum )
! 2dup 1string swap . . ! Great for debug... ! 2dup 1string swap . . ! Great for debug...
[
{ {
{ CHAR: \" [ j-string over push ] } { CHAR: \" [ j-string over push ] }
{ CHAR: [ [ V{ } clone over push ] } { CHAR: [ [ V{ } clone over push ] }
@ -86,8 +75,7 @@ DEFER: j-string
{ CHAR: f [ 4 read drop f over push ] } { CHAR: f [ 4 read drop f over push ] }
{ CHAR: n [ 3 read drop json-null over push ] } { CHAR: n [ 3 read drop json-null over push ] }
[ value [ over push ] dip [ scan ] when* ] [ value [ over push ] dip [ scan ] when* ]
} case } case ;
] when* ;
PRIVATE> PRIVATE>