# HG changeset patch # User Steve Losh # Date 1598743837 14400 # Node ID 2a95e54cdcac7cdea1dd9a54aae2cc27d83e9416 # Parent af3ef34fe3baf1424854a7d7c9f392751added15 Remove opaque-json It doesn't save that much over just parsing into vanilla `t`, and it makes the code more complicated. diff -r af3ef34fe3ba -r 2a95e54cdcac jarl.asd --- a/jarl.asd Sat Aug 29 19:22:07 2020 -0400 +++ b/jarl.asd Sat Aug 29 19:30:37 2020 -0400 @@ -14,7 +14,7 @@ :components ((:module "src" :serial t :components ((:file "package") (:file "basic") - (:file "opaque") + (:file "discard") (:file "wrappers") (:file "mop"))))) diff -r af3ef34fe3ba -r 2a95e54cdcac src/discard.lisp --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/discard.lisp Sat Aug 29 19:30:37 2020 -0400 @@ -0,0 +1,119 @@ +(in-package :jarl) + +;; Optimized reader for cases where you just want to make sure the JSON parses +;; but don't want to allocate all the internal objects. + + +(defun discard-hex-digit (input) + (let ((ch (r input))) + (if (eql :eof ch) + (e nil input "cannot parse \\u escape sequence, got ~S" :eof) + (or (digit-char-p ch 16) + (e nil input "cannot parse \\u escape sequence, ~S is not a hexadecimal digit" ch))))) + +(defun discard-escaped-character (input) + (let ((ch (r input))) + (case ch + ((#\" #\\ #\/ #\b #\f #\n #\r #\t) nil) + (#\u (loop :repeat 4 :do (discard-hex-digit input))) + (t (e nil input "bad escape sequence ~S ~S" #\\ ch)))) + nil) + +(defun discard-literal (string input) + (loop :for next :across string + :for char = (r input) + :unless (eql next char) + :do (e nil input "expected ~S when parsing ~S but got ~S" next string char))) + +(defun discard-array (input) + (r input) ; [ + (incf-depth input) + (skip-whitespace input) + (if (eql (p input) #\]) + (progn (decf-depth input) + (r input)) + (loop (discard-any input) + (skip-whitespace input) + (let ((ch (r input))) + (case ch + (#\] (decf-depth input) (return)) + (#\, (skip-whitespace input)) + (t (e nil input "expected ~S or ~S but got ~S." #\] #\, ch))))))) + +(defun discard-object (input) + (r input) ; { + (incf-depth input) + (skip-whitespace input) + (if (eql (p input) #\}) + (progn (decf-depth input) + (r input)) + (loop (discard-string input) + (parse-kv-separator nil input) + (discard-any input) + (skip-whitespace input) + (let ((ch (r input))) + (case ch + (#\} (decf-depth input) (return)) + (#\, (skip-whitespace input)) + (t (e nil input "expected ~S or ~S but got ~S" #\} #\, ch))))))) + +(defun discard-string (input) + (let ((ch (r input))) + (unless (eql ch #\") + (e nil input "expected opening ~S but got ~S" #\" ch))) + (loop :for ch = (r input) + :do (case ch + (:eof (e nil input "got ~S" :eof)) + (#\\ (discard-escaped-character input)) + (#\" (return)) + (t (if (requires-escape-p ch) + (e nil input "bad unescaped character ~S" ch) + nil))))) + +(defun discard-int (input &optional (allow-leading-zero t)) + (loop :for n :from 0 + :for ch = (p input #\e) + :for digit = (digit-char-p ch) + :while digit + :do (progn (r input) + (when (and (not allow-leading-zero) + (zerop n) ; leading + (zerop digit) ; zero + (digit-char-p (p input #\e))) ; but not a bare zero + (e nil input "bad leading zero"))) + :finally (when (zerop n) + (e nil input "expected an integer")))) + +(defun discard-exponent (input) + (when (member (p input) '(#\+ #\-)) + (r input)) + (discard-int input)) + +(defun discard-number (input) + (when (eql #\- (p input)) + (r input)) + (discard-int input nil) + (when (eql #\. (p input)) + (r input) + (discard-int input)) + (when (member (p input) '(#\e #\E)) + (r input) + (discard-exponent input))) + +(defun discard-any (input) + (case (p input) + (:eof (r input) (e 'discard-json input "got ~S" :eof)) + (#\n (discard-literal "null" input)) + (#\t (discard-literal "true" input)) + (#\f (discard-literal "false" input)) + (#\" (discard-string input)) + (#\{ (discard-object input)) + (#\[ (discard-array input)) + ((#\- #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9) (discard-number input)) + (t (e nil input "unexpected character ~S" (r input))))) + + +(defmethod read% ((class (eql 'nil)) contained-class input) + (skip-whitespace input) + (discard-any input) + (values)) diff -r af3ef34fe3ba -r 2a95e54cdcac src/opaque.lisp --- a/src/opaque.lisp Sat Aug 29 19:22:07 2020 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,157 +0,0 @@ -(in-package :jarl) - -;; Optimized readers for cases where you just want to make sure the JSON parses -;; and preserve it for later, but don't want to allocate all the internal -;; objects. -;; -;; Parsing into opaque-json stores the JSON in a string so it can be emitted -;; later, but doesn't bother allocating all the internal objects It's similar -;; to Golang's json.RawMessage. -;; -;; Parsing into nil parses the JSON to make sure it's well formed, but discards -;; the characters entirely. -;; -;; TODO: Opaque JSON doesn't seem to save all that much over vanilla parsing. -;; Investigate why, and whether we should bother with this at all. - - -(defclass opaque-json () - ((data :accessor data :initarg :data))) - -(defmethod print-object ((o opaque-json) s) - (print-unreadable-object (o s :type t) - (format s "~S" (if (> (length (data o)) 10) - (concatenate 'string (subseq (data o) 0 10) "…") - (data o))))) - -(defun w (input output) ; write through (and read) - (declare (type input input) (optimize (speed 3) (safety 1) (debug 1))) - (let ((ch (r input))) - (unless (or (null output) (eql :eof ch)) - (write-char ch output)) - ch)) - - -(defun opaque-hex-digit (input output) - (let ((ch (w input output))) - (if (eql :eof ch) - (e nil input "cannot parse \\u escape sequence, got ~S" :eof) - (or (digit-char-p ch 16) - (e nil input "cannot parse \\u escape sequence, ~S is not a hexadecimal digit" ch))))) - -(defun opaque-escaped-character (input output) - (let ((ch (w input output))) - (case ch - ((#\" #\\ #\/ #\b #\f #\n #\r #\t) nil) - (#\u (loop :repeat 4 :do (opaque-hex-digit input output))) - (t (e nil input "bad escape sequence ~S ~S" #\\ ch)))) - nil) - -(defun opaque-literal (string input output) - (loop :for next :across string - :for char = (w input output) - :unless (eql next char) - :do (e nil input "expected ~S when parsing ~S but got ~S" next string char))) - -(defun opaque-array (input output) - (w input output) ; [ - (incf-depth input) - (skip-whitespace input) - (if (eql (p input) #\]) - (progn (decf-depth input) - (w input output)) - (loop (opaque-any input output) - (skip-whitespace input) - (let ((ch (w input output))) - (case ch - (#\] (decf-depth input) (return)) - (#\, (skip-whitespace input)) - (t (e nil input "expected ~S or ~S but got ~S." #\] #\, ch))))))) - -(defun opaque-object (input output) - (w input output) ; { - (incf-depth input) - (skip-whitespace input) - (if (eql (p input) #\}) - (progn (decf-depth input) - (w input output)) - (loop (opaque-string input output) - (parse-kv-separator nil input) - (when output (write-char #\: output)) - (opaque-any input output) - (skip-whitespace input) - (let ((ch (w input output))) - (case ch - (#\} (decf-depth input) (return)) - (#\, (skip-whitespace input)) - (t (e nil input "expected ~S or ~S but got ~S" #\} #\, ch))))))) - -(defun opaque-string (input output) - (let ((ch (w input output))) - (unless (eql ch #\") - (e nil input "expected opening ~S but got ~S" #\" ch))) - (loop :for ch = (w input output) - :do (case ch - (:eof (e nil input "got ~S" :eof)) - (#\\ (opaque-escaped-character input output)) - (#\" (return)) - (t (if (requires-escape-p ch) - (e nil input "bad unescaped character ~S" ch) - nil))))) - -(defun opaque-int (input output &optional (allow-leading-zero t)) - (loop :for n :from 0 - :for ch = (p input #\e) - :for digit = (digit-char-p ch) - :while digit - :do (progn (w input output) - (when (and (not allow-leading-zero) - (zerop n) ; leading - (zerop digit) ; zero - (digit-char-p (p input #\e))) ; but not a bare zero - (e nil input "bad leading zero"))) - :finally (when (zerop n) - (e nil input "expected an integer")))) - -(defun opaque-exponent (input output) - (when (member (p input) '(#\+ #\-)) - (w input output)) - (opaque-int input output)) - -(defun opaque-number (input output) - (when (eql #\- (p input)) - (w input output)) - (opaque-int input output nil) - (when (eql #\. (p input)) - (w input output) - (opaque-int input output)) - (when (member (p input) '(#\e #\E)) - (w input output) - (opaque-exponent input output))) - -(defun opaque-any (input output) - (case (p input) - (:eof (w input output) (e 'opaque-json input "got ~S" :eof)) - (#\n (opaque-literal "null" input output)) - (#\t (opaque-literal "true" input output)) - (#\f (opaque-literal "false" input output)) - (#\" (opaque-string input output)) - (#\{ (opaque-object input output)) - (#\[ (opaque-array input output)) - ((#\- #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9) (opaque-number input output)) - (t (e nil input "unexpected character ~S" (w input output))))) - - -(defmethod read% ((class (eql 'opaque-json)) contained-class input) - (skip-whitespace input) - (make-instance 'opaque-json - :data (with-output-to-string (s) - (opaque-any input s)))) - -(defmethod print% ((thing opaque-json) stream) - (write-string (data thing) stream)) - -(defmethod read% ((class (eql 'nil)) contained-class input) - (skip-whitespace input) - (opaque-any input nil) - (values)) diff -r af3ef34fe3ba -r 2a95e54cdcac test/tests.lisp --- a/test/tests.lisp Sat Aug 29 19:22:07 2020 -0400 +++ b/test/tests.lisp Sat Aug 29 19:30:37 2020 -0400 @@ -68,20 +68,15 @@ (is (null (multiple-value-list (jarl:read nil s)))) (signals end-of-file (jarl:read t s)))) -(defun check-opaques-one-object (object string) - (with-input-from-string (s string) - ;; Make sure we can read it as opaque JSON. - (let ((oj (jarl:read 'jarl::opaque-json s))) - ;; Roundtrip it through print and read again and make sure it doesn't get - ;; mangled. - (is (same object (jarl:read t (jarl:print oj nil))))) - (signals end-of-file (jarl:read t s)))) (defun roundtrip-string (class-designator string) (jarl:print (jarl:read class-designator (json string)) nil)) +(defun roundtrip-object (class-designator object) + (jarl:read class-designator (jarl:print object nil))) + (defun check-roundtrips (object) - (is (same object (jarl:read t (jarl:print object nil))))) + (is (same object (roundtrip-object t object)))) (defun check-errors (line col string) (dolist (class '(t nil)) ; todo check discarding errors too @@ -105,8 +100,6 @@ (check-reads-one-object ,object ,string) ; Check that we can roundtrip the form reliably. (check-roundtrips ,object) - ; Check that we can parse it opaquely too. - (check-opaques-one-object ,object ,string) ; Check that we can discard it safely. (check-discards-one-object ,string))))))