diff options
| -rw-r--r-- | json.asd | 3 | ||||
| -rw-r--r-- | json.lisp | 48 |
2 files changed, 34 insertions, 17 deletions
@@ -1,6 +1,7 @@ (asdf:defsystem #:json :serial t - :depends-on (#:monparser) + :depends-on (#:utils + #:monparser) :components ((:file "package") (:file "json"))) @@ -19,7 +19,9 @@ (either signed-digits (fail "Malformed exponent part.")) nothing))) - (list 'number base fraction exponent)))) + (read-from-string + (str:from-list + (remove nil (append base (cons dot fraction) (cons e exponent)))))))) (defparameter string-literal (comp ((_ (unit (lambda (x) (char= x #\")))) @@ -30,11 +32,14 @@ (cp1 (unit #'digit-char-p)) (cp2 (unit #'digit-char-p)) (cp3 (unit #'digit-char-p))) - (let ((str (make-string 4))) - (setf (char str 0) cp0) - (setf (char str 1) cp1) - (setf (char str 2) cp2) - (setf (char str 3) cp3) + (let ((str (make-string 7))) + (setf (char str 0) #\#) + (setf (char str 1) #\\) + (setf (char str 2) #\u) + (setf (char str 3) cp0) + (setf (char str 4) cp1) + (setf (char str 5) cp2) + (setf (char str 6) cp3) str)) nothing))) (case escaped @@ -43,11 +48,12 @@ (#\t #\Tab) (#\u - codepoints) + (read-from-string codepoints)) (t escaped))) - (unit (lambda (x) (char/= x #\")))))) + (unit (lambda (x) (and (char/= x #\") + (char/= x #\\))))))) (_ (unit (lambda (x) (char= x #\"))))) - (list 'string chars))) + (str:from-list chars))) (defparameter whitespace (comp ((_ (zero-or-more (unit (lambda (x) (or (char= x #\Space) @@ -89,9 +95,11 @@ vi)) nothing)) (_ (unit (lambda (x) (char= x #\]))))) - (if vn - (list 'array (cons v0 vn)) - (list 'array v0)))) + (if v0 + (if vn + (cons v0 vn) + (list v0)) + 'empty-array))) (defparameter json-object (let ((json-pair @@ -100,7 +108,7 @@ (_ whitespace) (_ (unit (lambda (x) (char= x #\:)))) (v json-value)) - (list 'pair k v)))) + (cons k v)))) (comp ((_ (unit (lambda (x) (char= x #\{)))) (v0 (either json-pair whitespace)) @@ -110,9 +118,17 @@ vi)) nothing)) (_ (unit (lambda (x) (char= x #\}))))) - (if vn - (list 'object (cons v0 vn)) - (list 'object v0))))) + (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)) + 'empty-object)))) (setf json-value (comp ((_ whitespace) |