* call-with-values where the second argument is a single-value

procedure is now direct-call-optimized.
This commit is contained in:
Abdulaziz Ghuloum 2007-01-26 10:23:07 -05:00
parent 8139a91a61
commit 126b7aa8fa
5 changed files with 25 additions and 2 deletions

Binary file not shown.

View File

@ -487,6 +487,16 @@
(record-case info
[(case-info L args proper) proper])]))]
[else #f]))
(define (single-value-consumer? x)
(record-case x
[(clambda L cases F)
(and (fx= (length cases) 1)
(record-case (car cases)
[(clambda-case info body)
(record-case info
[(case-info L args proper)
(and proper (fx= (length args) 1))])]))]
[else #f]))
(define (valid-mv-producer? x)
(record-case x
[(funcall) #t]
@ -507,6 +517,8 @@
(let ([producer (inline (car rand*) '())]
[consumer (cadr rand*)])
(cond
[(single-value-consumer? consumer)
(inline consumer (list producer))]
[(and (valid-mv-consumer? consumer)
(valid-mv-producer? producer))
(make-mvcall producer consumer)]

View File

@ -1597,8 +1597,11 @@ reference-implementation:
(revcons (reverse ls ls ls '())
(append ($car ls*) ($cdr ls*)))])))
(primitive-set! 'append
(lambda (ls . ls*)
(append ls ls*))))
(case-lambda
[() '()]
[(ls) ls]
[(ls . ls*)
(append ls ls*)])))
(primitive-set! 'list->vector

View File

@ -26,6 +26,7 @@
syntax quasisyntax unsyntax unsyntax-splicing datum
let let* let-values cond case define-record or and when unless do
include parameterize trace untrace trace-lambda trace-define
rec
time))

View File

@ -4676,3 +4676,10 @@
[(_ expr)
#'(time-it (lambda () expr) 'expr)])))
(define-syntax rec
(lambda (x)
(syntax-case x ()
[(_ name proc) (identifier? #'name)
#'(letrec ([name proc])
name)])))