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

add memv, assv, member, and assoc

This commit is contained in:
Yuichi Nishiwaki 2013-11-09 16:45:04 +09:00
parent c211d9ffde
commit 71b0f8c686
1 changed files with 29 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
piclib/built-in.scm
View File

@ -104,6 +104,13 @@
list list
(memq obj (cdr list))))) (memq obj (cdr list)))))
(define (memv obj list)
(if (null? list)
#f
(if (eqv? obj (car list))
list
(memq obj (cdr list)))))
(define (assq obj list) (define (assq obj list)
(if (null? list) (if (null? list)
#f #f
@ -111,6 +118,13 @@
(car list) (car list)
(assq obj (cdr list))))) (assq obj (cdr list)))))
(define (assv obj list)
(if (null? list)
#f
(if (eqv? obj (caar list))
(car list)
(assq obj (cdr list)))))
(define (list-copy obj) (define (list-copy obj)
(if (null? obj) (if (null? obj)
obj obj
@ -183,3 +197,18 @@
(else (else
#f))) #f)))
(define (member obj list . opts)
(let ((compare (if (null? opts) equal? (car opts))))
(if (null? list)
#f
(if (compare obj (car list))
list
(member obj (cdr list) compare)))))
(define (assoc obj list . opts)
(let ((compare (if (null? opts) equal? (car opts))))
(if (null? list)
#f
(if (compare obj (caar list))
(car list)
(assoc obj (cdr list) compare)))))