Skip to content

Commit

Permalink
Fix compiler bug on previously seen keywords
Browse files Browse the repository at this point in the history
I previously fixed this for subsequent keywords, but the first
keyword still went through literal-index rather than
new-literal-index, so oops. Reported by beach on #sicl.

This code isn't the most elegant but tests pass so hey.

TODO: Add a new test. The problem can be seen by compiling
(list :foo '(8) (lambda (&key foo bar) ...))
The lambda will expect (8) as a key instead of bar.
  • Loading branch information
Bike committed Jul 13, 2024
1 parent ffa1f24 commit 11c5f74
Showing 1 changed file with 10 additions and 8 deletions.
18 changes: 10 additions & 8 deletions compile/compile.lisp
Original file line number Diff line number Diff line change
Expand Up @@ -370,12 +370,12 @@
(defun emit-const (context index) (assemble context m:const index))
(defun emit-fdefinition (context index) (assemble context m:fdefinition index))

(defun emit-parse-key-args (context max-count key-count key-names aok-p)
(defun emit-parse-key-args (context max-count key-count key-literal-start aok-p)
;; Because of the key-count encoding, we have to special case long a bit.
(let ((frame-end (context-frame-end context))
(lit (if (zerop key-count) ; don't need a literal then
0
(literal-index (first key-names) context))))
key-literal-start)))
(cond ((and (< max-count #.(ash 1 8)) (< key-count #.(ash 1 7))
(< lit #.(ash 1 8)) (< frame-end #.(ash 1 8)))
(assemble context m:parse-key-args
Expand Down Expand Up @@ -1640,12 +1640,14 @@
(when key-p
;; Generate code to parse the key args. As with optionals, we don't do
;; defaulting yet.
(let ((key-names (mapcar #'caar keys)))
(emit-parse-key-args context max-count key-count key-names aok-p)
;; emit-parse-key-args establishes the first key in the literals.
;; now do the rest.
(dolist (key-name (rest key-names))
(new-literal-index key-name context)))
(let ((key-literal-start nil))
;; Generate fresh indices for each keyword, to ensure they're
;; contiguous.
(dolist (key keys)
(let ((i (new-literal-index (caar key) context)))
(unless key-literal-start (setf key-literal-start i))))
(emit-parse-key-args context
max-count key-count key-literal-start aok-p))
(let ((keyvars (mapcar #'cadar keys)))
(setf (values new-env context)
(bind-vars keyvars new-env context))
Expand Down

0 comments on commit 11c5f74

Please sign in to comment.