# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1595094809 14400
# Node ID 30f068e0228519d9d6dc3139d8eda529058e5be3
# Parent  a2712b3d3b16b2b0e11fd7fe9c92872dc7d6e251
Scratch commit for historical purposes

diff -r a2712b3d3b16 -r 30f068e02285 README.markdown
--- a/README.markdown	Mon Jul 13 21:59:43 2020 -0400
+++ b/README.markdown	Sat Jul 18 13:53:29 2020 -0400
@@ -1,3 +1,6 @@
+Not ready yet, clone at your own risk
+=====================================
+
 Jarl
 =====
 
@@ -8,4 +11,3 @@
 * **Mercurial:** <https://hg.stevelosh.com/jarl/>
 * **Git:** <https://github.com/sjl/jarl/>
 
-Jarl is …
diff -r a2712b3d3b16 -r 30f068e02285 jarl.asd
--- a/jarl.asd	Mon Jul 13 21:59:43 2020 -0400
+++ b/jarl.asd	Sat Jul 18 13:53:29 2020 -0400
@@ -6,14 +6,14 @@
   :license "MIT"
   :version "0.0.1"
 
-  :depends-on ()
+  :depends-on (:closer-mop)
 
   :in-order-to ((asdf:test-op (asdf:test-op :jarl/test)))
 
   :serial t
   :components ((:module "src" :serial t
                 :components ((:file "package")
-                             (:file "reference")
+                             ;; (:file "reference")
                              (:file "main")))))
 
 
diff -r a2712b3d3b16 -r 30f068e02285 src/main.lisp
--- a/src/main.lisp	Mon Jul 13 21:59:43 2020 -0400
+++ b/src/main.lisp	Sat Jul 18 13:53:29 2020 -0400
@@ -1,1 +1,618 @@
 (in-package :jarl)
