From 4726757d95cc6c32164170cd3d564b9efe7cdc5f Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Thu, 15 Sep 2011 07:59:17 -0700
Subject: [PATCH] json.reader: cleanup and speed up when handling heavily
 escaped strings.

---
 basis/json/reader/reader.factor | 98 +++++++++++++++------------------
 1 file changed, 43 insertions(+), 55 deletions(-)

diff --git a/basis/json/reader/reader.factor b/basis/json/reader/reader.factor
index f684321846..95b851d5f7 100644
--- a/basis/json/reader/reader.factor
+++ b/basis/json/reader/reader.factor
@@ -1,19 +1,22 @@
 ! Copyright (C) 2008 Peter Burns, 2009 Philipp Winkler
 ! 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
 
 <PRIVATE
+
 : value ( char -- num char )
     1string " \t\r\n,:}]" read-until
     [ append string>number ] dip ;
 
-DEFER: j-string
+DEFER: j-string%
 
-: convert-string ( str -- str )
-    read1
-    {
+: j-escape% ( -- )
+    read1 {
         { CHAR: b [ 8 ] }
         { CHAR: f [ 12 ] }
         { CHAR: n [ CHAR: \n ] }
@@ -21,73 +24,58 @@ DEFER: j-string
         { CHAR: t [ CHAR: \t ] }
         { CHAR: u [ 4 read hex> ] }
         [ ]
-    } case
-    dup
-    [ 1string append j-string append ]
-    [ drop ] if ;
+    } case [ , j-string% ] when* ;
+
+: j-string% ( -- )
+    "\\\"" read-until [ % ] dip
+    CHAR: \" = [ j-escape% ] unless ;
 
 : j-string ( -- str )
     "\\\"" read-until CHAR: \" =
-    [ convert-string ] unless ;
+    [ [ % j-escape% ] "" make ] unless ;
 
 : second-last ( seq -- second-last )
-    [ length 2 - ] keep nth ; inline
+    [ length 2 - ] [ nth ] bi ; inline
 
-: third-last ( seq -- third-last )
-    [ length 3 - ] keep nth ; inline
+ERROR: json-error ;
 
-: last2 ( seq -- second-last last )
-    [ second-last ] [ last ] bi ; inline
-
-: last3 ( seq -- third-last second-last last )
-    [ third-last ] [ last2 ] bi ; inline
+: check-length ( seq n -- seq )
+    [ dup length ] [ >= ] bi* [ json-error ] unless ;
 
 : v-over-push ( vec -- vec' )
-    dup length 2 >=
-    [
-        dup
-        [ pop ]
-        [ last ] bi push
-    ] when ;
+    2 check-length dup [ pop ] [ last ] bi push ;
 
 : v-pick-push ( vec -- vec' )
-    dup length 3 >=
-    [
-        dup
-        [ pop ]
-        [ second-last ] bi push
-    ] when ;
+    3 check-length dup [ pop ] [ second-last ] bi push ;
+
+: (close) ( accum -- accum' )
+    dup last V{ } = not [ v-over-push ] when ;
 
 : (close-array) ( accum -- accum' )
-    dup last vector? [ v-over-push ] unless
-    dup pop >array over push ;
+    (close) dup pop >array over push ;
 
 : (close-hash) ( accum -- accum' )
-    dup [ length 3 >= ] [ last V{ } = not ] bi@ and [ v-over-push ] when
-    dup dup [ pop ] bi@ swap
-    zip H{ } assoc-clone-like over push ;
+    (close) dup dup [ pop ] bi@ swap zip >hashtable over push ;
 
 : scan ( accum char -- accum )
     ! 2dup 1string swap . . ! Great for debug...
-    [
-        {
-            { CHAR: \" [ j-string over push ] }
-            { CHAR: [  [ V{ } clone over push ] }
-            { CHAR: ,  [ v-over-push ] }
-            { CHAR: ]  [ (close-array) ] }
-            { CHAR: {  [ 2 [ V{ } clone over push ] times ] }
-            { CHAR: :  [ v-pick-push ] }
-            { CHAR: }  [ (close-hash) ] }
-            { CHAR: \s [ ] }
-            { CHAR: \t [ ] }
-            { CHAR: \r [ ] }
-            { CHAR: \n [ ] }
-            { CHAR: t  [ 3 read drop t over push ] }
-            { CHAR: f  [ 4 read drop f over push ] }
-            { CHAR: n  [ 3 read drop json-null over push ] }
-            [ value [ over push ] dip [ scan ] when*  ]
-        } case
-    ] when* ;
+    {
+        { CHAR: \" [ j-string over push ] }
+        { CHAR: [  [ V{ } clone over push ] }
+        { CHAR: ,  [ v-over-push ] }
+        { CHAR: ]  [ (close-array) ] }
+        { CHAR: {  [ 2 [ V{ } clone over push ] times ] }
+        { CHAR: :  [ v-pick-push ] }
+        { CHAR: }  [ (close-hash) ] }
+        { CHAR: \s [ ] }
+        { CHAR: \t [ ] }
+        { CHAR: \r [ ] }
+        { CHAR: \n [ ] }
+        { CHAR: t  [ 3 read drop t over push ] }
+        { CHAR: f  [ 4 read drop f over push ] }
+        { CHAR: n  [ 3 read drop json-null over push ] }
+        [ value [ over push ] dip [ scan ] when*  ]
+    } case ;
 
 PRIVATE>