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

* Added find.

This commit is contained in:
Abdulaziz Ghuloum 2007-09-10 17:09:19 -04:00
parent 66541809e1
commit dd968d389d
4 changed files with 30 additions and 4 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.

31
src/ikarus.lists.ss
View File

@ -1,14 +1,14 @@
(library (ikarus lists)
(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 find assq assp assv assoc
remq remv remove remp filter map for-each andmap ormap list-tail)
(import
(ikarus system $fx)
(ikarus system $pairs)
(except (ikarus) list? list cons* make-list append reverse
last-pair length list-ref memq memp memv member assq
assp assv assoc remq remv remove remp filter
last-pair length list-ref memq memp memv member find
assq assp assv assoc remq remv remove remp filter
map for-each andmap ormap list-tail))
(define $memq
@ -274,6 +274,31 @@
(error 'memp "~s is not a procedure" p))
(race ls ls ls p))))
(define find
(letrec ([race
(lambda (h t ls p)
(if (pair? h)
(let ([a ($car h)])
(if (p a)
a
(let ([h ($cdr h)])
(if (pair? h)
(let ([a ($car h)])
(if (p a)
a
(if (not (eq? h t))
(race ($cdr h) ($cdr t) ls p)
(error 'find "circular list ~s" ls))))
(if (null? h)
'#f
(error 'find "~s is not a proper list" ls))))))
(if (null? h)
'#f
(error 'find "~s is not a proper list" ls))))])
(lambda (p ls)
(unless (procedure? p)
(error 'find "~s is not a procedure" p))
(race ls ls ls p))))
(define assq
(letrec ([race

1
src/makefile.ss
View File

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

2
src/todo-r6rs.ss
View File

@ -505,7 +505,7 @@
[assv C ls se]
[cons* C ls]
[filter C ls]
[find S ls]
[find C ls]
[fold-left S ls]
[fold-right S ls]
[for-all S ls]