diff options
author | Juan Manuel Tomás <jtomas1815@gmail.com> | 2022-11-03 10:17:11 -0300 |
---|---|---|
committer | Juan Manuel Tomás <jtomas1815@gmail.com> | 2022-11-03 10:17:11 -0300 |
commit | 888e53f97c0a1ef5b714b9b7a3dc1a896b873fdb (patch) | |
tree | 39a89f6e4134774670b86288e89838d275823f1d | |
parent | cd21f6d9873f77b808ee55feca8062abe909532e (diff) | |
download | json-888e53f97c0a1ef5b714b9b7a3dc1a896b873fdb.tar.gz json-888e53f97c0a1ef5b714b9b7a3dc1a896b873fdb.zip |
Add parsers for most of the spec
Some concessions were made when handling unicode and whitespace.
-rw-r--r-- | json.lisp | 71 |
1 files changed, 71 insertions, 0 deletions
@@ -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)) |