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

[bugfix] `do` macro should execute epilogue expressions iff test 

evaluates *true*
This commit is contained in:
Yuichi Nishiwaki 2014-01-08 20:18:44 +09:00
parent fbffa4697a
commit 8273659bd0
1 changed files with 15 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
piclib/built-in.scm
View File

@ -195,13 +195,13 @@
(list (car x) (cadr x))) (list (car x) (cadr x)))
bindings) bindings)
(,(r 'if) ,(car finish) (,(r 'if) ,(car finish)
(,(r 'begin) ,@(cdr finish))
(,(r 'begin) ,@body (,(r 'begin) ,@body
(,(r 'loop) ,@(map (lambda (x) (,(r 'loop) ,@(map (lambda (x)
(if (null? (cddr x)) (if (null? (cddr x))
(car x) (car x)
(car (cddr x)))) (car (cddr x))))
bindings))) bindings)))))))))
(,(r 'begin) ,@(cdr finish))))))))
(define-syntax when (define-syntax when
(er-macro-transformer (er-macro-transformer
@ -309,7 +309,7 @@
`(,(r 'begin) `(,(r 'begin)
,@(do ((vars formals (cdr vars)) ,@(do ((vars formals (cdr vars))
(defs '())) (defs '()))
((pair? vars) ((null? vars)
defs) defs)
(set! defs (cons `(,(r 'define) ,(car vars) #f) defs))) (set! defs (cons `(,(r 'define) ,(car vars) #f) defs)))
(,(r 'call-with-values) (,(r 'call-with-values)
@ -317,7 +317,7 @@
(,(r 'lambda) (,@(map r formals)) (,(r 'lambda) (,@(map r formals))
,@(do ((vars formals (cdr vars)) ,@(do ((vars formals (cdr vars))
(assn '())) (assn '()))
((pair? vars) ((null? vars)
assn) assn)
(set! assn (cons `(,(r 'set!) ,(car vars) ,(r (car vars))) assn)))))))))) (set! assn (cons `(,(r 'set!) ,(car vars) ,(r (car vars))) assn))))))))))
@ -599,7 +599,7 @@
(let ((v (make-string len))) (let ((v (make-string len)))
(do ((i 0 (+ i 1)) (do ((i 0 (+ i 1))
(l objs (cdr l))) (l objs (cdr l)))
((< i len) ((= i len)
v) v)
(string-set! v i (car l)))))) (string-set! v i (car l))))))
@ -610,7 +610,7 @@
(string-length string)))) (string-length string))))
(do ((i start (+ i 1)) (do ((i start (+ i 1))
(res '())) (res '()))
((< i end) ((= i end)
(reverse res)) (reverse res))
(set! res (cons (string-ref string i) res))))) (set! res (cons (string-ref string i) res)))))
@ -624,7 +624,7 @@
(string-length from)))) (string-length from))))
(do ((i at (+ i 1)) (do ((i at (+ i 1))
(j start (+ j 1))) (j start (+ j 1)))
((< j end)) ((= j end))
(string-set! to i (string-ref from j))))) (string-set! to i (string-ref from j)))))
(define (string-copy v . opts) (define (string-copy v . opts)
@ -650,7 +650,7 @@
(cadr opts) (cadr opts)
(string-length v)))) (string-length v))))
(do ((i start (+ i 1))) (do ((i start (+ i 1)))
((< i end) ((= i end)
#f) #f)
(string-set! v i fill)))) (string-set! v i fill))))
@ -665,7 +665,7 @@
(let ((v (make-vector len))) (let ((v (make-vector len)))
(do ((i 0 (+ i 1)) (do ((i 0 (+ i 1))
(l objs (cdr l))) (l objs (cdr l)))
((< i len) ((= i len)
v) v)
(vector-set! v i (car l)))))) (vector-set! v i (car l))))))
@ -676,7 +676,7 @@
(vector-length vector)))) (vector-length vector))))
(do ((i start (+ i 1)) (do ((i start (+ i 1))
(res '())) (res '()))
((< i end) ((= i end)
(reverse res)) (reverse res))
(set! res (cons (vector-ref vector i) res))))) (set! res (cons (vector-ref vector i) res)))))
@ -690,7 +690,7 @@
(vector-length from)))) (vector-length from))))
(do ((i at (+ i 1)) (do ((i at (+ i 1))
(j start (+ j 1))) (j start (+ j 1)))
((< j end)) ((= j end))
(vector-set! to i (vector-ref from j))))) (vector-set! to i (vector-ref from j)))))
(define (vector-copy v . opts) (define (vector-copy v . opts)
@ -716,7 +716,7 @@
(cadr opts) (cadr opts)
(vector-length v)))) (vector-length v))))
(do ((i start (+ i 1))) (do ((i start (+ i 1)))
((< i end) ((= i end)
#f) #f)
(vector-set! v i fill)))) (vector-set! v i fill))))
@ -738,7 +738,7 @@
(let ((v (make-bytevector len))) (let ((v (make-bytevector len)))
(do ((i 0 (+ i 1)) (do ((i 0 (+ i 1))
(l objs (cdr l))) (l objs (cdr l)))
((< i len) ((= i len)
v) v)
(bytevector-u8-set! v i (car l)))))) (bytevector-u8-set! v i (car l))))))
@ -749,7 +749,7 @@
(bytevector-length from)))) (bytevector-length from))))
(do ((i at (+ i 1)) (do ((i at (+ i 1))
(j start (+ j 1))) (j start (+ j 1)))
((< j end)) ((= j end))
(bytevector-u8-set! to i (bytevector-u8-ref from j))))) (bytevector-u8-set! to i (bytevector-u8-ref from j)))))
(define (bytevector-copy v . opts) (define (bytevector-copy v . opts)
@ -772,7 +772,7 @@
(define (bytevector->list v start end) (define (bytevector->list v start end)
(do ((i start (+ i 1)) (do ((i start (+ i 1))
(res '())) (res '()))
((< i end) ((= i end)
(reverse res)) (reverse res))
(set! res (cons (bytevector-u8-ref v i) res)))) (set! res (cons (bytevector-u8-ref v i) res))))