json.l

(de parse-json ()
 (skip)
 (case (peek) 
  ("\"" (read-string))
  ("{" (read-object))
  ("[" (read-array))
  ("t" (read-bare-word "true"))
  ("f" (read-bare-word "false"))
  ("n" (read-bare-word "null"))
  (T (read-number))))

(de expect (C)
 (skip)
 (let P (peek)
   (unless (= P C) (quit (pack "Expected <" C "> Got <" P ">")))))

(de read-string () 
 (expect "\"")
 (char)
 (let R
  (make
    (until (= (peek) "\"")
      (case (peek)
       ("\\" (char) (link (char)))
       (T (link (char))))))
  (char)
  (pack R)))

(de read-object () (read-collection read-key-value "{" "}"))
       
(de read-array () (read-collection parse-json "[" "]"))

(de read-bare-word (W)
  (skip)
  (let R
    (pack
     (make (do (length W) (link (char)))))
   (prog (unless (= W R) (quit (pack "Expected " W ", got " R))) R)))

(de read-number ()
 (skip)
 (let (
       Neg (if (= "-" (peek)) (char))
       _ (unless (isNum (peek)) (quit (pack "Not a number " (peek))))
       Flt NIL
       R (make (while (isNum (peek)) (if (= "." (peek)) (setq Flt T)) (link (char)))))
   (round (pack (if Neg "-") R (unless Flt ".0")))))

(de read-key-value ()
 (let (
   k (read-string)
   _ (skip)
   _ (unless (= (char) ":") (exit ":" (peek)))
   v (parse-json))
   (list k v)))

(de read-collection (F S E) 
 (expect S)
 (char)
 (let R
   (make
     (while (not (= (peek) E))
       (link (F))
       (skip)
       (if (= (peek) ",") (prog (char) (skip) (if (= E (peek)) (quit "Incorrect array termination"))))))
   (char)
   R))

(de isNum (n) (or (= "." n) (num? (format n))))