mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-18 18:40:22 +02:00
Code Activity

setq can take any number of arguments

Browse source 
* module/language/elisp/compile-tree-il.scm (compile-setq): Return nil
  if called with no arguments, and set the last variable to nil if its
  value is omitted.
This commit is contained in:
Brian Templeton 2010-07-10 02:47:16 -04:00
parent 3b93c9b881
commit 46ab7225d5
1 changed files with 16 additions and 29 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -694,36 +694,23 @@
(make-const loc sym))))))) (make-const loc sym)))))))
(defspecial setq (loc args) (defspecial setq (loc args)
(define (car* x) (if (null? x) '() (car x)))
(define (cdr* x) (if (null? x) '() (cdr x)))
(define (cadr* x) (car* (cdr* x)))
(define (cddr* x) (cdr* (cdr* x)))
(make-sequence (make-sequence
loc loc
(let iterate ((tail args)) (let loop ((args args) (last (nil-value loc)))
(let ((sym (car tail)) (if (null? args)
(tailtail (cdr tail))) (list last)
(let ((sym (car args))
(val (compile-expr (cadr* args))))
(if (not (symbol? sym)) (if (not (symbol? sym))
(report-error loc "expected symbol in setq") (report-error loc "expected symbol in setq")
(if (null? tailtail) (cons
(report-error loc (set-variable! loc sym value-slot val)
"missing value for symbol in setq" (loop (cddr* args)
sym) (reference-variable loc sym value-slot)))))))))
(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)))))))))))
(defspecial let (loc args) (defspecial let (loc args)
(pmatch args (pmatch args