mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 11:50:28 +02:00
Code Activity

Use values\' and call-with-values\'.

Browse source
This commit is contained in:
Keisuke Nishida 2000-10-06 00:39:44 +00:00
parent a56b30ccd1
commit eef3cc8cda
1 changed files with 12 additions and 13 deletions
Download patch file Download diff file Expand all files Collapse all files

25
vm/compile.scm
View file

@ -106,30 +106,29 @@
(make-code:constant env (car args)))
(define (canon-formals formals)
;; foo -> (() . foo)
;; (foo bar baz) -> ((foo bar baz) . #f)
;; (foo bar . baz) -> ((foo bar) . baz)
;; foo -> (), foo
;; (foo bar baz) -> (foo bar baz), #f
;; (foo bar . baz) -> (foo bar), baz
(cond ((symbol? formals)
(cons '() formals))
(values '() formals))
((or (null? formals)
(null? (cdr (last-pair formals))))
(cons formals #f))
(values formals #f))
(else
(let* ((copy (list-copy formals))
(pair (last-pair copy))
(last (cdr pair)))
(set-cdr! pair '())
(cons copy last)))))
(values copy last)))))
(define (parse-lambda args env)
(let ((formals (car args)) (body (cdr args)))
(let* ((pair (canon-formals formals))
(reqs (car pair))
(rest (cdr pair))
(syms (append reqs (if rest (list rest) '())))
(new-env (make-env syms env)))
(make-code:program env (length reqs) (if rest #t #f)
(parse-begin body new-env)))))
(call-with-values (lambda () (canon-formals formals))
(lambda (reqs rest)
(let* ((syms (append reqs (if rest (list rest) '())))
(new-env (make-env syms env)))
(make-code:program env (length reqs) (if rest #t #f)
(parse-begin body new-env)))))))
(define (parse-set! args env)
(let ((var (env-ref env (car args)))