diff options
Diffstat (limited to 'json.lisp')
| -rw-r--r-- | json.lisp | 79 |
1 files changed, 34 insertions, 45 deletions
@@ -6,8 +6,7 @@ (char= x #\+)))))) (natural (one-or-more (unit #'digit-char-p)))) (cons sign natural)))) - (comp ((base (either signed-digits - (fail "Malformed number."))) + (comp ((base signed-digits) (dot (zero-or-one (unit (lambda (x) (char= x #\.))))) (fraction (if dot (either (one-or-more (unit #'digit-char-p)) @@ -52,7 +51,8 @@ (t escaped))) (unit (lambda (x) (and (char/= x #\") (char/= x #\\))))))) - (_ (unit (lambda (x) (char= x #\"))))) + (_ (either (unit (lambda (x) (char= x #\"))) + (fail "String is not properly closed.")))) (str:from-list chars))) (defparameter whitespace @@ -85,62 +85,51 @@ (defvar json-value) +(defun separated-list (value-type separator) + (comp ((v value-type) + (sep (zero-or-one (unit (lambda (x) (char= separator x))))) + (vn (if sep + (either (separated-list value-type separator) + (fail "Expected another value.")) + nothing))) + (cons v vn))) + (defparameter json-array (comp ((_ (unit (lambda (x) (char= x #\[)))) - (v0 (either json-value - whitespace)) - (vn (if v0 - (zero-or-more (comp ((_ (unit (lambda (x) (char= #\,)))) - (vi json-value)) - vi)) - nothing)) + (vn (zero-or-one (separated-list json-value #\,))) (_ (unit (lambda (x) (char= x #\]))))) - (if v0 - (if vn - (cons v0 vn) - (list v0)) - nil))) + (apply #'vector vn))) (defparameter json-object (let ((json-pair (comp ((_ whitespace) - (k string-literal) + (k (either string-literal + (fail "Expected a string."))) (_ whitespace) - (_ (unit (lambda (x) (char= x #\:)))) + (_ (either (unit (lambda (x) (char= x #\:))) + (fail "Expected a \":\""))) (v json-value)) (cons k v)))) (comp ((_ (unit (lambda (x) (char= x #\{)))) - (v0 (either json-pair - whitespace)) - (vn (if v0 - (zero-or-more (comp ((_ (unit (lambda (x) (char= #\,)))) - (vi json-pair)) - vi)) - nothing)) + (vn (zero-or-one (separated-list json-pair #\,))) (_ (unit (lambda (x) (char= x #\}))))) - (if v0 - (if vn - (let* ((vlist (cons v0 vn)) - (obj (make-hash-table :test #'equal :size (length vlist)))) - (dolist (v vlist) - (setf (gethash (car v) obj) (cdr v))) - obj) - (let ((obj (make-hash-table :test #'equal))) - (setf (gethash (car v0) obj) (cdr v0)) - obj)) - (make-hash-table :test #'equal))))) + (let* ((vlist vn) + (obj (make-hash-table :test #'equal :size (length vlist)))) + (dolist (v vlist) + (setf (gethash (car v) obj) (cdr v))) + obj)))) (setf json-value - (comp ((_ whitespace) - (v (either number-literal - string-literal - json-array - json-object - true-symbol - false-symbol - null-symbol)) - (_ whitespace)) - v)) + (comp ((_ whitespace) + (v (either number-literal + string-literal + json-object + json-array + true-symbol + false-symbol + null-symbol)) + (_ whitespace)) + v)) (defun parse-string (str) (run json-value (input:from-string str))) |