mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-07-02 23:50:47 +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 ; 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 ; tail recursive because it is clearer this way and large lists of symbol
; expression pairs are very unlikely. ; expression pairs are very unlikely.
((setq . ,args) ((setq . ,args) (guard (not (null? args)))
(make-sequence loc (make-sequence loc
(let iterate ((tail args)) (let iterate ((tail args))
(if (null? tail) (let ((sym (car tail))
(list (make-void loc)) (tailtail (cdr tail)))
(let ((sym (car tail)) (if (not (symbol? sym))
(tailtail (cdr tail))) (report-error loc "expected symbol in setq")
(if (not (symbol? sym)) (if (null? tailtail)
(report-error loc "expected symbol in setq") (report-error loc "missing value for symbol in setq" sym)
(if (null? tailtail) (let* ((val (compile-expr (car tailtail)))
(report-error loc "missing value for symbol in setq" sym) (op (set-variable! loc sym value-slot val)))
(let* ((val (compile-expr (car tailtail))) (if (null? (cdr tailtail))
(op (set-variable! loc sym value-slot val))) (let* ((temp (gensym))
(cons op (iterate (cdr tailtail))))))))))) (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 ; Let is done with a single call to with-fluids* binding them locally to new
; values. ; values.

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

@ -112,10 +112,11 @@
; TODO: Check for variable-void error ; TODO: Check for variable-void error
(pass-if-equal "setq and reference" 6 (pass-if-equal "setq and reference" 6
(progn (setq a 1 (progn (setq a 1 b 2 c 3)
b 2 (+ a b c)))
c 3)
(+ a b c)))) (pass-if-equal "setq value" 2
(progn (setq a 1 b 2))))
(with-test-prefix/compile "Let and Let*" (with-test-prefix/compile "Let and Let*"