Skip to main content
    (defun mk-scanner (s) (list :stream s :cursor 0))

    (defun scanner-peek (scanner) 
      (if (scanner-finished? scanner) 
        nil
        (char (getf scanner :stream) (getf scanner :cursor))))

    (defun scanner-pop (scanner) 
      (let ((result (scanner-peek scanner)))
      (incf (getf scanner :cursor))
      result))

    (defun scanner-finished? (scanner)
      (>= (getf scanner :cursor) (length (getf scanner :stream))))

    (defun scanner-advance (n scanner)
      (let ((cur (getf scanner :cursor)))
        (setf (getf scanner :cursor) (+ cur n))
        (subseq (getf scanner :stream) cur (min (+ cur n) (length (getf scanner :stream))))))

    (defun scanner-position (scanner)
      (getf scanner :cursor))

    ; c is either a string or a char.
    (defun match (c scanner)
      (let ((s (string c)))
        (let ((s-stream (scanner-advance (length s) scanner)))
          (if (equal s s-stream) t
          (error (format nil "No match at char ~a" (scanner-position scanner)))))))


    (defun skip-ws (scanner)
         (loop while (member (scanner-peek scanner) (mapcar #'code-char '(#x20 #x09 #x0A #x0D)))
               do (scanner-pop scanner)))

    (defun parse-string (scanner)
      (match #\" scanner)
      (prog1 
        (coerce (loop 
            while (not (equal (scanner-peek scanner) #\"))
            collect
            (let ((chr (scanner-pop scanner)))
              (if (equal chr #\\)
                (list chr (scanner-pop scanner))
                chr))) 'string)
        (match #\" scanner)))

    (defun parse-int (scanner)
      (parse-integer (coerce (loop while (member (scanner-peek scanner) (coerce "-1234567890" 'list)) collect (scanner-pop scanner)) 'string)))

    (defun parse-array (scanner)
      (prog2
        (match "[" scanner)
        (loop
          collect (prog2 
                    (skip-ws scanner)
                    (parse-value scanner)
                    (skip-ws scanner))
          while (and (equal (scanner-peek scanner) #\,) (match #\, scanner)))
        (skip-ws scanner)
        (match "]" scanner)))

    (defun parse-object (scanner)
      (prog2
        (match "{" scanner)
        (loop
          while (progn (skip-ws scanner) (not (equal (scanner-peek scanner) #\})))
          collect (parse-kvp scanner))
        (match "}" scanner)))


    (defun parse-value (scanner)
      (skip-ws scanner)
      (let ((c (scanner-peek scanner)))
        (cond
          ((equal c #\n) (progn (match "null" scanner) 'jsnull))
          ((equal c #\t) (progn (match "true" scanner) 'jstrue))
          ((equal c #\f) (progn (match "false" scanner) 'jsfalse))
          ((equal c #\[) (parse-array scanner))
          ((equal c #\") (parse-string scanner))
          ((equal c #\{) (parse-object scanner))
          ((member c (coerce "-1234567890" 'list)) (parse-int scanner)))))

    (defun parse-kvp (scanner)
      (let (key val)
          (skip-ws scanner)
          (setq key (parse-string scanner))
          (skip-ws scanner)
          (match #\: scanner)
          (skip-ws scanner)
          (setq val (parse-value scanner))
          (skip-ws scanner)
          (when (equal (scanner-peek scanner) #\,) (match #\, scanner))
          (cons key val)))

    (defun parse (str)
      (parse-value (mk-scanner str)))
```
    (defun mk-scanner (s) (list :stream s :cursor 0))

    (defun scanner-peek (scanner) 
      (if (scanner-finished? scanner) 
        nil
        (char (getf scanner :stream) (getf scanner :cursor))))

    (defun scanner-pop (scanner) 
      (let ((result (scanner-peek scanner)))
      (incf (getf scanner :cursor))
      result))

    (defun scanner-finished? (scanner)
      (>= (getf scanner :cursor) (length (getf scanner :stream))))

    (defun scanner-advance (n scanner)
      (let ((cur (getf scanner :cursor)))
        (setf (getf scanner :cursor) (+ cur n))
        (subseq (getf scanner :stream) cur (min (+ cur n) (length (getf scanner :stream))))))

    (defun scanner-position (scanner)
      (getf scanner :cursor))

    ; c is either a string or a char.
    (defun match (c scanner)
      (let ((s (string c)))
        (let ((s-stream (scanner-advance (length s) scanner)))
          (if (equal s s-stream) t
          (error (format nil "No match at char ~a" (scanner-position scanner)))))))


    (defun skip-ws (scanner)
         (loop while (member (scanner-peek scanner) (mapcar #'code-char '(#x20 #x09 #x0A #x0D)))
               do (scanner-pop scanner)))

    (defun parse-string (scanner)
      (match #\" scanner)
      (prog1 
        (coerce (loop 
            while (not (equal (scanner-peek scanner) #\"))
            collect
            (let ((chr (scanner-pop scanner)))
              (if (equal chr #\\)
                (list chr (scanner-pop scanner))
                chr))) 'string)
        (match #\" scanner)))

    (defun parse-int (scanner)
      (parse-integer (coerce (loop while (member (scanner-peek scanner) (coerce "-1234567890" 'list)) collect (scanner-pop scanner)) 'string)))

    (defun parse-array (scanner)
      (prog2
        (match "[" scanner)
        (loop
          collect (prog2 
                    (skip-ws scanner)
                    (parse-value scanner)
                    (skip-ws scanner))
          while (and (equal (scanner-peek scanner) #\,) (match #\, scanner)))
        (skip-ws scanner)
        (match "]" scanner)))

    (defun parse-object (scanner)
      (prog2
        (match "{" scanner)
        (loop
          while (progn (skip-ws scanner) (not (equal (scanner-peek scanner) #\})))
          collect (parse-kvp scanner))
        (match "}" scanner)))


    (defun parse-value (scanner)
      (skip-ws scanner)
      (let ((c (scanner-peek scanner)))
        (cond
          ((equal c #\n) (progn (match "null" scanner) 'jsnull))
          ((equal c #\t) (progn (match "true" scanner) 'jstrue))
          ((equal c #\f) (progn (match "false" scanner) 'jsfalse))
          ((equal c #\[) (parse-array scanner))
          ((equal c #\") (parse-string scanner))
          ((equal c #\{) (parse-object scanner))
          ((member c (coerce "-1234567890" 'list)) (parse-int scanner)))))

    (defun parse-kvp (scanner)
      (let (key val)
          (skip-ws scanner)
          (setq key (parse-string scanner))
          (skip-ws scanner)
          (match #\: scanner)
          (skip-ws scanner)
          (setq val (parse-value scanner))
          (skip-ws scanner)
          (when (equal (scanner-peek scanner) #\,) (match #\, scanner))
          (cons key val)))

    (defun parse (str)
      (parse-value (mk-scanner str)))
```
(defun mk-scanner (s) (list :stream s :cursor 0))

(defun scanner-peek (scanner) 
  (if (scanner-finished? scanner) 
    nil
    (char (getf scanner :stream) (getf scanner :cursor))))

(defun scanner-pop (scanner) 
  (let ((result (scanner-peek scanner)))
  (incf (getf scanner :cursor))
  result))

(defun scanner-finished? (scanner)
  (>= (getf scanner :cursor) (length (getf scanner :stream))))

(defun scanner-advance (n scanner)
  (let ((cur (getf scanner :cursor)))
    (setf (getf scanner :cursor) (+ cur n))
    (subseq (getf scanner :stream) cur (min (+ cur n) (length (getf scanner :stream))))))

(defun scanner-position (scanner)
  (getf scanner :cursor))

; c is either a string or a char.
(defun match (c scanner)
  (let ((s (string c)))
    (let ((s-stream (scanner-advance (length s) scanner)))
      (if (equal s s-stream) t
      (error (format nil "No match at char ~a" (scanner-position scanner)))))))


(defun skip-ws (scanner)
     (loop while (member (scanner-peek scanner) (mapcar #'code-char '(#x20 #x09 #x0A #x0D)))
           do (scanner-pop scanner)))

(defun parse-string (scanner)
  (match #\" scanner)
  (prog1 
    (coerce (loop 
        while (not (equal (scanner-peek scanner) #\"))
        collect
        (let ((chr (scanner-pop scanner)))
          (if (equal chr #\\)
            (list chr (scanner-pop scanner))
            chr))) 'string)
    (match #\" scanner)))

(defun parse-int (scanner)
  (parse-integer (coerce (loop while (member (scanner-peek scanner) (coerce "-1234567890" 'list)) collect (scanner-pop scanner)) 'string)))

(defun parse-array (scanner)
  (prog2
    (match "[" scanner)
    (loop
      collect (prog2 
                (skip-ws scanner)
                (parse-value scanner)
                (skip-ws scanner))
      while (and (equal (scanner-peek scanner) #\,) (match #\, scanner)))
    (skip-ws scanner)
    (match "]" scanner)))

(defun parse-object (scanner)
  (prog2
    (match "{" scanner)
    (loop
      while (progn (skip-ws scanner) (not (equal (scanner-peek scanner) #\})))
      collect (parse-kvp scanner))
    (match "}" scanner)))


(defun parse-value (scanner)
  (skip-ws scanner)
  (let ((c (scanner-peek scanner)))
    (cond
      ((equal c #\n) (progn (match "null" scanner) 'jsnull))
      ((equal c #\t) (progn (match "true" scanner) 'jstrue))
      ((equal c #\f) (progn (match "false" scanner) 'jsfalse))
      ((equal c #\[) (parse-array scanner))
      ((equal c #\") (parse-string scanner))
      ((equal c #\{) (parse-object scanner))
      ((member c (coerce "-1234567890" 'list)) (parse-int scanner)))))

(defun parse-kvp (scanner)
  (let (key val)
      (skip-ws scanner)
      (setq key (parse-string scanner))
      (skip-ws scanner)
      (match #\: scanner)
      (skip-ws scanner)
      (setq val (parse-value scanner))
      (skip-ws scanner)
      (when (equal (scanner-peek scanner) #\,) (match #\, scanner))
      (cons key val)))

(defun parse (str)
  (parse-value (mk-scanner str)))
```
Became Hot Network Question
removed commented out code
Source Link
    (defun mk-scanner (s) (list :stream s :cursor 0))

    (defun scanner-peek (scanner) 
      (if (scanner-finished? scanner) 
        nil
        (char (getf scanner :stream) (getf scanner :cursor))))

    (defun scanner-pop (scanner) 
      (let ((result (scanner-peek scanner)))
      (incf (getf scanner :cursor))
      result))

    (defun scanner-finished? (scanner)
      (>= (getf scanner :cursor) (length (getf scanner :stream))))

    (defun scanner-advance (n scanner)
      (let ((cur (getf scanner :cursor)))
        (setf (getf scanner :cursor) (+ cur n))
        (subseq (getf scanner :stream) cur (min (+ cur n) (length (getf scanner :stream))))))

    ; Can maybe support newlines like row:col, e.g. 5:60
    (defun scanner-position (scanner)
      (getf scanner :cursor))
    ; (defvar *ss* (mk-scanner (uiop:read-file-string "johndoe.json")))

    ; c is either a string or a char.
    (defun match (c scanner)
      (let ((s (string c)))
        (let ((s-stream (scanner-advance (length s) scanner)))
          (if (equal s s-stream) t
          (error (format nil "No match at char ~a" (scanner-position scanner)))))))


    (defun skip-ws (scanner)
         (loop while (member (scanner-peek scanner) (mapcar #'code-char '(#x20 #x09 #x0A #x0D)))
               do (scanner-pop scanner)))

    (defun parse-string (scanner)
      (match #\" scanner)
      (prog1 
        (coerce (loop 
            while (not (equal (scanner-peek scanner) #\"))
            collect
            (let ((chr (scanner-pop scanner)))
              (if (equal chr #\\)
                (list chr (scanner-pop scanner))
                chr))) 'string)
        (match #\" scanner)))

    (defun parse-int (scanner)
      (parse-integer (coerce (loop while (member (scanner-peek scanner) (coerce "-1234567890" 'list)) collect (scanner-pop scanner)) 'string)))

    (defun parse-array (scanner)
      (prog2
        (match "[" scanner)
        (loop
          collect (prog2 
                    (skip-ws scanner)
                    (parse-value scanner)
                    (skip-ws scanner))
          while (and (equal (scanner-peek scanner) #\,) (match #\, scanner)))
        (skip-ws scanner)
        (match "]" scanner)))

    (defun parse-object (scanner)
      (prog2
        (match "{" scanner)
        (loop
          while (progn (skip-ws scanner) (not (equal (scanner-peek scanner) #\})))
          collect (parse-kvp scanner))
        (match "}" scanner)))


    (defun parse-value (scanner)
      (skip-ws scanner)
      (let ((c (scanner-peek scanner)))
        (cond
          ((equal c #\n) (progn (match "null" scanner) 'jsnull))
          ((equal c #\t) (progn (match "true" scanner) 'jstrue))
          ((equal c #\f) (progn (match "false" scanner) 'jsfalse))
          ((equal c #\[) (parse-array scanner))
          ((equal c #\") (parse-string scanner))
          ((equal c #\{) (parse-object scanner))
          ((member c (coerce "-1234567890" 'list)) (parse-int scanner)))))

    (defun parse-kvp (scanner)
      (let (key val)
          (skip-ws scanner)
          (setq key (parse-string scanner))
          (skip-ws scanner)
          (match #\: scanner)
          (skip-ws scanner)
          (setq val (parse-value scanner))
          (skip-ws scanner)
          (when (equal (scanner-peek scanner) #\,) (match #\, scanner))
          (cons key val)))

    (defun parse (str)
      (parse-value (mk-scanner str)))
```
    (defun mk-scanner (s) (list :stream s :cursor 0))

    (defun scanner-peek (scanner) 
      (if (scanner-finished? scanner) 
        nil
        (char (getf scanner :stream) (getf scanner :cursor))))

    (defun scanner-pop (scanner) 
      (let ((result (scanner-peek scanner)))
      (incf (getf scanner :cursor))
      result))

    (defun scanner-finished? (scanner)
      (>= (getf scanner :cursor) (length (getf scanner :stream))))

    (defun scanner-advance (n scanner)
      (let ((cur (getf scanner :cursor)))
        (setf (getf scanner :cursor) (+ cur n))
        (subseq (getf scanner :stream) cur (min (+ cur n) (length (getf scanner :stream))))))

    ; Can maybe support newlines like row:col, e.g. 5:60
    (defun scanner-position (scanner)
      (getf scanner :cursor))
    ; (defvar *ss* (mk-scanner (uiop:read-file-string "johndoe.json")))

    ; c is either a string or a char.
    (defun match (c scanner)
      (let ((s (string c)))
        (let ((s-stream (scanner-advance (length s) scanner)))
          (if (equal s s-stream) t
          (error (format nil "No match at char ~a" (scanner-position scanner)))))))


    (defun skip-ws (scanner)
         (loop while (member (scanner-peek scanner) (mapcar #'code-char '(#x20 #x09 #x0A #x0D)))
               do (scanner-pop scanner)))

    (defun parse-string (scanner)
      (match #\" scanner)
      (prog1 
        (coerce (loop 
            while (not (equal (scanner-peek scanner) #\"))
            collect
            (let ((chr (scanner-pop scanner)))
              (if (equal chr #\\)
                (list chr (scanner-pop scanner))
                chr))) 'string)
        (match #\" scanner)))

    (defun parse-int (scanner)
      (parse-integer (coerce (loop while (member (scanner-peek scanner) (coerce "-1234567890" 'list)) collect (scanner-pop scanner)) 'string)))

    (defun parse-array (scanner)
      (prog2
        (match "[" scanner)
        (loop
          collect (prog2 
                    (skip-ws scanner)
                    (parse-value scanner)
                    (skip-ws scanner))
          while (and (equal (scanner-peek scanner) #\,) (match #\, scanner)))
        (skip-ws scanner)
        (match "]" scanner)))

    (defun parse-object (scanner)
      (prog2
        (match "{" scanner)
        (loop
          while (progn (skip-ws scanner) (not (equal (scanner-peek scanner) #\})))
          collect (parse-kvp scanner))
        (match "}" scanner)))


    (defun parse-value (scanner)
      (skip-ws scanner)
      (let ((c (scanner-peek scanner)))
        (cond
          ((equal c #\n) (progn (match "null" scanner) 'jsnull))
          ((equal c #\t) (progn (match "true" scanner) 'jstrue))
          ((equal c #\f) (progn (match "false" scanner) 'jsfalse))
          ((equal c #\[) (parse-array scanner))
          ((equal c #\") (parse-string scanner))
          ((equal c #\{) (parse-object scanner))
          ((member c (coerce "-1234567890" 'list)) (parse-int scanner)))))

    (defun parse-kvp (scanner)
      (let (key val)
          (skip-ws scanner)
          (setq key (parse-string scanner))
          (skip-ws scanner)
          (match #\: scanner)
          (skip-ws scanner)
          (setq val (parse-value scanner))
          (skip-ws scanner)
          (when (equal (scanner-peek scanner) #\,) (match #\, scanner))
          (cons key val)))

    (defun parse (str)
      (parse-value (mk-scanner str)))
```
    (defun mk-scanner (s) (list :stream s :cursor 0))

    (defun scanner-peek (scanner) 
      (if (scanner-finished? scanner) 
        nil
        (char (getf scanner :stream) (getf scanner :cursor))))

    (defun scanner-pop (scanner) 
      (let ((result (scanner-peek scanner)))
      (incf (getf scanner :cursor))
      result))

    (defun scanner-finished? (scanner)
      (>= (getf scanner :cursor) (length (getf scanner :stream))))

    (defun scanner-advance (n scanner)
      (let ((cur (getf scanner :cursor)))
        (setf (getf scanner :cursor) (+ cur n))
        (subseq (getf scanner :stream) cur (min (+ cur n) (length (getf scanner :stream))))))

    (defun scanner-position (scanner)
      (getf scanner :cursor))

    ; c is either a string or a char.
    (defun match (c scanner)
      (let ((s (string c)))
        (let ((s-stream (scanner-advance (length s) scanner)))
          (if (equal s s-stream) t
          (error (format nil "No match at char ~a" (scanner-position scanner)))))))


    (defun skip-ws (scanner)
         (loop while (member (scanner-peek scanner) (mapcar #'code-char '(#x20 #x09 #x0A #x0D)))
               do (scanner-pop scanner)))

    (defun parse-string (scanner)
      (match #\" scanner)
      (prog1 
        (coerce (loop 
            while (not (equal (scanner-peek scanner) #\"))
            collect
            (let ((chr (scanner-pop scanner)))
              (if (equal chr #\\)
                (list chr (scanner-pop scanner))
                chr))) 'string)
        (match #\" scanner)))

    (defun parse-int (scanner)
      (parse-integer (coerce (loop while (member (scanner-peek scanner) (coerce "-1234567890" 'list)) collect (scanner-pop scanner)) 'string)))

    (defun parse-array (scanner)
      (prog2
        (match "[" scanner)
        (loop
          collect (prog2 
                    (skip-ws scanner)
                    (parse-value scanner)
                    (skip-ws scanner))
          while (and (equal (scanner-peek scanner) #\,) (match #\, scanner)))
        (skip-ws scanner)
        (match "]" scanner)))

    (defun parse-object (scanner)
      (prog2
        (match "{" scanner)
        (loop
          while (progn (skip-ws scanner) (not (equal (scanner-peek scanner) #\})))
          collect (parse-kvp scanner))
        (match "}" scanner)))


    (defun parse-value (scanner)
      (skip-ws scanner)
      (let ((c (scanner-peek scanner)))
        (cond
          ((equal c #\n) (progn (match "null" scanner) 'jsnull))
          ((equal c #\t) (progn (match "true" scanner) 'jstrue))
          ((equal c #\f) (progn (match "false" scanner) 'jsfalse))
          ((equal c #\[) (parse-array scanner))
          ((equal c #\") (parse-string scanner))
          ((equal c #\{) (parse-object scanner))
          ((member c (coerce "-1234567890" 'list)) (parse-int scanner)))))

    (defun parse-kvp (scanner)
      (let (key val)
          (skip-ws scanner)
          (setq key (parse-string scanner))
          (skip-ws scanner)
          (match #\: scanner)
          (skip-ws scanner)
          (setq val (parse-value scanner))
          (skip-ws scanner)
          (when (equal (scanner-peek scanner) #\,) (match #\, scanner))
          (cons key val)))

    (defun parse (str)
      (parse-value (mk-scanner str)))
```
Source Link

Simple JSON parser in lisp

A simple recursive descent JSON parser. The entrypoint to the code is the parse function. Since I'm pretty new to common lisp, I wanted to get feedback on how to make my code more concise, general, and performant. There are no real optimizations -- this is the first working version, and I would like to know what it would take to go from my implementation to something that would be production ready (of course, ignoring the fact that I could simply use a library for this). Some possible sources of improvement:

  • Creating a separate lexer to improve performance and reduce calls like scanner-peek immediately before scanner-pop
  • Making it more robust to malformed inputs / improved error messages
  • Shorter code / following lisp idioms better

Here is the code in its entirety:

    (defun mk-scanner (s) (list :stream s :cursor 0))

    (defun scanner-peek (scanner) 
      (if (scanner-finished? scanner) 
        nil
        (char (getf scanner :stream) (getf scanner :cursor))))

    (defun scanner-pop (scanner) 
      (let ((result (scanner-peek scanner)))
      (incf (getf scanner :cursor))
      result))

    (defun scanner-finished? (scanner)
      (>= (getf scanner :cursor) (length (getf scanner :stream))))

    (defun scanner-advance (n scanner)
      (let ((cur (getf scanner :cursor)))
        (setf (getf scanner :cursor) (+ cur n))
        (subseq (getf scanner :stream) cur (min (+ cur n) (length (getf scanner :stream))))))

    ; Can maybe support newlines like row:col, e.g. 5:60
    (defun scanner-position (scanner)
      (getf scanner :cursor))
    ; (defvar *ss* (mk-scanner (uiop:read-file-string "johndoe.json")))

    ; c is either a string or a char.
    (defun match (c scanner)
      (let ((s (string c)))
        (let ((s-stream (scanner-advance (length s) scanner)))
          (if (equal s s-stream) t
          (error (format nil "No match at char ~a" (scanner-position scanner)))))))


    (defun skip-ws (scanner)
         (loop while (member (scanner-peek scanner) (mapcar #'code-char '(#x20 #x09 #x0A #x0D)))
               do (scanner-pop scanner)))

    (defun parse-string (scanner)
      (match #\" scanner)
      (prog1 
        (coerce (loop 
            while (not (equal (scanner-peek scanner) #\"))
            collect
            (let ((chr (scanner-pop scanner)))
              (if (equal chr #\\)
                (list chr (scanner-pop scanner))
                chr))) 'string)
        (match #\" scanner)))

    (defun parse-int (scanner)
      (parse-integer (coerce (loop while (member (scanner-peek scanner) (coerce "-1234567890" 'list)) collect (scanner-pop scanner)) 'string)))

    (defun parse-array (scanner)
      (prog2
        (match "[" scanner)
        (loop
          collect (prog2 
                    (skip-ws scanner)
                    (parse-value scanner)
                    (skip-ws scanner))
          while (and (equal (scanner-peek scanner) #\,) (match #\, scanner)))
        (skip-ws scanner)
        (match "]" scanner)))

    (defun parse-object (scanner)
      (prog2
        (match "{" scanner)
        (loop
          while (progn (skip-ws scanner) (not (equal (scanner-peek scanner) #\})))
          collect (parse-kvp scanner))
        (match "}" scanner)))


    (defun parse-value (scanner)
      (skip-ws scanner)
      (let ((c (scanner-peek scanner)))
        (cond
          ((equal c #\n) (progn (match "null" scanner) 'jsnull))
          ((equal c #\t) (progn (match "true" scanner) 'jstrue))
          ((equal c #\f) (progn (match "false" scanner) 'jsfalse))
          ((equal c #\[) (parse-array scanner))
          ((equal c #\") (parse-string scanner))
          ((equal c #\{) (parse-object scanner))
          ((member c (coerce "-1234567890" 'list)) (parse-int scanner)))))

    (defun parse-kvp (scanner)
      (let (key val)
          (skip-ws scanner)
          (setq key (parse-string scanner))
          (skip-ws scanner)
          (match #\: scanner)
          (skip-ws scanner)
          (setq val (parse-value scanner))
          (skip-ws scanner)
          (when (equal (scanner-peek scanner) #\,) (match #\, scanner))
          (cons key val)))

    (defun parse (str)
      (parse-value (mk-scanner str)))
```