mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-18 10:10:23 +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

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

@ -694,37 +694,24 @@
(make-const loc sym)))))))
(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
loc
(let iterate ((tail args))
(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 loop ((args args) (last (nil-value loc)))
(if (null? args)
(list last)
(let ((sym (car args))
(val (compile-expr (cadr* args))))
(if (not (symbol? sym))
(report-error loc "expected symbol in setq")
(cons
(set-variable! loc sym value-slot val)
(loop (cddr* args)
(reference-variable loc sym value-slot)))))))))
(defspecial let (loc args)
(pmatch args
((,bindings . ,body)