Fix bug with :slot access

This commit is contained in:
~keith 2022-02-22 15:35:49 +00:00
parent 914d5dfcdc
commit 7d85c12f3a
Signed by: keith
GPG Key ID: 5BEBEEAB2C73D520
1 changed files with 10 additions and 8 deletions

View File

@ -14,14 +14,16 @@
(let ((expr root)) (let ((expr root))
(loop for entry on forms (loop for entry on forms
for form = (car entry) for form = (car entry)
and prev-form = nil then form
unless (eq prev-form :slot)
do (setf expr do (setf expr
(cond ((consp form) `(,(car form) ,expr ,@(cdr form))) (cond ((consp form) `(,(car form) ,expr ,@(cdr form)))
((eq form :slot) (prog1 ((eq form :slot) (prog1 `(slot-value ,expr ',(cadr entry))
`(slot-value ,expr ',(cadr entry)) (unless (cadr entry)
(rplacd entry (cddr entry)))) (error "Missing slot name"))))
((symbolp form) `(,form ,expr)) ((symbolp form) `(,form ,expr))
(t (error "Unexpected form ~S" form)) (t (error "Unexpected form ~S" form)))))
))) ;(format t "~S => ~S~%" `(O! ,root ,@forms) expr)
expr)) expr))
(defun read-construct (stream char arg) (defun read-construct (stream char arg)