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

Fix functions pair-fold-right, any, and every in contrib/40.srfi/srfi/1.scm

This commit is contained in:
koba-e964 2015-07-16 21:36:47 +09:00
parent 6fdd5ef05d
commit c18c12f197
1 changed files with 5 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
contrib/40.srfi/srfi/1.scm
View File

@ -315,8 +315,7 @@
(let rec ((clist clist) (cont values)) (let rec ((clist clist) (cont values))
(if (null? clist) (if (null? clist)
(cont knil) (cont knil)
(let ((tail (map cdr clists))) (rec (cdr clist) (lambda (x) (cont (kons clist x))))))
(rec tail (lambda (x) (cont (kons clist x)))))))
(let rec ((clists (cons clist clists)) (cont values)) (let rec ((clists (cons clist clists)) (cont values))
(if (every pair? clists) (if (every pair? clists)
(let ((tail (map cdr clists))) (let ((tail (map cdr clists)))
@ -497,11 +496,11 @@
(define (any pred clist . clists) (define (any pred clist . clists)
(if (null? clists) (if (null? clists)
(let rec ((clist clist)) (let rec ((clist clist))
(if (pair? clist) (and (pair? clist)
(or (pred (car clist)) (or (pred (car clist))
(rec (cdr clist))))) (rec (cdr clist)))))
(let rec ((clists (cons clist clists))) (let rec ((clists (cons clist clists)))
(if (every pair? clists) (and (every pair? clists)
(or (apply pred (map car clists)) (or (apply pred (map car clists))
(rec (map cdr clists))))))) (rec (map cdr clists)))))))
@ -510,11 +509,11 @@
(if (null? clists) (if (null? clists)
(let rec ((clist clist)) (let rec ((clist clist))
(or (null? clist) (or (null? clist)
(if (pred (car clist)) (and (pred (car clist))
(rec (cdr clist))))) (rec (cdr clist)))))
(let rec ((clists (cons clist clists))) (let rec ((clists (cons clist clists)))
(or (any null? clists) (or (any null? clists)
(if (apply pred (map car clists)) (and (apply pred (map car clists))
(rec (map cdr clists)))))))) (rec (map cdr clists))))))))
(define (list-index pred clist . clists) (define (list-index pred clist . clists)