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

.

Browse Source 
original commit: f9435f648256d35972c860a803dac03039813634
This commit is contained in:
Matthew Flatt 2001-11-01 16:31:11 +00:00
parent aad709e4da
commit 21f577da9a
1 changed files with 16 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
collects/mzlib/list.ss
View File

@ -220,9 +220,20 @@
(format "~a: second argument must be a (proper) list; given ~e" name list) (format "~a: second argument must be a (proper) list; given ~e" name list)
(current-continuation-marks) (current-continuation-marks)
list))] list))]
[(f (car l)) (if whole-list? l (car l))] [else (let ([a (car l)])
[else (loop (cdr l))])))))) (if whole-list?
(if (f a)
l
(loop (cdr l)))
(if (pair? a)
(if (f (car a))
a
(loop (cdr l)))
(raise-mismatch-error
name
"found a non-pair in the list: "
a))))]))))))
(define assf (define assf
(let ([a (make-find 'assf #f)]) (let ([a (make-find 'assf #f)])
(polymorphic (polymorphic
@ -249,11 +260,9 @@
(if keep? (if keep?
(cons (car l) (loop (cdr l))) (cons (car l) (loop (cdr l)))
(loop (cdr l))))] (loop (cdr l))))]
[else (raise-type-error [else (raise-mismatch-error
'filter 'filter
"proper list" "expects a proper list: "
1 ; i.e., 2nd argument
f
list)]))))) list)])))))
(define first (polymorphic (lambda (x) (define first (polymorphic (lambda (x)