artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

mes: filter-map: Handle two lists.

Browse source 
* module/srfi/srfi-1.mes (filter-map): Handle two lists, add error
  when called with three or more.
This commit is contained in:
Jan Nieuwenhuizen 2018-04-29 18:29:26 +02:00
parent 56ef2f3f2d
commit 75db8bed91
No known key found for this signature in database
GPG key ID: F3C1A0D9C1D65273
2 changed files with 21 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
module/mes/base.mes
View file

@ -107,13 +107,13 @@
((closure? p) #t) ((closure? p) #t)
(#t #f))) (#t #f)))
(define (map f l . r) (define (map f h . t)
(if (null? l) '() (if (null? h) '()
(if (null? r) (cons (f (car l)) (map f (cdr l))) (if (null? t) (cons (f (car h)) (map f (cdr h)))
(if (null? (cdr r)) (if (null? (cdr t))
(cons (f (car l) (caar r)) (map f (cdr l) (cdar r))) (cons (f (car h) (caar t)) (map f (cdr h) (cdar t)))
(if (null? (cddr r)) (if (null? (cddr t))
(cons (f (car l) (caar r) (caadr r)) (map f (cdr l) (cdar r) (cdadr r))) (cons (f (car h) (caar t) (caadr t)) (map f (cdr h) (cdar t) (cdadr t)))
(if (null? (cdddr r)) (if (null? (cdddr t))
(cons (f (car l) (caar r) (caadr r) (car (caddr r))) (map f (cdr l) (cdar r) (cdadr r) (cdr (caddr r)))) (cons (f (car h) (caar t) (caadr t) (car (caddr t))) (map f (cdr h) (cdar t) (cdadr t) (cdr (caddr t))))
(error 'unsupported (cons* "map 5:" f l r))) ))))) (error 'unsupported (cons* "map 5:" f h t))) )))))

16
module/srfi/srfi-1.mes
View file

@ -40,11 +40,17 @@
(define (append-map f lst . rest) (define (append-map f lst . rest)
(apply append (apply map f (cons lst rest)))) (apply append (apply map f (cons lst rest))))
(define (filter-map f lst) (define (filter-map f h . t)
(if (null? lst) (list) (if (null? h) '()
(let ((r (f (car lst)))) (if (null? t)
(if r (cons r (filter-map f (cdr lst))) (let ((r (f (car h))))
(filter-map f (cdr lst)))))) (if r (cons r (filter-map f (cdr h)))
(filter-map f (cdr h))))
(if (null? (cdr t))
(let ((r (f (car h) (caar t))))
(if r (cons r (filter-map f (cdr h) (cdar t)))
(filter-map f (cdr h) (cdar t))))
(error 'unsupported (cons* "filter-map 3:" f h t))))))
;;; nyacc requirements ;;; nyacc requirements