rewrite scheme/lazy.scm with syntax-rules
This commit is contained in:
parent
c3a6bffa61
commit
9ace96dd19
contrib/05.r7rs/scheme
|
@ -5,33 +5,27 @@
|
||||||
(picrin macro))
|
(picrin macro))
|
||||||
|
|
||||||
(define-record-type <promise>
|
(define-record-type <promise>
|
||||||
(make-promise% done obj)
|
(make-promise% done value)
|
||||||
promise?
|
promise?
|
||||||
(done promise-done? promise-done!)
|
(done promise-done? set-promise-done!)
|
||||||
(obj promise-value promise-value!))
|
(value promise-value set-promise-value!))
|
||||||
|
|
||||||
(define-syntax delay-force
|
(define-syntax delay-force
|
||||||
(ir-macro-transformer
|
(syntax-rules ()
|
||||||
(lambda (form rename compare?)
|
((_ expr)
|
||||||
(let ((expr (cadr form)))
|
(make-promise% #f (lambda () expr)))))
|
||||||
`(make-promise% #f (lambda () ,expr))))))
|
|
||||||
|
|
||||||
(define-syntax delay
|
(define-syntax delay
|
||||||
(ir-macro-transformer
|
(syntax-rules ()
|
||||||
(lambda (form rename compare?)
|
((_ expr)
|
||||||
(let ((expr (cadr form)))
|
(delay-force (make-promise% #t expr)))))
|
||||||
`(delay-force (make-promise% #t ,expr))))))
|
|
||||||
|
|
||||||
(define (promise-update! new old)
|
|
||||||
(promise-done! old (promise-done? new))
|
|
||||||
(promise-value! old (promise-value new)))
|
|
||||||
|
|
||||||
(define (force promise)
|
(define (force promise)
|
||||||
(if (promise-done? promise)
|
(if (promise-done? promise)
|
||||||
(promise-value promise)
|
(promise-value promise)
|
||||||
(let ((promise* ((promise-value promise))))
|
(let ((new-promise ((promise-value promise))))
|
||||||
(unless (promise-done? promise)
|
(set-promise-done! promise (promise-done? new-promise))
|
||||||
(promise-update! promise* promise))
|
(set-promise-value! promise (promise-value new-promise))
|
||||||
(force promise))))
|
(force promise))))
|
||||||
|
|
||||||
(define (make-promise obj)
|
(define (make-promise obj)
|
||||||
|
@ -39,4 +33,8 @@
|
||||||
obj
|
obj
|
||||||
(make-promise% #t obj)))
|
(make-promise% #t obj)))
|
||||||
|
|
||||||
(export delay-force delay force make-promise promise?))
|
(export delay-force
|
||||||
|
delay
|
||||||
|
force
|
||||||
|
make-promise
|
||||||
|
promise?))
|
||||||
|
|
Loading…
Reference in New Issue