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

fix for-each.

Browse source
This commit is contained in:
Jan Nieuwenhuizen 2016-07-24 12:40:44 +02:00
parent 07a5f716fc
commit 8c1a5f19da
3 changed files with 6 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
mes.c
View file

@ -342,8 +342,6 @@ eval (scm *e, scm *a)
#if DEBUG #if DEBUG
printf ("\neval e="); printf ("\neval e=");
display (e); display (e);
printf ("\na=");
display (a);
puts (""); puts ("");
#endif #endif
scm *macro; scm *macro;

6
scm.mes
View file

@ -158,8 +158,10 @@
(define (identity x) x) (define (identity x) x)
(define (for-each f l . r) (define (for-each f l . r)
(apply map (cons f (cons l r))) (cond ((null? l) '())
*unspecified*) ((null? r) (f (car l)) (for-each f (cdr l)))
((null? (cdr r))
(for-each f (cdr l) (cdar r)))))
(define (not x) (define (not x)
(cond (x #f) (cond (x #f)

3
test.mes
View file

@ -94,7 +94,8 @@
(pass-if "map" (sequal? (map identity '(1 2 3 4)) '(1 2 3 4))) (pass-if "map" (sequal? (map identity '(1 2 3 4)) '(1 2 3 4)))
(pass-if "map 2 " (sequal? (map (lambda (i a) (cons i a)) '(1 2 3 4) '(a b c d)) (pass-if "map 2 " (sequal? (map (lambda (i a) (cons i a)) '(1 2 3 4) '(a b c d))
'((1 . a) (2 . b) (3 . c) (4 . d)))) '((1 . a) (2 . b) (3 . c) (4 . d))))
(pass-if "for-each" (sequal? (let ((acc '())) (for-each (lambda (x) (set! acc (cons x acc))) '(1 2 3 4)) acc) '(4 3 2 1)))
(define xxxa 0) (define xxxa 0)
(pass-if "set! " (seq? (begin (set! xxxa 1) xxxa) 1)) (pass-if "set! " (seq? (begin (set! xxxa 1) xxxa) 1))
(pass-if "set! 2" (seq? (let ((a 0)) (set! a 1) a) 1)) (pass-if "set! 2" (seq? (let ((a 0)) (set! a 1) a) 1))