summaryrefslogtreecommitdiff
path: root/json.lisp
diff options
context:
space:
mode:
Diffstat (limited to 'json.lisp')
-rw-r--r--json.lisp71
1 files changed, 71 insertions, 0 deletions
diff --git a/json.lisp b/json.lisp
index 94f04ee..cc3e0c1 100644
--- a/json.lisp
+++ b/json.lisp
@@ -54,3 +54,74 @@
(char= x #\Newline)
(char= x #\Tab)))))))
nil))
+
+(defparameter true-symbol
+ (comp ((_ (unit (lambda (x) (char= x #\t))))
+ (_ (unit (lambda (x) (char= x #\r))))
+ (_ (unit (lambda (x) (char= x #\u))))
+ (_ (unit (lambda (x) (char= x #\e)))))
+ 'true))
+
+(defparameter false-symbol
+ (comp ((_ (unit (lambda (x) (char= x #\f))))
+ (_ (unit (lambda (x) (char= x #\a))))
+ (_ (unit (lambda (x) (char= x #\l))))
+ (_ (unit (lambda (x) (char= x #\s))))
+ (_ (unit (lambda (x) (char= x #\e)))))
+ 'false))
+
+(defparameter null-symbol
+ (comp ((_ (unit (lambda (x) (char= x #\n))))
+ (_ (unit (lambda (x) (char= x #\u))))
+ (_ (unit (lambda (x) (char= x #\l))))
+ (_ (unit (lambda (x) (char= x #\l)))))
+ 'null))
+
+(defvar json-value)
+
+(defparameter json-array
+ (comp ((_ (unit (lambda (x) (char= x #\[))))
+ (v0 (either json-value
+ whitespace))
+ (vn (if v0
+ (zero-or-more (comp ((_ (unit (lambda (x) (char= #\,))))
+ (vi json-value))
+ vi))
+ nothing))
+ (_ (unit (lambda (x) (char= x #\])))))
+ (if vn
+ (list 'array (cons v0 vn))
+ (list 'array v0))))
+
+(defparameter json-object
+ (let ((json-pair
+ (comp ((_ whitespace)
+ (k string-literal)
+ (_ whitespace)
+ (_ (unit (lambda (x) (char= x #\:))))
+ (v json-value))
+ (list 'pair k v))))
+ (comp ((_ (unit (lambda (x) (char= x #\{))))
+ (v0 (either json-pair
+ whitespace))
+ (vn (if v0
+ (zero-or-more (comp ((_ (unit (lambda (x) (char= #\,))))
+ (vi json-pair))
+ vi))
+ nothing))
+ (_ (unit (lambda (x) (char= x #\})))))
+ (if vn
+ (list 'object (cons v0 vn))
+ (list 'object v0)))))
+
+(setf json-value
+ (comp ((_ whitespace)
+ (v (either number-literal
+ string-literal
+ json-array
+ json-object
+ true-symbol
+ false-symbol
+ null-symbol))
+ (_ whitespace))
+ v))