mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-29 22:40:34 +02:00
Return correct value for setq form.
* module/language/elisp/compile-tree-il.scm: Fix implementation of setq. * test-suite/tests/elisp-compiler.test: Check for value of setq form.
This commit is contained in:
parent
9b5ff6a6e1
commit
570c12aca7
2 changed files with 23 additions and 16 deletions
|
@ -464,20 +464,26 @@
|
|||
; Build a set form for possibly multiple values. The code is not formulated
|
||||
; tail recursive because it is clearer this way and large lists of symbol
|
||||
; expression pairs are very unlikely.
|
||||
((setq . ,args)
|
||||
((setq . ,args) (guard (not (null? args)))
|
||||
(make-sequence loc
|
||||
(let iterate ((tail args))
|
||||
(if (null? tail)
|
||||
(list (make-void loc))
|
||||
(let ((sym (car tail))
|
||||
(tailtail (cdr tail)))
|
||||
(if (not (symbol? sym))
|
||||
(report-error loc "expected symbol in setq")
|
||||
(if (null? tailtail)
|
||||
(report-error loc "missing value for symbol in setq" sym)
|
||||
(let* ((val (compile-expr (car tailtail)))
|
||||
(op (set-variable! loc sym value-slot val)))
|
||||
(cons op (iterate (cdr tailtail)))))))))))
|
||||
(let ((sym (car tail))
|
||||
(tailtail (cdr tail)))
|
||||
(if (not (symbol? sym))
|
||||
(report-error loc "expected symbol in setq")
|
||||
(if (null? tailtail)
|
||||
(report-error loc "missing value for symbol in setq" sym)
|
||||
(let* ((val (compile-expr (car tailtail)))
|
||||
(op (set-variable! loc sym value-slot val)))
|
||||
(if (null? (cdr tailtail))
|
||||
(let* ((temp (gensym))
|
||||
(ref (make-lexical-ref loc temp temp)))
|
||||
(list (make-let loc `(,temp) `(,temp) `(,val)
|
||||
(make-sequence loc
|
||||
(list (set-variable! loc sym value-slot ref)
|
||||
ref)))))
|
||||
(cons (set-variable! loc sym value-slot val)
|
||||
(iterate (cdr tailtail)))))))))))
|
||||
|
||||
; Let is done with a single call to with-fluids* binding them locally to new
|
||||
; values.
|
||||
|
|
|
@ -112,10 +112,11 @@
|
|||
; TODO: Check for variable-void error
|
||||
|
||||
(pass-if-equal "setq and reference" 6
|
||||
(progn (setq a 1
|
||||
b 2
|
||||
c 3)
|
||||
(+ a b c))))
|
||||
(progn (setq a 1 b 2 c 3)
|
||||
(+ a b c)))
|
||||
|
||||
(pass-if-equal "setq value" 2
|
||||
(progn (setq a 1 b 2))))
|
||||
|
||||
(with-test-prefix/compile "Let and Let*"
|
||||
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue