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

scm: Evaluate arguments of OR only once.

Browse source 
* module/mes/base.mes (or): Evaluate arguments only once.
* module/mes/read-0.mes (or): Likewise.
* tests/base.test ("or only once"): Test it.
* module/mes/read-0-32.mo: Regenerate.
This commit is contained in:
Jan Nieuwenhuizen 2017-04-02 16:47:22 +02:00
parent 232e87bd9d
commit 08c04ff845
4 changed files with 24 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
module/mes/base.mes
View file

@ -73,18 +73,20 @@
(define (command-line) %argv)
(define-macro (or . x)
(if (null? x) #f
(if (null? (cdr x)) (car x)
(list 'if (car x) (car x)
(cons 'or (cdr x))))))
(define-macro (and . x)
(if (null? x) #t
(if (null? (cdr x)) (car x)
(list 'if (car x) (cons 'and (cdr x))
#f))))
(define-macro (or . x)
(if (null? x) #f
(if (null? (cdr x)) (car x)
(list (list 'lambda (list 'r)
(list 'if 'r 'r
(cons 'or (cdr x))))
(car x)))))
(define (and=> value procedure) (and value (procedure value)))
(define eqv? eq?)

BIN
module/mes/read-0-32.mo
View file

Binary file not shown.

7
module/mes/read-0.mes
View file

@ -198,8 +198,11 @@
(define-macro (or . x)
(if (null? x) #f
(if (null? (cdr x)) (car x)
(list (quote if) (car x) (car x)
(cons (quote or) (cdr x))))))
(list (list (quote lambda) (list (quote r))
(list (quote if) (quote r) (quote r)
(cons (quote or) (cdr x))))
(car x)))))
(define (not x)
(if x #f #t))

11
tests/base.test
View file

@ -76,6 +76,17 @@ exit $?
(pass-if "or 3" (seq? (or #f (= 0 1) 3) 3))
(pass-if "or 4" (seq? (or (= 0 0) (= 0 1)) #t))
(pass-if "or 5" (seq? (or (= 0 1) (= 0 0)) #t))
(pass-if-equal "or only once"
1
(let ()
(define read
(let ((lst '(1 0)))
(lambda ()
(let ((r (car lst)))
(set! lst (cdr lst))
r))))
(or (read) #t)))
(pass-if "let" (seq? (let () 0) 0))
(pass-if "let 2" (seq? (let ((x 0)) x) 0))
(pass-if "let 3" (seq? (let ((p 5) (q 6)) (+ p q)) 11))