suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix sort, improved filter, and fixed another bunch of applications

Browse Source 
svn: r7407
This commit is contained in:
Eli Barzilay 2007-09-24 21:17:49 +00:00
parent 22c89205df
commit beba8aa2d0
1 changed files with 23 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
collects/lazy/lazy.ss
View File

@ -599,7 +599,7 @@
(cond [(null? list) list] (cond [(null? list) list]
[(not (pair? list)) [(not (pair? list))
(error name "not a proper list: ~e" 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)))))])))) [else (cons (car list) (~ (loop (! (cdr list)))))]))))
(define* remove (define* remove
(case-lambda [(item list ) (do-remove 'remove item list ~equal?)] (case-lambda [(item list ) (do-remove 'remove item list ~equal?)]
@ -613,8 +613,9 @@
(cond [(null? list) list] (cond [(null? list) list]
[(not (pair? list)) [(not (pair? list))
(error name "not a proper list: ~e" list)] (error name "not a proper list: ~e" list)]
[else (let ([xs (~ (loop (! (cdr list))))]) [else
(if (memf (lambda (item) (= item (car list))) items) (let ([xs (~ (loop (! (cdr list))))])
(if (memf (lambda (item) (!*app = item (car list))) items)
xs xs
(cons (car list) xs)))])))) (cons (car list) xs)))]))))
(define* remove* (define* remove*
@ -628,7 +629,7 @@
(let loop ([list (! list)]) (let loop ([list (! list)])
(cond [(null? list) #f] (cond [(null? list) #f]
[(not (pair? list)) (error 'memf "not a proper list: ~e" list)] [(not (pair? list)) (error 'memf "not a proper list: ~e" list)]
[(pred (! (car list))) list] [(!*app pred (car list)) list]
[else (loop (! (cdr list)))])))) [else (loop (! (cdr list)))]))))
(define* (assf pred alist) (define* (assf pred alist)
@ -639,20 +640,23 @@
[else (let ([cell (! (car alist))]) [else (let ([cell (! (car alist))])
(cond [(not (pair? cell)) (cond [(not (pair? cell))
(error 'assf "non-pair found in list: ~e" cell)] (error 'assf "non-pair found in list: ~e" cell)]
[(pred (! (car cell))) cell] [(!*app pred (car cell)) cell]
[else (loop (! (cdr alist)))]))])))) [else (loop (! (cdr alist)))]))]))))
(define* (filter pred list) (define* (filter pred list)
(let ([pred (! pred)])
(let loop ([list (! list)]) (let loop ([list (! list)])
(cond ([null? list] list) (cond [(null? list) list]
([pair? list] [(pair? list)
(let ([x (! (car list))] [xs (~ (loop (! (cdr list))))]) (let ([x (car list)]
(if (! (pred x)) (cons x xs) xs))) [xs (~ (loop (! (cdr list))))])
(else (error 'filter "not a proper list: ~e" 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)) (require (rename (lib "list.ss") !sort sort))
(define* (sort list less-than) (define* (sort list less?)
(!sort (!list list) (! less-than))) (let ([less? (! less?)])
(!sort (!list list) (lambda (x y) (! (!*app less? x y))))))
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
;; (lib "etc.ss") functionality ;; (lib "etc.ss") functionality