Racket-implemented reverse', member', memv', memq'

With the JIT, the `reverse' function is significantly faster,
while the `member' variants do not really change; the main
benefit is that the operations play well with futures.

The C implementation is still used when the JIT is unavailable,
since the Racket implementations can be much slower in
interpreted mode.
This commit is contained in:
Matthew Flatt 2011-07-25 18:26:26 -04:00
parent f1160da419
commit 9ace663021
3 changed files with 42 additions and 3 deletions

View File

@ -1,7 +1,7 @@
(module base "pre-base.rkt"
(#%require "hash.rkt"
"list.rkt"
"list.rkt" ; shadows `reverse', `mem{q,v,ber}'
"string.rkt"
"stxcase-scheme.rkt"
"qqstx.rkt"

View File

@ -26,6 +26,11 @@
build-string
build-list
(rename-out [alt-reverse reverse]
[alt-memq memq]
[alt-memv memv]
[alt-member member])
compose
compose1)
@ -406,4 +411,35 @@
(mk-simple-compose app* f g))))
(values compose1 compose)))
(define alt-reverse
(if (eval-jit-enabled)
(let ([reverse
(lambda (l)
(unless (list? l) (raise-type-error 'reverse "list"))
(let loop ([a null] [l l])
(if (null? l)
a
(loop (cons (car l) a) (cdr l)))))])
reverse)
reverse))
(define-values (alt-memq alt-memv alt-member)
(if (eval-jit-enabled)
(let ()
(define-syntax-rule (mk id eq?)
(let ([id
(lambda (v orig-l)
(let loop ([ls orig-l])
(cond
[(null? ls) #f]
[(not (pair? ls))
(bad-list 'id orig-l)]
[(eq? v (car ls)) ls]
[else (loop (cdr ls))])))])
id))
(values (mk memq eq?)
(mk memv eqv?)
(mk member equal?)))
(values memq memv member)))
)

View File

@ -19,7 +19,10 @@
racket/private/promise
racket/private/cert
(only racket/private/cond old-cond)
(only racket/private/list assq assv assoc) ; shadows #%kernel bindings
;; shadows #%kernel bindings:
(only racket/private/list
assq assv assoc reverse
memq memv member)
racket/tcp
racket/udp
'#%builtin) ; so it's attached
@ -94,7 +97,7 @@
make-namespace
#%top-interaction
map for-each andmap ormap
assq assv assoc
assq assv assoc reverse memq memv member
(rename datum #%datum)
(rename mzscheme-in-stx-module-begin #%module-begin)
(rename #%module-begin #%plain-module-begin)