diff options
| -rw-r--r-- | load.lisp | 56 |
1 files changed, 18 insertions, 38 deletions
@@ -1,28 +1,21 @@ (in-package #:json) -(defparameter whitespace - (comp ((_ (optional (many (unit-if #'char:whitespace?))))) - nil)) - (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))))) + (crit (many (unit digit-char-p))) + (many (unit 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.")) + (crit (many (unit digit-char-p))) nothing)) (e (optional (one-of (unit #\e) (unit #\E)))) (exponent (if e - (one-of signed-digits - (fail "Malformed exponent part.")) + (crit signed-digits) nothing))) (read-from-string (str:from-list @@ -31,12 +24,12 @@ (defparameter string-literal (comp ((_ (unit #\")) (chars (optional (many (one-of (comp ((slash (unit #\\)) - (escaped (unit-if)) + (escaped (unit)) (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))) + (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) #\\) @@ -55,28 +48,23 @@ (#\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.")))) + (unit (and (char/= it #\") (char/= it #\\))))))) + (_ (crit (unit #\")))) (str:from-list chars))) (defparameter true-symbol (comp ((_ (unit #\t)) - (_ (one-of (literal "rue") - (fail "Expected 'true'.")))) + (_ (crit (literal "rue")))) 'true)) (defparameter false-symbol (comp ((_ (unit #\f)) - (_ (one-of (literal "alse") - (fail "Expected 'false'.")))) + (_ (crit (literal "alse")))) 'false)) (defparameter null-symbol (comp ((_ (unit #\n)) - (_ (one-of (literal "ull") - (fail "Expected 'null'.")))) + (_ (crit (literal "ull")))) 'null)) (defvar json-value) @@ -90,11 +78,9 @@ (defparameter json-object (let ((json-pair (comp ((_ whitespace) - (k (one-of string-literal - (fail "Expected a string."))) + (k (crit string-literal)) (_ whitespace) - (_ (one-of (unit #\:) - (fail "Expected a \":\""))) + (_ (crit (unit #\:))) (v json-value)) (cons k v)))) (comp ((_ (unit #\{)) @@ -117,14 +103,8 @@ (_ whitespace)) v)) -(defun run (input) - (let ((result (funcall json-value input))) - (if (parsing-p result) - (parsing-tree result) - result))) - (defun from-string (str) - (run (input:from-string str))) + (run json-value (input:from-string str))) (defun from-file (file) - (run (input:from-file file))) + (run json-value (input:from-file file))) |