--- a/jarl.asd Tue Jul 28 22:51:37 2020 -0400
+++ b/jarl.asd Tue Jul 28 22:53:58 2020 -0400
@@ -13,7 +13,6 @@
:serial t
:components ((:module "src" :serial t
:components ((:file "package")
- ;; (:file "reference")
(:file "main")))))
--- a/src/reference.lisp Tue Jul 28 22:51:37 2020 -0400
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,268 +0,0 @@
-(in-package :jarl)
-
-;;;; Reading ------------------------------------------------------------------
-(defun requires-escape-p (char)
- (or (char= #\" char)
- (char= #\\ char)
- (<= (char-code char) #x1F)))
-
-(defun skip-whitespace (stream)
- (loop :while (member (peek-char nil stream nil nil)
- '(#\space #\tab #\newline #\linefeed #\return))
- :do (read-char stream)))
-
-(defun read-literal (stream literal)
- (loop :for next :across literal
- :for char = (read-char stream)
- :do (assert (char= next char))))
-
-(defun read-integer (stream &optional (allow-leading-zero t))
- (loop :with i = 0
- :with n = 0
- :with has-leading-zero = nil
- :for ch = (peek-char nil stream nil #\e)
- :for digit = (digit-char-p ch)
- :while digit
- :do (progn
- (when (and (zerop n) (zerop digit))
- (setf has-leading-zero t))
- (incf n)
- (setf i (+ (* 10 i) digit))
- (read-char stream))
- :finally
- (cond
- ((zerop n) (error "Expected integer"))
- ((and has-leading-zero (not allow-leading-zero)
- (not (and (= n 1) (= i 0))))
- (error "Bad leading zero"))
- (t (return (values i n))))))
-
-(defun read-exponent (stream)
- (read-char stream) ; e
- (let* ((char (peek-char nil stream))
- (sign (if (member char '(#\+ #\-))
- (progn
- (read-char stream)
- (case char
- (#\+ 1)
- (#\- -1)))
- 1)))
- (* sign (read-integer stream))))
-
-(defun read-number (stream)
- ; todo disallow leading zeros in integer part
- (let ((sign 1) integer
- (fractional 0) (fractional-length 0)
- (exponent 0) has-exponent)
- (when (char= #\- (peek-char nil stream))
- (read-char stream)
- (setf sign -1))
- (setf integer (read-integer stream nil))
- (when (eql #\. (peek-char nil stream nil nil))
- (read-char stream)
- (setf (values fractional fractional-length) (read-integer stream)))
- (when (member (peek-char nil stream nil nil) '(#\e #\E))
- (setf exponent (read-exponent stream)
- has-exponent t))
- (if (and (zerop fractional-length) (not has-exponent))
- (* sign integer (expt 10 exponent))
- (values
- (coerce
- (read-from-string (format nil "~A~D.~V,'0Dd~D" ; good enough for reference
- (if (= -1 sign) #\- #\+)
- integer
- fractional-length
- fractional
- exponent))
- 'double-float)))))
-
-(defun read-hex-digit (stream)
- (or (digit-char-p (read-char stream) 16)
- (error "Expected hex digit.")))
-
-(defun read-escaped-char (stream)
- (read-char stream) ; \
- (ecase (read-char stream)
- (#\" #\")
- (#\\ #\\)
- (#\/ #\/)
- (#\b #\backspace)
- (#\f (code-char #x0C))
- (#\n #\linefeed)
- (#\r #\return)
- (#\t #\tab)
- (#\u (let ((a (read-hex-digit stream)) ; todo handle surrogate pairs
- (b (read-hex-digit stream))
- (c (read-hex-digit stream))
- (d (read-hex-digit stream)))
- (code-char (+ (* a (expt 16 3))
- (* b (expt 16 2))
- (* c (expt 16 1))
- (* d (expt 16 0))))))))
-
-(defun read-string (stream)
- (assert (char= #\" (read-char stream)))
- (coerce (loop :for ch = (peek-char nil stream)
- :collect (cond
- ((char= #\\ ch) (read-escaped-char stream))
- ((char= #\" ch) (read-char stream) (loop-finish))
- ((requires-escape-p ch) (error "Bad unescaped char ~S." ch))
- (t (read-char stream))))
- 'string))
-
-(defun read-array (stream)
- (assert (char= #\[ (read-char stream)))
- (skip-whitespace stream)
- (if (char= #\] (peek-char nil stream))
- (progn
- (read-char stream)
- (vector))
- (coerce (loop :collect (read-thing stream)
- :do (progn
- (skip-whitespace stream)
- (case (peek-char nil stream)
- (#\] (read-char stream) (loop-finish))
- (#\, (read-char stream))
- (t (error "Expected , or ] while reading array, got ~S."
- (peek-char nil stream))))))
- 'vector)))
-
-(defun read-object (stream)
- (assert (char= #\{ (read-char stream)))
- (skip-whitespace stream)
- (let ((result (make-hash-table :test #'equal)))
- (if (char= #\} (peek-char nil stream))
- (read-char stream)
- (loop :for name = (progn (skip-whitespace stream)
- (read-string stream))
- :for sep = (progn
- (skip-whitespace stream)
- (assert (char= #\: (read-char stream))))
- :for value = (progn (skip-whitespace stream)
- (read-thing stream))
- :do (progn
- (setf (gethash name result) value)
- (skip-whitespace stream)
- (case (peek-char nil stream)
- (#\} (read-char stream) (loop-finish))
- (#\, (read-char stream))
- (t (error "Expected , or } while reading object, got ~S."
- (peek-char nil stream)))))))
- result))
-
-(defun read-thing (stream)
- (skip-whitespace stream)
- (ecase (peek-char nil stream)
- (#\f (read-literal stream "false") :false)
- (#\t (read-literal stream "true") :true)
- (#\n (read-literal stream "null") nil)
- (#\" (read-string stream))
- (#\{ (read-object stream))
- (#\[ (read-array stream))
- ((#\- #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9) (read-number stream))))
-
-(defun read-json% (stream eof-error-p eof-value)
- (skip-whitespace stream)
- (if (peek-char nil stream nil nil)
- (prog1
- (read-thing stream)
- (skip-whitespace stream))
- (if eof-error-p
- (error "EOF")
- eof-value)))
-
-(defun read-json (&optional (stream-or-string *standard-input*) (eof-error-p t) eof-value)
- (read-json% (etypecase stream-or-string
- (stream stream-or-string)
- (string (make-string-input-stream stream-or-string)))
- eof-error-p
- eof-value))
-
-
-;;;; Printing -----------------------------------------------------------------
-(defun write-escaped-char (char stream)
- (case char
- ((#\newline #\linefeed) (write-string "\\n" stream))
- (#\return (write-string "\\r" stream))
- (#\\ (write-string "\\\\" stream))
- (t (format stream "\\u~4,'0X" (char-code char)))))
-
-
-(defgeneric print-thing (thing stream))
-
-(defmethod print-thing ((thing null) stream)
- (write-string "null" stream))
-
-(defmethod print-thing ((thing string) stream)
- (write-char #\" stream)
- (loop :for char :across thing
- :do (if (requires-escape-p char)
- (write-escaped-char char stream)
- (write-char char stream)))
- (write-char #\" stream))
-
-(defmethod print-thing ((thing vector) stream)
- (write-char #\[ stream)
- (loop :with first = t
- :for object :across thing
- :do (progn (if first
- (setf first nil)
- (write-char #\, stream))
- (print-thing object stream)))
- (write-char #\] stream))
-
-(defmethod print-thing ((thing hash-table) stream)
- (write-char #\{ stream)
- (loop :with first = t
- :for name :being :the hash-keys :in thing :using (hash-value value)
- :do (progn (if first
- (setf first nil)
- (write-char #\, stream))
- (assert (stringp name))
- (print-thing name stream)
- (write-char #\: stream)
- (print-thing value stream)))
- (write-char #\} stream))
-
-(defmethod print-thing ((thing double-float) stream)
- (princ thing stream))
-
-(defmethod print-thing ((thing integer) stream)
- (format stream "~D" thing))
-
-(defmethod print-thing ((thing (eql :false)) stream)
- (write-string "false" stream))
-
-(defmethod print-thing ((thing (eql :true)) stream)
- (write-string "true" stream))
-
-
-(defun print-json (object &optional (stream *standard-output*))
- (let ((*read-default-float-format* 'double-float)
- (*print-base* 10))
- (etypecase stream
- (stream (print-thing object stream)
- (values))
- (null (with-output-to-string (s) (print-thing object s))))))
-
-
-
-#; Scratch --------------------------------------------------------------------
-
-(read-json " false")
-(parse-integer )
-
-(print-json
- (read-json
- (substitute #\" #\'
- "{
- 'foo': [ 1, 2, 3221098950382094832.0123948904],
- 'bar': [{'meow': {}, 'woof': null}, {'baz': 1}]
- }")))
-
-
-
-(with-open-file (s "../JSONTestSuite/test_parsing/i_string_overlong_sequence_2_bytes.json")
- (read-json s))
-
-(read-json "[123e1000]")