diff options
Diffstat (limited to 'json.lisp')
-rw-r--r-- | json.lisp | 120 |
1 files changed, 0 insertions, 120 deletions
diff --git a/json.lisp b/json.lisp deleted file mode 100644 index 80fef99..0000000 --- a/json.lisp +++ /dev/null @@ -1,120 +0,0 @@ -(in-package #:json) - -(defparameter number-literal - (let ((signed-digits - (comp ((sign (optional (one-of (unit #\-) - (unit #\+)))) - (natural (if sign - (one-of (many (unit-if #'digit-char-p)) - (fail "Malformed number.")) - (many (unit-if #'digit-char-p))))) - (cons sign natural)))) - (comp ((base signed-digits) - (dot (optional (unit #\.))) - (fraction (if dot - (one-of (many (unit-if #'digit-char-p)) - (fail "Malformed fractional part.")) - nothing)) - (e (optional (one-of (unit #\e) (unit #\E)))) - (exponent (if e - (one-of signed-digits - (fail "Malformed exponent part.")) - nothing))) - (read-from-string - (str:from-list - (remove nil (append base (cons dot fraction) (cons e exponent)))))))) - -(defparameter string-literal - (comp ((_ (unit #\")) - (chars (optional (many (one-of (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 #\\)))))))) - (_ (one-of (unit #\") - (fail "String is not properly closed.")))) - (str:from-list chars))) - -(defparameter true-symbol - (comp ((_ (unit #\t)) - (_ (one-of (literal "rue") - (fail "Expected 'true'.")))) - 'true)) - -(defparameter false-symbol - (comp ((_ (unit #\f)) - (_ (one-of (literal "alse") - (fail "Expected 'false'.")))) - 'false)) - -(defparameter null-symbol - (comp ((_ (unit #\n)) - (_ (one-of (literal "ull") - (fail "Expected 'null'.")))) - 'null)) - -(defvar json-value nil) - -(defparameter json-array - (comp ((_ (unit #\[)) - (vn (optional (separated-list json-value (unit #\,)))) - (_ (unit #\]))) - (apply #'vector vn))) - -(defparameter json-object - (let ((json-pair - (comp ((_ whitespace) - (k (one-of string-literal - (fail "Expected a string."))) - (_ whitespace) - (_ (one-of (unit #\:) - (fail "Expected a \":\""))) - (v json-value)) - (cons k v)))) - (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))) - obj)))) - -(setf json-value - (comp ((_ whitespace) - (v (one-of 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))) - -(defun parse-file (file) - (run json-value (input:from-file file))) |