Merge branch 'master' of git://repo.or.cz/factor/jcg

extra/json/reader/reader-tests.factor

@@ -0,0 +1,43 @@
+USING: arrays json.reader kernel multiline strings tools.test ;
+IN: json.reader.tests
+
+{ f } [ "false" json> ] unit-test
+{ t } [ "true" json> ] unit-test
+{ json-null } [ "null" json> ] unit-test
+{ 0 } [ "0" json> ] unit-test
+{ 102 } [ "102" json> ] unit-test
+{ -102 } [ "-102" json> ] unit-test
+{ 102 } [ "+102" json> ] unit-test
+{ 102.0 } [ "102.0" json> ] unit-test
+{ 102.5 } [ "102.5" json> ] unit-test
+{ 102.5 } [ "102.50" json> ] unit-test
+{ -10250 } [ "-102.5e2" json> ] unit-test
+{ -10250 } [ "-102.5E+2" json> ] unit-test
+{ 10.25 } [ "1025e-2" json> ] unit-test
+{ 0.125 } [ "0.125" json> ] unit-test
+{ -0.125 } [ "-0.125" json> ] unit-test
+
+{ " fuzzy  pickles " } [ <" " fuzzy  pickles " "> json> ] unit-test
+{ "while 1:\n\tpass" } [ <" "while 1:\n\tpass" "> json> ] unit-test
+{ 8 9 10 12 13 34 47 92 } >string 1array [ <" "\b\t\n\f\r\"\/\\" "> json> ] unit-test
+{ HEX: abcd } >string 1array [ <" "\uaBCd" "> json> ] unit-test
+
+{ { 1 "two" 3.0 } } [ <" [1, "two", 3.0] "> json> ] unit-test
+{ H{ { "US$" 1.0 } { "EU€" 1.5 } } } [ <" { "US$":1.00, "EU\u20AC":1.50 } "> json> ] unit-test
+{ H{
+    { "fib" { 1 1 2 3 5 8 H{ { "etc" "etc" } } } }
+    { "prime" { 2 3 5 7 11 13 } }
+} } [ <" {
+    "fib": [1, 1,  2,   3,     5,         8,
+        { "etc":"etc" } ],
+    "prime":
+    [ 2,3,     5,7,
+11,
+13
+]      }
+"> json> ] unit-test
+
+{ 0 } [ "      0" json> ] unit-test
+{ 0 } [ "0      " json> ] unit-test
+{ 0 } [ "   0   " json> ] unit-test
+

extra/json/reader/reader.factor

@@ -7,6 +7,8 @@ IN: json.reader
 
 ! Grammar for JSON from RFC 4627
 
+SYMBOL: json-null
+
 : [<&>] ( quot -- quot )
   { } make unclip [ <&> ] reduce ;
 
@@ -17,8 +19,7 @@ LAZY: 'ws' ( -- parser )
   " " token 
   "\n" token <|>
   "\r" token <|>
-  "\t" token <|> 
+  "\t" token <|> <*> ;
-  "" token <|> ;
 
 LAZY: spaced ( parser -- parser )
   'ws' swap &> 'ws' <& ;
@@ -42,24 +43,39 @@ LAZY: 'value-separator' ( -- parser )
   "," token spaced ;
 
 LAZY: 'false' ( -- parser )
-  "false" token ;
+  "false" token [ drop f ] <@ ;
 
 LAZY: 'null' ( -- parser )
-  "null" token ;
+  "null" token [ drop json-null ] <@ ;
 
 LAZY: 'true' ( -- parser )
-  "true" token ;
+  "true" token [ drop t ] <@ ;
 
 LAZY: 'quot' ( -- parser )
   "\"" token ;
 
+LAZY: 'hex-digit' ( -- parser )
+  [ digit> ] satisfy [ digit> ] <@ ;
+
+: hex-digits>ch ( digits -- ch )
+    0 [ swap 16 * + ] reduce ;
+
+LAZY: 'string-char' ( -- parser )
+  [ quotable? ] satisfy
+  "\\b" token [ drop 8 ] <@ <|>
+  "\\t" token [ drop CHAR: \t ] <@ <|>
+  "\\n" token [ drop CHAR: \n ] <@ <|>
+  "\\f" token [ drop 12 ] <@ <|>
+  "\\r" token [ drop CHAR: \r ] <@ <|>
+  "\\\"" token [ drop CHAR: " ] <@ <|>
+  "\\/" token [ drop CHAR: / ] <@ <|>
+  "\\\\" token [ drop CHAR: \\ ] <@ <|>
+  "\\u" token 'hex-digit' 4 exactly-n &>
+  [ hex-digits>ch ] <@ <|> ;
+
 LAZY: 'string' ( -- parser )
   'quot' 
-  [ 
+  'string-char' <*> &> 
-    [ quotable? ] keep
-    [ CHAR: \\ = or ] keep 
-    CHAR: " = not and 
-  ] satisfy <*> &> 
   'quot' <& [ >string ] <@  ;
 
 DEFER: 'value'
@@ -86,6 +102,9 @@ LAZY: 'minus' ( -- parser )
 LAZY: 'plus' ( -- parser )
   "+" token ;
 
+LAZY: 'sign' ( -- parser )
+  'minus' 'plus' <|> ;
+
 LAZY: 'zero' ( -- parser )
   "0" token [ drop 0 ] <@ ;
 
@@ -116,11 +135,11 @@ LAZY: 'e' ( -- parser )
 : sign-number ( pair -- number )
   #! Pair is { minus? num }
   #! Convert the json number value to a factor number
-  dup second swap first [ -1 * ] when ;
+  dup second swap first [ first "-" = [ -1 * ] when ] when* ;
 
 LAZY: 'exp' ( -- parser )
     'e' 
-    'minus' 'plus' <|> <?> &>
+    'sign' <?> &>
     'digit0-9' <+> [ decimal>integer ] <@ <&> [ sign-number ] <@ ;
 
 : sequence>frac ( seq -- num ) 
@@ -136,7 +155,7 @@ LAZY: 'frac' ( -- parser )
   dup second dup [ 10 swap first ^ swap first * ] [ drop first ] if ;
 
 LAZY: 'number' ( -- parser )
-  'minus' <?>
+  'sign' <?>
   [ 'int' , 'frac' 0 succeed <|> , ] [<&>] [ sum ] <@ 
   'exp' <?> <&> [ raise-to-power ] <@ <&> [ sign-number ] <@ ;
 
@@ -149,7 +168,7 @@ LAZY: 'value' ( -- parser )
     'object' ,
     'array' ,
     'number' ,
-  ] [<|>] ;
+  ] [<|>] spaced ;
 
 : json> ( string -- object )
   #! Parse a json formatted string to a factor object