3eda0a6022fc

Remove old file
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Tue, 28 Jul 2020 22:53:58 -0400
parents b35951eca1b2
children 9e6018aa6c5d
branches/tags (none)
files jarl.asd src/reference.lisp

Changes

--- 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]")