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