--- a/.TODO.done Tue Aug 11 23:45:07 2020 -0400
+++ b/.TODO.done Wed Aug 12 00:38:21 2020 -0400
@@ -1,1 +1,2 @@
+Optimize discarding | id:93105ef9d21d33bfb10c67fcac36bc60434d3fb4
Add basic unit tests | id:ed372a368fce619ce8230043635de5258212f607
--- a/TODO Tue Aug 11 23:45:07 2020 -0400
+++ b/TODO Wed Aug 12 00:38:21 2020 -0400
@@ -1,6 +1,5 @@
Add read/print disabling mechanism | id:1268bf0b10c13aec23aafbd8f5e236db1e485fa5
Add basic wrapper definition | id:861f048b3b69079dedf8779be1cb73c05e6fc732
-Optimize discarding | id:93105ef9d21d33bfb10c67fcac36bc60434d3fb4
Add after-read and before-print functions | id:9f982ca45b68d644159e0c64f0dc1b185f72a2f8
Add opaque-json type | id:a1a380eb9782d088693dfb75402b99c2b30cf039
Add dynamic extent wrapper definition | id:a937f1179ff1fac77ca501ce7c70449464411f58
--- a/src/main.lisp Tue Aug 11 23:45:07 2020 -0400
+++ b/src/main.lisp Wed Aug 12 00:38:21 2020 -0400
@@ -160,6 +160,71 @@
(defgeneric read% (class contained-class input))
+(defmethod read% ((class (eql 'nil)) contained-class input)
+ ;; Optimized reader for cases where you don't actually care about the value
+ ;; and just need to parse over it without allocating anything.
+ (labels
+ ((any% ()
+ (case (p input)
+ (:eof (r input) (e nil input "got ~S" :eof))
+ (#\n (literal% "null"))
+ (#\t (literal% "true"))
+ (#\f (literal% "false"))
+ (#\" (string%))
+ (#\{ (object%))
+ (#\[ (array%))
+ ((#\- #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9) (number%))
+ (t (e nil input "unexpected character ~S" (r input)))))
+ (literal% (string)
+ (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)))
+ (array% ()
+ (r input) ; [
+ (skip-whitespace input)
+ (if (eql (p input) #\])
+ (r input)
+ (loop (any%)
+ (skip-whitespace input)
+ (let ((ch (r input)))
+ (case ch
+ (#\] (return))
+ (#\, (skip-whitespace input))
+ (t (e nil input "expected ~S or ~S but got ~S." #\] #\, ch)))))))
+ (object% ()
+ (r input) ; {
+ (skip-whitespace input)
+ (if (eql (p input) #\})
+ (r input)
+ (loop
+ (string%)
+ (parse-kv-separator nil input)
+ (any%)
+ (skip-whitespace input)
+ (let ((ch (r input)))
+ (case ch
+ (#\} (return))
+ (#\, (skip-whitespace input))
+ (t (e nil input "expected ~S or ~S but got ~S" #\} #\, ch)))))))
+ (number% ()
+ ;; TODO: Optimize this too. Not a huge priority since fixnums don't cons.
+ (parse-number input))
+ (string% ()
+ (let ((ch (r input)))
+ (unless (eql ch #\")
+ (e nil input "expected opening ~S but got ~S" #\" ch)))
+ (loop :for ch = (r input)
+ :do (cond
+ ((eql ch :eof) (e nil input "got ~S" :eof))
+ ((eql ch #\\) (parse-escaped-character input)) ; TODO: Optimize this too.
+ ((eql ch #\") (return))
+ ((requires-escape-p ch) (e nil input "bad unescaped character ~S" ch))
+ (t nil)))))
+ (skip-whitespace input)
+ (any%)
+ (values)))
+
(defmethod read% ((class (eql 'keyword)) contained-class input)
(let ((ch (r input)))
(case ch
@@ -186,13 +251,13 @@
:with c = (car contained-class)
:with cc = (cadr contained-class)
:collect (read% c cc input)
- :do (progn
- (skip-whitespace input)
- (let ((ch (r input)))
- (case ch
- (#\] (loop-finish))
- (#\, (skip-whitespace input))
- (t (e 'vector input "expected ~S or ~S but got ~S." #\] #\, ch))))))
+ :do (progn
+ (skip-whitespace input)
+ (let ((ch (r input)))
+ (case ch
+ (#\] (loop-finish))
+ (#\, (skip-whitespace input))
+ (t (e 'vector input "expected ~S or ~S but got ~S." #\] #\, ch))))))
'vector)))
(defmethod read% ((class (eql 'string)) contained-class input)
@@ -201,12 +266,12 @@
(e 'string input "expected opening ~S but got ~S" #\" ch)))
(with-output-to-string (s)
(loop :for ch = (r input)
- :collect (cond
- ((eql ch :eof) (e 'string input "got ~S" :eof))
- ((eql ch #\\) (write-char (parse-escaped-character input) s))
- ((eql ch #\") (loop-finish))
- ((requires-escape-p ch) (e 'string input "bad unescaped character ~S" ch))
- (t (write-char ch s))))))
+ :do (cond
+ ((eql ch :eof) (e 'string input "got ~S" :eof))
+ ((eql ch #\\) (write-char (parse-escaped-character input) s))
+ ((eql ch #\") (loop-finish))
+ ((requires-escape-p ch) (e 'string input "bad unescaped character ~S" ch))
+ (t (write-char ch s))))))
(defmethod read% ((class (eql 'hash-table)) contained-class input)
(let ((ch (r input)))
@@ -259,6 +324,7 @@
(t (e 't input "unexpected character ~S" (r input)))))
+
;;;; Object Parsers -----------------------------------------------------------
(defun lisp-case-to-snake-case (string)
"Convert a Lisp-cased string designator `\"FOO-BAR\"` into snake cased `\"foo_bar\"`."
--- a/test/tests.lisp Tue Aug 11 23:45:07 2020 -0400
+++ b/test/tests.lisp Wed Aug 12 00:38:21 2020 -0400
@@ -42,16 +42,43 @@
(null (set-difference y x :test #'equal))))
+(defun check-reads-one-object (object string)
+ (with-input-from-string (s string)
+ (is (same object (jarl:read t s)))
+ (signals end-of-file (jarl:read t s))))
+
+(defun check-discards-one-object (string)
+ (with-input-from-string (s string)
+ (is (null (multiple-value-list (jarl:read nil s))))
+ (signals end-of-file (jarl:read t s))))
+
+(defun check-roundtrips (object)
+ (is (same object (jarl:read t (jarl:print object nil)))))
+
+(defun check-errors (line col string)
+ (dolist (class '(t nil)) ; todo check discarding errors too
+ (handler-case
+ (progn
+ (jarl:read class string)
+ (error "Should have signaled a json-parsing-error when parsing ~S but didn't."
+ class))
+ (jarl::json-parsing-error (e)
+ (is (equal (list class line col)
+ (list class (jarl:line e) (jarl:column e))))))))
+
+
;;;; Basic Tests --------------------------------------------------------------
(defmacro define-basic-tests (name &rest clauses)
`(define-test ,name
,@(loop :for (object string) :in clauses :collect
(alexandria:once-only (object string)
- `(progn
- ; check that the string deserializes to the expected form
- (is (same ,object (jarl:read t (json ,string))))
- ; check that we can roundtrip the form reliably
- (is (same ,object (jarl:read t (jarl:print ,object nil)))))))))
+ `(let ((,string (json ,string)))
+ ; Check that the entire string deserializes to the expected form.
+ (check-reads-one-object ,object ,string)
+ ; Check that we can roundtrip the form reliably.
+ (is (same ,object (jarl:read t (jarl:print ,object nil))))
+ ; Check that we can discard it safely.
+ (check-discards-one-object ,string))))))
(define-basic-tests null
@@ -140,12 +167,16 @@
;;;; Real-World Data ----------------------------------------------------------
(defmacro define-file-test (name (object path) &body body)
- `(define-test ,name
- (let ((,object (with-open-file (s ,path)
- (jarl:read t s))))
- ;; Check that we can roundtrip it first.
- (is (same ,object (jarl:read t (jarl:print ,object nil))))
- ,@body)))
+ (alexandria:with-gensyms (string)
+ `(define-test ,name
+ (let ((,string (alexandria:read-file-into-string ,path)))
+ ;; Check that discarding works.
+ (check-discards-one-object ,string)
+ (let ((,object (jarl:read t ,string)))
+ ;; Check that we can discard it.
+ (check-roundtrips ,object)
+ ;; Other test-specific checks.
+ ,@body)))))
(define-file-test github/sjl (o "test/data/github/sjl.json")
@@ -164,15 +195,8 @@
;;;; Error Tests --------------------------------------------------------------
(defmacro define-error-tests (name &rest clauses)
`(define-test ,name
- ,@(loop :for (line col string) :in clauses :collect
- (alexandria:once-only (line col string)
- `(handler-case (progn (jarl:read t (json ,string))
- (error "Should have signaled a json-parsing-error but didn't."))
- (jarl::json-parsing-error
- (e)
- (1am:is (equal (cons ,line ,col)
- (cons (jarl:line e)
- (jarl:column e))))))))))
+ ,@(loop :for (line col string) :in clauses
+ :collect `(check-errors ,line ,col (json ,string)))))
(define-error-tests trash