2011/11/27 Vok Vojwo <[email protected]>:
> The json-abnf module creates some strange results for booleans:
>
> (use json-abnf)
> (pp (parser "{\"str\":\"a\",\"true\":true,\"false\":false}"))
>
> prints:
>
> (object ("str" "a") ("true" (#t)) ("false"))
>
> true is a list and false is '().
>
I think the attached patch fixes the problem.
It does some additional changes:
- parser renamed to parse-json
- object tagging removed
- key value pairs stored as pairs instead of lists
- null as symbol null instead of empty list
I think it is now compatible to Medea.
--- json-abnf.orig/json-abnf.scm 2011-11-27 21:14:06.000000000 +0100
+++ json-abnf/json-abnf.scm 2011-11-27 22:25:51.000000000 +0100
@@ -26,7 +26,7 @@
(module json-abnf
- (parser)
+ (parse-json)
(import scheme chicken data-structures srfi-1 srfi-14)
@@ -35,7 +35,6 @@
(prefix abnf-consumers abnf:)
)
-
;; helper macro for mutually-recursive parser definitions
(define-syntax vac
@@ -53,7 +52,6 @@
((_ p) (abnf:bind consumed-chars->number p))
))
-
(define escaped-char->control-char
(abnf:consumed-chars->list
(lambda (x)
@@ -64,27 +62,24 @@
((#\r) #\return )
((#\t) #\tab )
(else (car x))))))
-
(define-syntax bind-consumed->control-char
(syntax-rules ()
((_ p) (abnf:bind escaped-char->control-char p))
))
-
(define consumed-chars->char-code
(abnf:consumed-chars->list
(compose (lambda (x) (integer->char (string->number x 16)))
list->string)))
-
(define-syntax bind-consumed->char-code
(syntax-rules ()
((_ p) (abnf:bind consumed-chars->char-code p))
))
(define (value? x) (or (string? x) (number? x) (boolean? x)
- (vector? x) (list? x)))
+ (vector? x) (pair? x) (symbol? x)))
(define consumed-values (abnf:consumed-objects value?))
(define consumed-values->list
@@ -97,6 +92,16 @@
((_ p) (abnf:bind (consumed-values->list) p))
))
+(define consumed-values->pair
+ ((abnf:consumed-objects-lift consumed-values)
+ (lambda (l)
+ (cons (car l) (cadr l)))))
+
+(define-syntax bind-consumed-values->pair
+ (syntax-rules ()
+ ((_ p) (abnf:bind consumed-values->pair p))
+ ))
+
;; construct vectors from consumed values
(define consumed-values->vector
((abnf:consumed-objects-lift consumed-values)
@@ -125,21 +130,21 @@
(abnf:alternatives
false null true number p-string object array)))
+(define true
+ (abnf:bind
+ (lambda x (list #t))
+ (abnf:lit "true")))
+
(define false
(abnf:bind
- (abnf:consumed-chars->list (lambda x #f))
+ (lambda x (list #f))
(abnf:lit "false")))
(define null
(abnf:bind
- (abnf:consumed-chars->list (lambda x '()))
+ (lambda x (list 'null))
(abnf:lit "null")))
-(define true
- (abnf:bind
- (abnf:consumed-chars->list (lambda x (list #t)))
- (abnf:lit "true")))
-
(define escaped
(abnf:concatenation
(abnf:drop-consumed (abnf:char #\\))
@@ -151,7 +156,6 @@
(bind-consumed->char-code
(abnf:repetition-n 4 abnf:hexadecimal)))
)))
-
(define char
(abnf:alternatives
@@ -162,8 +166,6 @@
(ucs-range->char-set #x5D #x10FFFF)))
escaped))
-
-
(define p-string
(abnf:alternatives
(abnf:bind-consumed->string
@@ -173,8 +175,6 @@
(abnf:drop-consumed (abnf:char #\"))))
(abnf:bind (lambda (x) (list "")) (abnf:concatenation (abnf:char #\") (abnf:char #\")))
))
-
-
(define number
(let* ((digit (abnf:range #\0 #\9))
@@ -201,18 +201,16 @@
significand
(abnf:optional-sequence exp))))))
-
(define p-member
- (bind-consumed-values->list
+ (bind-consumed-values->pair
(abnf:concatenation
p-string
name-separator
value
)))
-
(define object
- (bind-consumed-values->list 'object
+ (bind-consumed-values->list
(abnf:concatenation
(abnf:drop-consumed begin-object)
(abnf:optional-sequence
@@ -224,7 +222,6 @@
p-member))))
(abnf:drop-consumed end-object))))
-
(define array
(bind-consumed-values->vector
(abnf:concatenation
@@ -238,23 +235,18 @@
value ) )))
(abnf:drop-consumed end-array))))
-
-
(define JSON-text
(abnf:alternatives object array))
-
(define (->char-list s)
(if (string? s) (string->list s) s))
-
(define (err s)
(print "JSON parser error on stream: " s)
`(error))
-
-(define parser
+(define parse-json
(lambda (s)
(JSON-text caar err `(() ,(->char-list s)))))
-)
\ Kein Zeilenumbruch am Dateiende.
+)
_______________________________________________
Chicken-users mailing list
[email protected]
https://lists.nongnu.org/mailman/listinfo/chicken-users
