2014-07-19 01:15:53 -04:00
|
|
|
;;; Appendix A. Standard Libraries Lazy
|
|
|
|
|
|
|
|
(define-library (scheme lazy)
|
|
|
|
(import (scheme base)
|
|
|
|
(picrin macro))
|
|
|
|
|
2014-08-05 22:33:07 -04:00
|
|
|
(define-record-type <promise>
|
2015-06-14 13:03:13 -04:00
|
|
|
(make-promise% done value)
|
|
|
|
promise?
|
|
|
|
(done promise-done? set-promise-done!)
|
|
|
|
(value promise-value set-promise-value!))
|
2014-07-19 01:15:53 -04:00
|
|
|
|
|
|
|
(define-syntax delay-force
|
2015-06-14 13:03:13 -04:00
|
|
|
(syntax-rules ()
|
|
|
|
((_ expr)
|
|
|
|
(make-promise% #f (lambda () expr)))))
|
2014-07-19 01:15:53 -04:00
|
|
|
|
|
|
|
(define-syntax delay
|
2015-06-14 13:03:13 -04:00
|
|
|
(syntax-rules ()
|
|
|
|
((_ expr)
|
|
|
|
(delay-force (make-promise% #t expr)))))
|
2014-07-19 01:15:53 -04:00
|
|
|
|
|
|
|
(define (force promise)
|
|
|
|
(if (promise-done? promise)
|
|
|
|
(promise-value promise)
|
2015-06-14 13:03:13 -04:00
|
|
|
(let ((new-promise ((promise-value promise))))
|
|
|
|
(set-promise-done! promise (promise-done? new-promise))
|
|
|
|
(set-promise-value! promise (promise-value new-promise))
|
|
|
|
(force promise))))
|
2014-07-19 01:15:53 -04:00
|
|
|
|
|
|
|
(define (make-promise obj)
|
|
|
|
(if (promise? obj)
|
|
|
|
obj
|
|
|
|
(make-promise% #t obj)))
|
|
|
|
|
2015-06-14 13:03:13 -04:00
|
|
|
(export delay-force
|
|
|
|
delay
|
|
|
|
force
|
|
|
|
make-promise
|
|
|
|
promise?))
|