diff options
Diffstat (limited to 'json.lisp')
| -rw-r--r-- | json.lisp | 126 |
1 files changed, 50 insertions, 76 deletions
@@ -1,29 +1,21 @@ (in-package #:json) -(defun the-char (c) - (unit (lambda (x) (char= c x)))) - -(defun some-char (&rest char-list) - (unit (lambda (x) (find x char-list)))) - -(defun not-these-chars (&rest char-list) - (unit (lambda (x) (not (find x char-list))))) - (defparameter number-literal (let ((signed-digits - (comp ((sign (zero-or-one (some-char #\- #\+))) + (comp ((sign (optional (either (unit #\-) + (unit #\+)))) (natural (if sign - (either (one-or-more (unit #'digit-char-p)) + (either (many (unit-if #'digit-char-p)) (fail "Malformed number.")) - (one-or-more (unit #'digit-char-p))))) + (many (unit-if #'digit-char-p))))) (cons sign natural)))) (comp ((base signed-digits) - (dot (zero-or-one (the-char #\.))) + (dot (optional (unit #\.))) (fraction (if dot - (either (one-or-more (unit #'digit-char-p)) + (either (many (unit-if #'digit-char-p)) (fail "Malformed fractional part.")) nothing)) - (e (zero-or-one (some-char #\e #\E))) + (e (optional (either (unit #\e) (unit #\E)))) (exponent (if e (either signed-digits (fail "Malformed exponent part.")) @@ -33,84 +25,66 @@ (remove nil (append base (cons dot fraction) (cons e exponent)))))))) (defparameter string-literal - (comp ((_ (the-char #\")) - (chars (zero-or-more (either (comp ((slash (the-char #\\)) - (escaped (unit)) - (codepoints (if (char= escaped #\u) - (comp ((cp0 (unit #'digit-char-p)) - (cp1 (unit #'digit-char-p)) - (cp2 (unit #'digit-char-p)) - (cp3 (unit #'digit-char-p))) - (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 - (#\n - #\Newline) - (#\t - #\Tab) - (#\u - (read-from-string codepoints)) - (t escaped))) - (not-these-chars #\" #\\)))) - (_ (either (the-char #\") + (comp ((_ (unit #\")) + (chars (optional (many (either (comp ((slash (unit #\\)) + (escaped (unit-if)) + (codepoints (if (char= escaped #\u) + (comp ((cp0 (unit-if #'digit-char-p)) + (cp1 (unit-if #'digit-char-p)) + (cp2 (unit-if #'digit-char-p)) + (cp3 (unit-if #'digit-char-p))) + (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 + (#\n + #\Newline) + (#\t + #\Tab) + (#\u + (read-from-string codepoints)) + (t escaped))) + (unit-if (lambda (x) (and (char/= x #\") + (char/= x #\\)))))))) + (_ (either (unit #\") (fail "String is not properly closed.")))) (str:from-list chars))) (defparameter whitespace - (comp ((_ (zero-or-more (some-char #\Space #\Newline #\Tab)))) + (comp ((_ (optional (many (either (unit #\Space) (unit #\Newline) (unit #\Tab)))))) nil)) (defparameter true-symbol - (comp ((_ (the-char #\t)) - (_ (either (comp ((_ (the-char #\r)) - (_ (the-char #\u)) - (_ (the-char #\e))) - nil) + (comp ((_ (unit #\t)) + (_ (either (literal "rue") (fail "Expected 'true'.")))) 'true)) (defparameter false-symbol - (comp ((_ (the-char #\f)) - (_ (either (comp ((_ (the-char #\a)) - (_ (the-char #\l)) - (_ (the-char #\s)) - (_ (the-char #\e))) - nil) + (comp ((_ (unit #\f)) + (_ (either (literal "alse") (fail "Expected 'false'.")))) 'false)) (defparameter null-symbol - (comp ((_ (the-char #\n)) - (_ (either (comp ((_ (the-char #\u)) - (_ (the-char #\l)) - (_ (the-char #\l))) - nil) + (comp ((_ (unit #\n)) + (_ (either (literal "ull") (fail "Expected 'null'.")))) 'null)) (defvar json-value) -(defun separated-list (value-type separator) - (comp ((v value-type) - (sep (zero-or-one (the-char separator))) - (vn (if sep - (either (separated-list value-type separator) - (fail "Expected another value.")) - nothing))) - (cons v vn))) - (defparameter json-array - (comp ((_ (the-char #\[)) - (vn (zero-or-one (separated-list json-value #\,))) - (_ (the-char #\]))) + (comp ((_ (unit #\[)) + (vn (optional (separated-list json-value (unit #\,)))) + (_ (unit #\]))) (apply #'vector vn))) (defparameter json-object @@ -119,13 +93,13 @@ (k (either string-literal (fail "Expected a string."))) (_ whitespace) - (_ (either (the-char #\:) + (_ (either (unit #\:) (fail "Expected a \":\""))) (v json-value)) (cons k v)))) - (comp ((_ (the-char #\{)) - (vn (zero-or-one (separated-list json-pair #\,))) - (_ (the-char #\}))) + (comp ((_ (unit #\{)) + (vn (optional (separated-list json-pair (unit #\,)))) + (_ (unit #\}))) (let* ((obj (make-hash-table :test #'equal :size (length vn)))) (dolist (v vn) (setf (gethash (car v) obj) (cdr v))) |