From beba8aa2d09171846e85fbb9b2371601b220a906 Mon Sep 17 00:00:00 2001
From: Eli Barzilay <eli@racket-lang.org>
Date: Mon, 24 Sep 2007 21:17:49 +0000
Subject: [PATCH] fix sort, improved filter, and fixed another bunch of
 applications

svn: r7407
---
 collects/lazy/lazy.ss | 42 +++++++++++++++++++++++-------------------
 1 file changed, 23 insertions(+), 19 deletions(-)

diff --git a/collects/lazy/lazy.ss b/collects/lazy/lazy.ss
index 8ef5876e26..5b6ef0f157 100644
--- a/collects/lazy/lazy.ss
+++ b/collects/lazy/lazy.ss
@@ -599,13 +599,13 @@
         (cond [(null? list) list]
               [(not (pair? list))
                (error name "not a proper list: ~e" list)]
-              [(= item (car list)) (cdr list)]
+              [(!*app = item (car list)) (cdr list)]
               [else (cons (car list) (~ (loop (! (cdr list)))))]))))
   (define* remove
     (case-lambda [(item list  ) (do-remove 'remove item list ~equal?)]
                  [(item list =) (do-remove 'remove item list =)]))
-  (define* (remq item list)      (do-remove 'remq   item list ~eq?))
-  (define* (remv item list)      (do-remove 'remv   item list ~eqv?))
+  (define* (remq item list)     (do-remove 'remq   item list ~eq?))
+  (define* (remv item list)     (do-remove 'remv   item list ~eqv?))
 
   (define (do-remove* name items list =)
     (let ([= (! =)] [items (!list items)])
@@ -613,22 +613,23 @@
         (cond [(null? list) list]
               [(not (pair? list))
                (error name "not a proper list: ~e" list)]
-              [else (let ([xs (~ (loop (! (cdr list))))])
-                      (if (memf (lambda (item) (= item (car list))) items)
-                        xs
-                        (cons (car list) xs)))]))))
+              [else
+               (let ([xs (~ (loop (! (cdr list))))])
+                 (if (memf (lambda (item) (!*app = item (car list))) items)
+                   xs
+                   (cons (car list) xs)))]))))
   (define* remove*
     (case-lambda [(items list  ) (do-remove* 'remove* items list ~equal?)]
                  [(items list =) (do-remove* 'remove* items list =)]))
-  (define* (remq* items list)     (do-remove* 'remq*   items list ~eq?))
-  (define* (remv* items list)     (do-remove* 'remv*   items list ~eqv?))
+  (define* (remq* items list)    (do-remove* 'remq*   items list ~eq?))
+  (define* (remv* items list)    (do-remove* 'remv*   items list ~eqv?))
 
   (define* (memf pred list)
     (let ([pred (! pred)])
       (let loop ([list (! list)])
         (cond [(null? list) #f]
               [(not (pair? list)) (error 'memf "not a proper list: ~e" list)]
-              [(pred (! (car list))) list]
+              [(!*app pred (car list)) list]
               [else (loop (! (cdr list)))]))))
 
   (define* (assf pred alist)
@@ -639,20 +640,23 @@
               [else (let ([cell (! (car alist))])
                       (cond [(not (pair? cell))
                              (error 'assf "non-pair found in list: ~e" cell)]
-                            [(pred (! (car cell))) cell]
+                            [(!*app pred (car cell)) cell]
                             [else (loop (! (cdr alist)))]))]))))
 
   (define* (filter pred list)
-    (let loop ([list (! list)])
-      (cond ([null? list] list)
-            ([pair? list]
-             (let ([x (! (car list))] [xs (~ (loop (! (cdr list))))])
-               (if (! (pred x)) (cons x xs) xs)))
-            (else (error 'filter "not a proper list: ~e" list)))))
+    (let ([pred (! pred)])
+      (let loop ([list (! list)])
+        (cond [(null? list) list]
+              [(pair? list)
+               (let ([x (car list)]
+                     [xs (~ (loop (! (cdr list))))])
+                 (if (!*app pred x) (cons x xs) xs))]
+              [else (error 'filter "not a proper list: ~e" list)]))))
 
   (require (rename (lib "list.ss") !sort sort))
-  (define* (sort list less-than)
-    (!sort (!list list) (! less-than)))
+  (define* (sort list less?)
+    (let ([less? (! less?)])
+      (!sort (!list list) (lambda (x y) (! (!*app less? x y))))))
 
   ;; --------------------------------------------------------------------------
   ;; (lib "etc.ss") functionality