andrius
/
mes
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

mes: Support fold 3. 

* module/srfi/srfi-1.mes (fold): Support fold 3.
This commit is contained in:
Jan Nieuwenhuizen 2018-05-20 23:20:27 +02:00
parent 345d0d8413
commit 8f8a4be83d
No known key found for this signature in database
GPG Key ID: F3C1A0D9C1D65273
1 changed files with 15 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
module/srfi/srfi-1.mes
View File

@ -54,17 +54,27 @@
(define (fold proc init lst1 . rest)
(if (null? rest)
(let loop ((lst lst1) (result init))
(if (null? lst) result
(loop (cdr lst) (proc (car lst) result))))
'*FOLD-n-NOT-SUPPORTED))
(let loop ((lst1 lst1) (result init))
(if (null? lst1) result
(loop (cdr lst1) (proc (car lst1) result))))
(if (null? (cdr rest))
(let loop ((lst1 lst1) (lst2 (car rest)) (result init))
(if (or (null? lst1)
(null? lst2)) result
(loop (cdr lst1) (cdr lst2) (proc (car lst1) (car lst2) result))))
(let loop ((lst1 lst1) (lst2 (car rest)) (lst3 (cadr rest)) (result init))
(if (or (null? lst1)
(null? lst2)
(null? lst3)) result
(loop (cdr lst1) (cdr lst2) (cdr lst3) (proc (car lst1) (car lst2) (car lst3) result))))
(error "FOLD-4-NOT-SUPPORTED"))))
(define (fold-right proc init lst1 . rest)
(if (null? rest)
(let loop ((lst lst1))
(if (null? lst) init
(proc (car lst) (loop (cdr lst)))))
'*FOLD-RIGHT-n-NOT-SUPPORTED))
(error "FOLD-RIGHT-2-NOT-SUPPORTED")))
(define (unfold p f g seed . rest)
(let ((tail-gen (if (null? rest) (const '())