+
+;;;; Notes --------------------------------------------------------------------
+;;;
+;;; Reading is implemented as a generic function read% of three arguments:
+;;;
+;;; 1. The name of the class to read.
+;;; 2. Any contained class designator, for things like (vector foo) or (nullable foo).
+;;; 3. The input struct.
+;;;
+;;; Printing is just a simple generic function of the object and a stream.
+
+
+;;;; Input --------------------------------------------------------------------
+(defstruct input
+  (stream nil :type stream)
+  (line 1 :type (and fixnum (integer 0)))
+  (column 0 :type (and fixnum (integer 0))))
+
+(defun p (input &optional (eof :eof)) ; peek
+  (peek-char nil (input-stream input) nil eof))
+
+(defun r (input) ; read
+  (let ((character (read-char (input-stream input) nil :eof)))
+    (case character
+      (#\newline (progn
+                   (incf (input-line input))
+                   (setf (input-column input) 0)))
+      (#\tab (incf (input-column input) 8))
+      (t (incf (input-column input))))
+    character))
+
+
+;;;; Errors -------------------------------------------------------------------
+(define-condition json-parsing-error (error)
+  ((line :accessor line :initarg :line)
+   (column :accessor column :initarg :column)
+   (message :accessor message :initarg :message))
+  (:report (lambda (c stream)
+             (format stream "Error parsing JSON at line ~D column ~D: ~A"
+                     (line c)
+                     (column c)
+                     (message c)))))
+
+(defun e (input format-string &rest args) ; error
+  (error 'json-parsing-error
+         :line (input-line input)
+         :column (input-column input)
+         :message (apply #'format nil format-string args)))
+
+
+;;;; Parsing Utilities --------------------------------------------------------
+(defun skip-whitespace (input)
+  (loop :for ch = (p input)
+        :while (member ch '(#\space #\tab #\newline #\linefeed #\return))
+        :do (r input)))
+
+(defun requires-escape-p (character)
+  (or (char= #\" character)
+      (char= #\\ character)
+      (<= (char-code character) #x1F)))
+
+(defun parse-literal (input literal remaining-characters)
+  (loop :for next :across remaining-characters
+        :for char = (r input)
+        :unless (eql next char)
+        :do (e input "Cannot parse literal ~S, expected ~S but got ~S" literal next char))
+  literal)
+
+(defun parse-hex-digit (input)
+  (let ((ch (r input)))
+    (if (eql :eof ch)
+      (e input "Cannot parse \\u escape sequence, got ~S." :eof)
+      (or (digit-char-p ch 16)
+          (e input "Cannot parse \\u escape sequence, ~S is not a hexadecimal digit." ch)))))
+
+(defun parse-escaped-character (input)
+  (let ((ch (r input)))
+    (case ch
+      (#\" #\")
+      (#\\ #\\)
+      (#\/ #\/)
+      (#\b #\backspace)
+      (#\f (code-char #x0C))
+      (#\n #\linefeed)
+      (#\r #\return)
+      (#\t #\tab)
+      (#\u (let ((a (parse-hex-digit input)) ; todo handle surrogate pairs
+                 (b (parse-hex-digit input))
+                 (c (parse-hex-digit input))
+                 (d (parse-hex-digit input)))
+             (code-char (+ (* a (expt 16 3)) ; todo maybe do this more portably
+                           (* b (expt 16 2))
+                           (* c (expt 16 1))
+                           (* d (expt 16 0))))))
+      (t (e input "Cannot parse string, bad escape sequence ~S ~S." #\\ ch)))))
+
+(defun parse-int (input &optional (allow-leading-zero t))
+  (loop :with i = 0
+        :with n = 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 input "Cannot parse integer, bad leading zero."))
+                   (incf n)
+                   (setf i (+ (* 10 i) digit)))
+        :finally (if (zerop n)
+                   (e input "Expected an integer.")
+                   (return (values i n)))))
+
+(defun parse-exponent (input)
+  (let* ((char (p input))
+         (sign (if (member char '(#\+ #\-))
+                 (progn (r input)
+                        (case char
+                          (#\+ 1)
+                          (#\- -1)))
+                 1)))
+    (* sign (parse-int input))))
+
+(defun parse-number (input)
+  (let ((sign 1) integer
+        (fractional 0) (fractional-length 0)
+        (exponent 0) has-exponent)
+    (when (eql #\- (p input))
+      (r input)
+      (setf sign -1))
+    (setf integer (parse-int input nil))
+    (when (eql #\. (p input))
+      (r input)
+      (setf (values fractional fractional-length) (parse-int input)))
+    (when (member (p input) '(#\e #\E))
+      (r input)
+      (setf exponent (parse-exponent input)
+            has-exponent t))
+    (if (and (zerop fractional-length) (not has-exponent))
+      (* sign integer)
+      (values
+        (coerce ;; todo make this less horrifying
+          (read-from-string (format nil "~A~D.~V,'0Dd~D"
+                                    (if (= -1 sign) #\- #\+)
+                                    integer
+                                    fractional-length
+                                    fractional
+                                    exponent))
+          'double-float)))))
+
+(defun parse-kv-separator (class input)
+  (skip-whitespace input)
+  (let ((ch (r input)))
+    (unless (eql #\: ch)
+      (e input "Cannot parse ~S, expected ~S but got ~S" class #\: ch))
+    (skip-whitespace input)))
+
+(defun json-type-of (object)
+  (typecase object
+    (integer 'integer)
+    (float 'float)
+    (t (type-of object))))
+
+
+;;;; Primitive Readers --------------------------------------------------------
+(defgeneric read% (class contained-class input))
+
+
+(defmacro defreader (class (input &optional contained-class) &body body)
+  `(defmethod read% ((class (eql ',class)) ,(or contained-class 'contained-class) (,input input))
+     (declare (ignore class ,@(unless contained-class '(contained-class))))
+     ,@body))
+
+(defreader keyword (input)
+  (let ((ch (r input)))
+    (case ch
+      (#\t (parse-literal input :true "rue"))
+      (#\f (parse-literal input :false "alse"))
+      (t (e input "Cannot parse keyword, expected ~S or ~S but got ~S." #\t #\f ch)))))
+
+(defreader null (input)
+  (let ((ch (r input)))
+    (if (eql ch #\n)
+      (parse-literal input nil "ull")
+      (e input "Cannot parse null, expected ~S but got ~S." #\n ch))))
+
+(defreader vector (input contained)
+  (let ((ch (r input)))
+    (unless (eql ch #\[)
+      (e input "Cannot parse vector, expected ~S but got ~S." #\[ ch)))
+  (skip-whitespace input)
+  ;; todo allow specialized vectors?
+  (if (eql (p input) #\])
+    (progn (r input) (vector))
+    (coerce
+      (loop
+        :with (c cc) = contained
+        :collect (read% c cc input)
+            :do (progn
+                  (skip-whitespace input)
+                  (let ((ch (r input)))
+                    (case ch
+                      (#\] (loop-finish))
+                      (#\, (skip-whitespace input))
+                      (t (e input "Cannot parse vector, expected ~S or ~S but got ~S." #\] #\, ch))))))
+      'vector)))
+
+(defreader string (input)
+  (let ((ch (r input)))
+    (unless (eql ch #\")
+      (e input "Cannot parse string, expected opening ~S but got ~S." #\" ch)))
+  (with-output-to-string (s)
+    (loop :for ch = (r input)
+          :collect (cond
+                     ((eql ch :eof) (e input "Cannot parse string, got ~S." :eof))
+                     ((eql ch #\\) (write-char (parse-escaped-character input) s))
+                     ((eql ch #\") (loop-finish))
+                     ((requires-escape-p ch) (e input "Cannot parse string, bad unescaped character ~S." ch))
+                     (t (write-char ch s))))))
+
+(defreader hash-table (input contained)
+  (let ((ch (r input)))
+    (unless (eql ch #\{)
+      (e input "Cannot parse hash table, expected ~S but got ~S." #\{ ch)))
+  (skip-whitespace input)
+  (let ((result (make-hash-table :test #'equal)))
+    (if (eql (p input) #\})
+      (r input)
+      (loop
+        :with (c cc) = contained
+        :for name = (read% 'string nil input)
+        :for sep = (parse-kv-separator 'hash-table input)
+        :for value = (progn (skip-whitespace input)
+                            (read% c cc input))
+        :do (progn
+              (setf (gethash name result) value)
+              (skip-whitespace input)
+              (let ((ch (r input)))
+                (case ch
+                  (#\} (loop-finish))
+                  (#\, (skip-whitespace input))
+                  (t (e input "Cannot parse hash table, expected ~S or ~S but got ~S." #\} #\, ch)))))))
+    result))
+
+(defreader number (input)
+  (let ((ch (p input)))
+    (unless (member ch '(#\- #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))
+      (r input) ; chomp to ensure accurate column count
+      (e input "Cannot parse number, expected digit or ~S but got ~S." #\- ch)))
+  (parse-number input))
+
+(defreader nullable (input contained)
+  (case (p input)
+    (:eof (e "Cannot parse ~S, got ~S." `(or null ,input) :eof))
+    (#\n (read% 'null nil input))
+    (t (read% (first contained) (second contained) input))))
+
+(defreader t (input)
+  (skip-whitespace input)
+  (ecase (p input)
+    (:eof (r input) (e input "Cannot parse JSON, got ~S." :eof))
+    ((#\t #\f) (read% 'keyword nil input))
+    (#\n (read% 'null nil input))
+    (#\" (read% 'string nil input))
+    (#\{ (read% 'hash-table '(t) input))
+    (#\[ (read% 'vector '(t) input))
+    ((#\- #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9) (read% 'number nil input))))
+
+
+;;;; Object Parsers -----------------------------------------------------------
+(defclass json-class (standard-class)
+  ((slot-name-to-json-name :accessor slot-name-to-json-name
+                           :initarg :slot-name-to-json-name
+                           :initform 'string-downcase)
+   (unknown-slots :accessor unknown-slots
+                  :initarg :unknown-slots
+                  :initform :discard)
+   (name-initarg-map :accessor name-initarg-map)))
+
+(defclass json-direct-slot-definition (c2mop:standard-direct-slot-definition)
+  ((json-name :initarg :json/name :accessor json-name)
+   (json-class :initarg :json/class :accessor json-class)))
+
+(defclass json-effective-slot-definition (c2mop:standard-effective-slot-definition)
+  ((json-name :initarg :json/name :accessor json-name)
+   (json-class :initarg :json/class :accessor json-class)
+   (json-initarg :accessor json-initarg)))
+
+(defmethod c2mop:direct-slot-definition-class ((class json-class) &rest initargs)
+  (declare (ignore initargs))
+  (find-class 'json-direct-slot-definition))
+
+(defmethod c2mop:effective-slot-definition-class ((class json-class) &rest initargs)
+  (declare (ignore initargs))
+  (find-class 'json-effective-slot-definition))
+
+(defmethod c2mop:compute-effective-slot-definition ((class json-class) name direct-slots)
+  (let ((eslot (call-next-method))
+        (dslot (first direct-slots))) ; todo be smarter about coalescing these
+    (setf (json-name eslot) (if (slot-boundp dslot 'json-name)
+                              (json-name dslot)
+                              (funcall (slot-name-to-json-name class) name)) ; todo make this less shitty
+          (json-class eslot) (if (slot-boundp dslot 'json-class)
+                               (canonicalize-class-designator (json-class dslot))
+                               '(t))
+          (json-initarg eslot) (gensym (format nil "json-initarg-~A" name))) ; todo nicer name
+    eslot))
+
+
+(defun json-slots (class)
+  (remove-if-not (lambda (slot) (typep slot 'json-effective-slot-definition))
+                 (c2mop:class-slots class)))
+
+(defun make-name-initarg-map (class)
+  (let* ((slots (json-slots class))
+         (result (make-hash-table :test #'equal :size (length slots))))
+    (dolist (slot slots)
+      (setf (gethash (json-name slot) result)
+            (json-initarg slot)))
+    result))
+
+(defmethod shared-initialize ((instance json-class) slot-names
+                              &rest initargs
+                              &key slot-name-to-json-name unknown-slots
+                              &allow-other-keys)
+  (apply #'call-next-method instance slot-names
+         (append
+           (when slot-name-to-json-name ; todo assert length = 1
+             (list :slot-name-to-json-name (first slot-name-to-json-name)))
+           (when unknown-slots ; todo assert length = 1
+             (list :unknown-slots (first unknown-slots)))
+           initargs))
+  instance)
+
+(defun build-reader-lambda (class)
+  ;; todo consider whether compiling a separate method for every class is REALLY
+  ;; worth it, or whether we should just do things the reflecty way like
+  ;; everyone else in the world.
+  (let ((slots (c2mop:class-slots class))
+        (class-name (class-name class)))
+    `(lambda (class contained-class input)
+       (let ((result (make-instance ',(class-name class))))
+         (let ((ch (r input)))
+           (unless (eql ch #\{)
+             (e input "Cannot parse ~S, expected ~S but got ~S." ',class-name #\{ ch)))
+         (skip-whitespace input)
+         (if (eql (p input) #\})
+           (r input)
+           (loop
+             :for name = (read% 'string nil input)
+             :for sep = (parse-kv-separator ',class-name input)
+             :do (progn
+                   (cond
+                     ,@(loop
+                        :for slot :in slots
+                        :for name = (json-name slot)
+                        :for (c cc) = (json-class slot)
+                        :collect `((string= name ,name)
+                                   (setf (slot-value result ',(c2mop:slot-definition-name slot))
+                                         (read% ',c ',cc input)))) ; todo types
+                     (t ,(ecase (unknown-slots class)
+                           (:discard `(read% t nil input)) ; todo: handle discarded keys, skip more efficiently
+                           (:error `(e input "Cannot parse ~S, got unknown object attribute ~S." ',class-name name)))))
+                   (skip-whitespace input)
+                   (let ((ch (r input)))
+                     (case ch
+                       (#\} (loop-finish))
+                       (#\, (skip-whitespace input))
+                       (t (e input "Cannot parse ~S, expected ~S or ~S but got ~S." ',class-name #\} #\, ch)))))))
+         result))))
+
+(defun make-read%-method (class)
+  (multiple-value-bind (lambda-form initargs)
+      (c2mop:make-method-lambda #'read%
+                                (first (c2mop:generic-function-methods #'read%))
+                                (build-reader-lambda class)
+                                nil)
+    (apply #'make-instance 'standard-method
+           :lambda-list '(class contained-class input)
+           :specializers (list (c2mop:intern-eql-specializer (class-name class))
+                               (find-class t)
+                               (find-class 'input))
+           :function (compile nil lambda-form)
+           initargs)))
+
+
+(defmethod c2mop:finalize-inheritance :after ((class json-class))
+  (setf (name-initarg-map class) (make-name-initarg-map class))
+  nil
+  ; todo: we may need to do things a bit differently here.  I think the MOP spec
+  ; says that the class doesn't need to be finalized until we're ready to
+  ; allocate the first instance.  but we need the read% method to be ready
+  ; *before* that, because that method is what allocates the instance!  So we
+  ; might need to do something like making the default method on read% allocate
+  ; a result instance and pass it to a call on a separate method read%%.  Sigh.
+  #+no(add-method #'read% (make-read%-method class)))
+
+(defmethod c2mop:validate-superclass ((class json-class) (superclass standard-class))
+  t)
+
+
+(defclass post ()
+  ((id :json/class number)
+   (title :json/class string)
+   (body :json/name "pingus")
+   (author :json/class user))
+  (:metaclass json-class)
+  (:unknown-slots :discard))
+
+(defclass user ()
+  ((id :type integer)
+   (name :type string)
+   (friends :type (vector integer)))
+  (:metaclass json-class))
+
+
+;; (make-instance 'post)
+
+;; (build-reader-lambda (find-class 'post))
+
+;; (find-class 'user)
+(find-class 'post)
+
+;; (make-instance 'post)
+
+;; (setf (find-class 'post) nil (find-class 'user) nil)
+
+;; (read '(vector post) (substitute #\" #\' "[{
+;;     'id': 69,
+;;     'pingus': 'oh my christ, it works!',
+;;     'author': {
+;;         'id': 101,
+;;         'name': 'sjl'
+;;     },
+;;     'wat': 1
+;;   }, {
+;;     'id': 420,
+;;     'title': 'hello, world!',
+;;     'pingus': 'incredible',
+;;     'author': {
+;;         'id': 101,
+;;         'name': 'sjl',
+;;         'friends': [1,2,3]
+;;     }
+;;   }]"))
+
+(defun parse-json-class (class-name class input)
+  (let ((ch (r input)))
+    (unless (eql ch #\{)
+      (e input "Cannot parse ~S, expected ~S but got ~S." class-name #\{ ch)))
+  (skip-whitespace input)
+  (if (eql (p input) #\})
+    (progn
+      (r input)
+      (make-instance class))
+    (loop
+      :with unknown = (first (unknown-slots class))
+      :with map = (name-initarg-map class)
+      :with init = (list)
+      :for name = (read% 'string nil input)
+      :for sep = (parse-kv-separator class-name input)
+      :for (initarg c cc) = (gethash name map)
+      :do (progn
+            (if (null initarg)
+              (ecase unknown
+                (:discard (read% t nil input))
+                (:error (e input "Cannot parse ~S, got unknown object attribute ~S." class-name name)))
+              (progn
+                (push (read% c cc input) init)
+                (push initarg init)))
+            (skip-whitespace input)
+            (let ((ch (r input)))
+              (case ch
+                (#\} (loop-finish))
+                (#\, (skip-whitespace input))
+                (t (e input "Cannot parse ~S, expected ~S or ~S but got ~S." class-name #\} #\, ch)))))
+      :finally (return (apply #'make-instance class init)))))
+
+(defmethod read% ((class-name symbol) (contained-class null) (input input))
+  (let ((class (find-class class-name nil)))
+    (typecase class
+      (json-class (parse-json-class class-name class input))
+      (null (error "Cannot find class ~S to parse JSON into." class-name))
+      (t (error "Cannot parse JSON into class ~S because it is not a ~S" class-name 'json-class)))))
+
+
+;;;; 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 stream))
+
+(defmethod print% ((thing null) stream)
+  (write-string "null" stream))
+
+(defmethod print% ((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 vector) stream)
+  (write-char #\[ stream)
+  (loop :with first = t
+        :for object :across thing
+        :do (progn (if first
+                     (setf first nil)
+                     (write-char #\, stream))
+                   (print% object stream)))
+  (write-char #\] stream))
+
+(defmethod print% ((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% name stream)
+                   (write-char #\: stream)
+                   (print% value stream)))
+  (write-char #\} stream))
+
+(defmethod print% ((thing single-float) stream)
+  (let ((*read-default-float-format* 'single-float))
+    (princ thing stream)))
+
+(defmethod print% ((thing double-float) stream)
+  (let ((*read-default-float-format* 'double-float))
+    (princ thing stream)))
+
+(defmethod print% ((thing integer) stream)
+  (format stream "~D" thing))
+
+(defmethod print% ((thing (eql :false)) stream)
+  (write-string "false" stream))
+
+(defmethod print% ((thing (eql :true)) stream)
+  (write-string "true" stream))
+
+
+(defun print (object &optional (stream *standard-output*))
+  (let ((*read-default-float-format* 'double-float)
+        (*print-base* 10))
+    (etypecase stream
+      ((or stream (eql t)) (progn (print% object stream)
+                                  (values)))
+      (null (with-output-to-string (s)
+              (print% object s))))))
+
+
+;;;; API ----------------------------------------------------------------------
+(defun canonicalize-class-designator (class-designator)
+  (flet ((fail () (error "Malformed class designator ~S" class-designator)))
+    (etypecase class-designator
+      (cons (destructuring-bind (head a &optional (b nil b?)) class-designator
+              (ecase head
+                ; (vector foo)
+                ((hash-table vector)
+                 (progn (when b? (fail))
+                        (list head (canonicalize-class-designator a))))
+                ; (or null foo)
+                (or (progn
+                      (unless b? (fail)) ; must have a second option
+                      (when (eql 'null b) (rotatef a b)) ; sort a/b
+                      (unless (eql 'null a) (fail)) ; no arbitrary ors
+                      (list 'nullable (canonicalize-class-designator b)))))))
+      (symbol (case class-designator
+                (vector '(vector (t)))
+                (hash-table '(hash-table (t)))
+                (t (list class-designator)))))))
+
+(defun ensure-stream (stream-or-string)
+  (etypecase stream-or-string
+    (stream stream-or-string)
+    (string (make-string-input-stream stream-or-string))))
+
+(defun read (class-designator stream-or-string &optional (eof-error-p t) eof)
+  (let ((input (make-input :stream (ensure-stream stream-or-string))))
+    (skip-whitespace input)
+    (if (eql :eof (p input))
+      (if eof-error-p
+        (error 'end-of-file)
+        eof)
+      (destructuring-bind (class &optional contained)
+          (canonicalize-class-designator class-designator)
+        (read% class contained input)))))
+
+
+#; Scratch --------------------------------------------------------------------
+
+(read '1 "[true, null,  false, true]")
+
+(canonicalize-class-designator 'keyword)
+
+(defclass post ()
+  ((title :type string)
+   (id :type integer)
+   (body :type string))
+  (:metaclass json-class))
+
+(defclass user ()
+  ((name :type string)
+   (id :type integer)
+   (posts :type (vector post)))
+  (:metaclass json-class))
+
+(canonicalize-type-designator '(vector keyword))
diff -r a2712b3d3b16 -r 30f068e02285 src/package.lisp
--- a/src/package.lisp	Mon Jul 13 21:59:43 2020 -0400
+++ b/src/package.lisp	Sat Jul 18 13:53:29 2020 -0400
@@ -1,5 +1,6 @@
 (defpackage :jarl
   (:use :cl)
+  (:shadow :read :print)
   (:export
     :read-json
     :print-json))