mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 20:00:19 +02:00
Use values\' and
call-with-values\'.
This commit is contained in:
parent
a56b30ccd1
commit
eef3cc8cda
1 changed files with 12 additions and 13 deletions
|
@ -106,30 +106,29 @@
|
||||||
(make-code:constant env (car args)))
|
(make-code:constant env (car args)))
|
||||||
|
|
||||||
(define (canon-formals formals)
|
(define (canon-formals formals)
|
||||||
;; foo -> (() . foo)
|
;; foo -> (), foo
|
||||||
;; (foo bar baz) -> ((foo bar baz) . #f)
|
;; (foo bar baz) -> (foo bar baz), #f
|
||||||
;; (foo bar . baz) -> ((foo bar) . baz)
|
;; (foo bar . baz) -> (foo bar), baz
|
||||||
(cond ((symbol? formals)
|
(cond ((symbol? formals)
|
||||||
(cons '() formals))
|
(values '() formals))
|
||||||
((or (null? formals)
|
((or (null? formals)
|
||||||
(null? (cdr (last-pair formals))))
|
(null? (cdr (last-pair formals))))
|
||||||
(cons formals #f))
|
(values formals #f))
|
||||||
(else
|
(else
|
||||||
(let* ((copy (list-copy formals))
|
(let* ((copy (list-copy formals))
|
||||||
(pair (last-pair copy))
|
(pair (last-pair copy))
|
||||||
(last (cdr pair)))
|
(last (cdr pair)))
|
||||||
(set-cdr! pair '())
|
(set-cdr! pair '())
|
||||||
(cons copy last)))))
|
(values copy last)))))
|
||||||
|
|
||||||
(define (parse-lambda args env)
|
(define (parse-lambda args env)
|
||||||
(let ((formals (car args)) (body (cdr args)))
|
(let ((formals (car args)) (body (cdr args)))
|
||||||
(let* ((pair (canon-formals formals))
|
(call-with-values (lambda () (canon-formals formals))
|
||||||
(reqs (car pair))
|
(lambda (reqs rest)
|
||||||
(rest (cdr pair))
|
(let* ((syms (append reqs (if rest (list rest) '())))
|
||||||
(syms (append reqs (if rest (list rest) '())))
|
|
||||||
(new-env (make-env syms env)))
|
(new-env (make-env syms env)))
|
||||||
(make-code:program env (length reqs) (if rest #t #f)
|
(make-code:program env (length reqs) (if rest #t #f)
|
||||||
(parse-begin body new-env)))))
|
(parse-begin body new-env)))))))
|
||||||
|
|
||||||
(define (parse-set! args env)
|
(define (parse-set! args env)
|
||||||
(let ((var (env-ref env (car args)))
|
(let ((var (env-ref env (car args)))
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue