Fix slot map/alist initialization
Instead of doing this on `finalize-inheritance`, do it after `compute-slots`.
I swear, sometimes using the MOP feels like playing whack-a-mole.
Also adds another real-world test case.
author |
Steve Losh <steve@stevelosh.com> |
date |
Mon, 31 Aug 2020 22:18:48 -0400 |
parents |
2a95e54cdcac |
children |
(none) |
(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))