conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

* Added filter.

This commit is contained in:
Abdulaziz Ghuloum 2007-09-10 17:03:40 -04:00
parent 4b83f21480
commit 66541809e1
4 changed files with 13 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
src/ikarus.boot
View File

Binary file not shown.

12
src/ikarus.lists.ss
View File

@ -2,13 +2,13 @@
(library (ikarus lists) (library (ikarus lists)
(export $memq list? list cons* make-list append length list-ref reverse (export $memq list? list cons* make-list append length list-ref reverse
last-pair memq memp memv member assq assp assv assoc last-pair memq memp memv member assq assp assv assoc
remq remv remove remp map for-each andmap ormap list-tail) remq remv remove remp filter map for-each andmap ormap list-tail)
(import (import
(ikarus system $fx) (ikarus system $fx)
(ikarus system $pairs) (ikarus system $pairs)
(except (ikarus) list? list cons* make-list append reverse (except (ikarus) list? list cons* make-list append reverse
last-pair length list-ref memq memp memv member assq last-pair length list-ref memq memp memv member assq
assp assv assoc remq remv remove remp assp assv assoc remq remv remove remp filter
map for-each andmap ormap list-tail)) map for-each andmap ormap list-tail))
(define $memq (define $memq
@ -391,7 +391,7 @@
(race x ls ls ls)))) (race x ls ls ls))))
(module (remq remv remove remp) (module (remq remv remove remp filter)
(define-syntax define-remover (define-syntax define-remover
(syntax-rules () (syntax-rules ()
[(_ name cmp check) [(_ name cmp check)
@ -432,7 +432,11 @@
(define-remover remp (lambda (elt p) (p elt)) (define-remover remp (lambda (elt p) (p elt))
(lambda (x ls) (lambda (x ls)
(unless (procedure? x) (unless (procedure? x)
(error 'remp "~s is not a procedure" x))))) (error 'remp "~s is not a procedure" x))))
(define-remover filter (lambda (elt p) (not (p elt)))
(lambda (x ls)
(unless (procedure? x)
(error 'filter "~s is not a procedure" x)))))
(module (map) (module (map)

1
src/makefile.ss
View File

@ -332,6 +332,7 @@
[remp i] [remp i]
[remv i] [remv i]
[remove i] [remove i]
[filter i]
[list-sort i] [list-sort i]
[vector-sort i] [vector-sort i]
[vector-sort! i] [vector-sort! i]

14
src/todo-r6rs.ss
View File

@ -504,7 +504,7 @@
[assq C ls se] [assq C ls se]
[assv C ls se] [assv C ls se]
[cons* C ls] [cons* C ls]
[filter S ls] [filter C ls]
[find S ls] [find S ls]
[fold-left S ls] [fold-left S ls]
[fold-right S ls] [fold-right S ls]
@ -516,9 +516,9 @@
[memv C ls se] [memv C ls se]
[partition S ls] [partition S ls]
[remq C ls] [remq C ls]
[remp S ls] [remp C ls]
[remv S ls] [remv C ls]
[remove S ls] [remove C ls]
;;; ;;;
[set-car! C mp se] [set-car! C mp se]
[set-cdr! C mp se] [set-cdr! C mp se]
@ -792,12 +792,6 @@
libs)))) libs))))
(error #f "invalid id ~s" x))) (error #f "invalid id ~s" x)))
(define (filter p? ls)
(cond
[(null? ls) '()]
[(p? (car ls))
(cons (car ls) (filter p? (cdr ls)))]
[else (filter p? (cdr ls))]))
(define (filter* ls) (define (filter* ls)
(filter (filter