# HG changeset patch # User Steve Losh # Date 1595991238 14400 # Node ID 3eda0a6022fc6ccef229cf587ec8037455f30de9 # Parent b35951eca1b20010a91045bc10c63ef4b02ab50f Remove old file diff -r b35951eca1b2 -r 3eda0a6022fc jarl.asd --- 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"))))) diff -r b35951eca1b2 -r 3eda0a6022fc src/reference.lisp --- 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]")