mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-30 23:10:21 +02:00
Code Activity

Return correct value for setq form.

Browse source 
* 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:
Daniel Kraft 2009-07-18 17:58:01 +02:00
parent 9b5ff6a6e1
commit 570c12aca7
2 changed files with 23 additions and 16 deletions
Download patch file Download diff file Expand all files Collapse all files

30
module/language/elisp/compile-tree-il.scm
View file

@ -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.

9
test-suite/tests/elisp-compiler.test
View file

@ -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*"