diff options
Diffstat (limited to 'load.lisp')
| -rw-r--r-- | load.lisp | 120 |
1 files changed, 64 insertions, 56 deletions
@@ -4,93 +4,101 @@ (let ((signed-digits (comp ((sign (optional (one-of (unit #\-) (unit #\+)))) - (natural (if sign - (crit (many (unit digit-char-p))) - (many (unit digit-char-p))))) - (cons sign natural)))) + (natural (many (unit digit-char-p)))) + (cons sign natural)))) (comp ((base signed-digits) (dot (optional (unit #\.))) (fraction (if dot - (crit (many (unit digit-char-p))) + (many (unit digit-char-p)) nothing)) (e (optional (one-of (unit #\e) (unit #\E)))) (exponent (if e - (crit signed-digits) + signed-digits nothing))) - (read-from-string - (coerce - (remove nil (append base (cons dot fraction) (cons (when e #\d) exponent))) - 'string))))) + (read-from-string + (coerce + (remove nil (append base + (cons dot fraction) + (cons (when e #\d) exponent))) + 'string))))) (defparameter string-literal (comp ((_ (unit #\")) - (chars (optional (many (one-of (comp ((slash (unit #\\)) - (escaped (unit)) - (codepoints (if (char= escaped #\u) - (repeat (unit digit-char-p) 4) - nothing))) - (case escaped - (#\n #\Newline) - (#\t #\Tab) - (#\u (read-from-string (coerce (append '(#\# #\\ #\u) codepoints) 'string))) - (t escaped))) - (unit (and (char/= it #\") (char/= it #\\))))))) - (_ (crit (unit #\")))) - (coerce chars 'string))) + (chars + (optional + (many + (one-of + (comp ((slash (unit #\\)) + (escaped (unit)) + (codepoints (if (char= escaped #\u) + (repeat (unit digit-char-p) 4) + nothing))) + (case escaped + (#\n #\Newline) + (#\t #\Tab) + (#\u (read-from-string + (coerce (append '(#\# #\\ #\u) + codepoints) + 'string))) + (t escaped))) + (unit (and (char/= it #\") (char/= it #\\))))))) + (_ (unit #\"))) + (coerce chars 'string))) + +(defmacro json-symbol (name) + `(comp ((v (literal ,name))) + (intern v))) (defparameter true-symbol - (comp ((_ (unit #\t)) - (_ (crit (literal "rue")))) - 'true)) + (json-symbol "true")) (defparameter false-symbol - (comp ((_ (unit #\f)) - (_ (crit (literal "alse")))) - 'false)) + (json-symbol "false")) (defparameter null-symbol - (comp ((_ (unit #\n)) - (_ (crit (literal "ull")))) - 'null)) - -(defvar json-value) + (json-symbol "null")) -(defparameter json-array +(defun json-array (value) (comp ((_ (unit #\[)) - (vn (optional (separated-list json-value (unit #\,)))) + (vn (optional (separated-list value (unit #\,)))) (_ (unit #\]))) - (apply #'vector vn))) + (apply #'vector vn))) -(defparameter json-object +(defun json-object (value) (let ((json-pair (comp ((_ whitespace) (k string-literal) (_ whitespace) - (_ (crit (unit #\:))) - (v (crit json-value))) - (cons k v)))) + (_ (unit #\:)) + (v 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)))) + (let* ((obj (make-hash-table :test #'equal :size (length vn)))) + (dolist (v vn) + (setf (gethash (car v) obj) (cdr v))) + obj)))) (defparameter json-value (comp ((_ whitespace) - (v (one-of number-literal - string-literal - json-object - json-array - true-symbol - false-symbol - null-symbol)) + (value (one-of number-literal + string-literal + (json-object json-value) + (json-array json-value) + true-symbol + false-symbol + null-symbol)) (_ whitespace)) - v)) + value)) (defun from-string (str) - (run json-value (input:from-string str))) + (parse json-value str)) -(defun from-file (file) - (run json-value (input:from-file file))) +(defun from-file (path) + (let (buf) + (with-open-file (f path) + (let ((size (file-length f))) + (setf buf (make-string size)) + (read-sequence buf f))) + (parse json-value buf))) |