Return correct value for setq form.
authorDaniel Kraft <d@domob.eu>
Sat, 18 Jul 2009 15:58:01 +0000 (17:58 +0200)
committerDaniel Kraft <d@domob.eu>
Sat, 18 Jul 2009 15:58:01 +0000 (17:58 +0200)
* module/language/elisp/compile-tree-il.scm: Fix implementation of setq.
* test-suite/tests/elisp-compiler.test: Check for value of setq form.

module/language/elisp/compile-tree-il.scm
test-suite/tests/elisp-compiler.test

index d09bbbc..815f5f6 100644 (file)
     ; 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.
index b77cbd3..1705a97 100644 (file)
   ; 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*"