Use defparserHEADmain

1 files changed, 46 insertions, 50 deletions

diff --git a/load.lisp b/load.lisp
index 65b85d9..e75ad18 100644
--- a/load.lisp
+++ b/load.lisp
@@ -1,11 +1,14 @@
 (in-package #:json)
 
-(defparameter number-literal
+(defparser whitespace ()
+  (optional (many (unit whitespace?))))
+
+(defparser number-literal ()
   (let ((signed-digits
           (comp ((sign (optional (one-of (unit #\-)
                                          (unit #\+))))
                  (natural (many (unit digit-char-p))))
-                (cons sign natural))))
+            (cons sign natural))))
     (comp ((base signed-digits)
            (dot (optional (unit #\.)))
            (fraction (if dot
@@ -15,14 +18,14 @@
            (exponent (if e
                        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
+(defparser string-literal ()
   (comp ((_ (unit #\"))
          (chars
            (optional
@@ -33,72 +36,65 @@
                         (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)))
+                   (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)))
+    (coerce chars 'string)))
 
 (defmacro json-symbol (name)
   `(comp ((v (literal ,name)))
-         (intern v)))
+     (intern (coerce v 'string))))
 
-(defparameter true-symbol
+(defparser true-symbol ()
   (json-symbol "true"))
 
-(defparameter false-symbol
+(defparser false-symbol ()
   (json-symbol "false"))
 
-(defparameter null-symbol
+(defparser null-symbol ()
   (json-symbol "null"))
 
-(defun json-array (value)
+(defparser json-array ()
   (comp ((_ (unit #\[))
-         (vn (optional (separated-list value (unit #\,))))
+         (vn (optional (interlinked (lazy json-value) (unit #\,))))
          (_ (unit #\])))
-        (apply #'vector vn)))
+    (apply #'vector vn)))
 
-(defun json-object (value)
+(defparser json-object ()
   (let ((json-pair
           (comp ((_ whitespace)
                  (k string-literal)
                  (_ whitespace)
                  (_ (unit #\:))
-                 (v value))
-                (cons k v))))
+                 (v (lazy json-value)))
+            (cons k v))))
     (comp ((_ (unit #\{))
-           (vn (optional (separated-list json-pair (unit #\,))))
+           (vn (optional (interlinked 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)
-         (value (one-of number-literal
-                        string-literal
-                        (json-object json-value)
-                        (json-array json-value)
-                        true-symbol
-                        false-symbol
-                        null-symbol))
-         (_ whitespace))
-        value))
+(defparser json-value ()
+  (within whitespace
+          (one-of number-literal
+                  string-literal
+                  json-object
+                  json-array
+                  true-symbol
+                  false-symbol
+                  null-symbol)))
 
 (defun from-string (str)
   (parse json-value str))
 
 (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)))
+  (parse json-value (str:read-file path)))