From 9ace663021bf02b09b9952e6939d15f45ecfe427 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Mon, 25 Jul 2011 18:26:26 -0400
Subject: [PATCH] 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.
---
 collects/racket/private/base.rkt |  2 +-
 collects/racket/private/list.rkt | 36 ++++++++++++++++++++++++++++++++
 collects/scheme/mzscheme.rkt     |  7 +++++--
 3 files changed, 42 insertions(+), 3 deletions(-)

diff --git a/collects/racket/private/base.rkt b/collects/racket/private/base.rkt
index b068d32e09..dbbc48652a 100644
--- a/collects/racket/private/base.rkt
+++ b/collects/racket/private/base.rkt
@@ -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"
diff --git a/collects/racket/private/list.rkt b/collects/racket/private/list.rkt
index 3598c93edd..49f8bc4b74 100644
--- a/collects/racket/private/list.rkt
+++ b/collects/racket/private/list.rkt
@@ -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)))
+
   )
diff --git a/collects/scheme/mzscheme.rkt b/collects/scheme/mzscheme.rkt
index 20176849ed..fe281c24d5 100644
--- a/collects/scheme/mzscheme.rkt
+++ b/collects/scheme/mzscheme.rkt
@@ -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)