mirror of
https://github.com/justinethier/cyclone.git
synced 2025-05-19 05:39:17 +02:00
WIP
This commit is contained in:
parent
709aaca4bb
commit
5d5611c407
1 changed files with 66 additions and 56 deletions
122
scheme/lazy.sld
122
scheme/lazy.sld
|
@ -5,66 +5,76 @@
|
|||
force
|
||||
delay-force
|
||||
make-promise
|
||||
promise?)
|
||||
;promise?
|
||||
)
|
||||
(begin
|
||||
(define (make-promise x)
|
||||
(delay x))
|
||||
;)
|
||||
;(begin
|
||||
(define (promise? x)
|
||||
(and (pair? x)
|
||||
(null? (cdr x))
|
||||
(pair? (car x))
|
||||
(or (eq? #t (caar x))
|
||||
(and (eq? #f (caar x))
|
||||
(procedure? (cdar x))))))
|
||||
; (define (make-promise x)
|
||||
; (delay x))
|
||||
; ;)
|
||||
; ;(begin
|
||||
; (define (promise? x)
|
||||
; (and (pair? x)
|
||||
; (null? (cdr x))
|
||||
; (pair? (car x))
|
||||
; (or (eq? #t (caar x))
|
||||
; (and (eq? #f (caar x))
|
||||
; (procedure? (cdar x))))))
|
||||
;
|
||||
; (define-syntax delay-force
|
||||
; (er-macro-transformer
|
||||
; (lambda (expr rename compare)
|
||||
; `(,(rename 'promise) #f (,(rename 'lambda) () ,(cadr expr))))))
|
||||
;
|
||||
; (define-syntax delay
|
||||
; (er-macro-transformer
|
||||
; (lambda (expr rename compare)
|
||||
; `(,(rename 'delay-force) (,(rename 'promise) #t ,(cadr expr))))))
|
||||
;
|
||||
; (define (promise done? proc)
|
||||
; (list (cons done? proc)))
|
||||
; (define (promise-done? x) (car (car x)))
|
||||
; (define (promise-value x) (cdr (car x)))
|
||||
; (define (promise-update! new old)
|
||||
; (set-car! (car old) (promise-done? new))
|
||||
; (set-cdr! (car old) (promise-value new))
|
||||
; (set-car! new (car old)))
|
||||
; (define (force promise)
|
||||
; (if (promise-done? promise)
|
||||
; (promise-value promise)
|
||||
; (let ((promise* ((promise-value promise))))
|
||||
; (if (not (promise-done? promise))
|
||||
; (promise-update! promise* promise))
|
||||
; (force promise))))))
|
||||
|
||||
(define-syntax delay-force
|
||||
(er-macro-transformer
|
||||
(lambda (expr rename compare)
|
||||
`(,(rename 'promise) #f (,(rename 'lambda) () ,(cadr expr))))))
|
||||
;; Delayed evaluation functions from husk
|
||||
(define force
|
||||
(lambda (object)
|
||||
(object)))
|
||||
|
||||
(define-syntax delay
|
||||
(er-macro-transformer
|
||||
(lambda (expr rename compare)
|
||||
`(,(rename 'delay-force) (,(rename 'promise) #t ,(cadr expr))))))
|
||||
`(make-promise (lambda () ,(cadr expr))))))
|
||||
(define-syntax delay-force
|
||||
(er-macro-transformer
|
||||
(lambda (expr rename compare)
|
||||
`(make-promise (lambda () ,(cadr expr))))))
|
||||
;(define-syntax delay
|
||||
; (syntax-rules ()
|
||||
; ((delay expression)
|
||||
; (make-promise (lambda () expression)))))
|
||||
|
||||
(define (promise done? proc)
|
||||
(list (cons done? proc)))
|
||||
(define (promise-done? x) (car (car x)))
|
||||
(define (promise-value x) (cdr (car x)))
|
||||
(define (promise-update! new old)
|
||||
(set-car! (car old) (promise-done? new))
|
||||
(set-cdr! (car old) (promise-value new))
|
||||
(set-car! new (car old)))
|
||||
(define (force promise)
|
||||
(if (promise-done? promise)
|
||||
(promise-value promise)
|
||||
(let ((promise* ((promise-value promise))))
|
||||
(if (not (promise-done? promise))
|
||||
(promise-update! promise* promise))
|
||||
(force promise))))))
|
||||
|
||||
;; Delayed evaluation functions from husk
|
||||
;(define force
|
||||
; (lambda (object)
|
||||
; (object)))
|
||||
;
|
||||
;(define-syntax delay
|
||||
; (syntax-rules ()
|
||||
; ((delay expression)
|
||||
; (make-promise (lambda () expression)))))
|
||||
;
|
||||
;(define make-promise
|
||||
; (lambda (proc)
|
||||
; (let ((result-ready? #f)
|
||||
; (result #f))
|
||||
; (lambda ()
|
||||
; (if result-ready?
|
||||
; result
|
||||
; (let ((x (proc)))
|
||||
; (if result-ready?
|
||||
; result
|
||||
; (begin (set! result x)
|
||||
; (set! result-ready? #t)
|
||||
; result))))))))
|
||||
(define make-promise
|
||||
(lambda (proc)
|
||||
(let ((result-ready? #f)
|
||||
(result #f))
|
||||
(lambda ()
|
||||
(if result-ready?
|
||||
result
|
||||
(let ((x (proc)))
|
||||
(if result-ready?
|
||||
result
|
||||
(begin (set! result x)
|
||||
(set! result-ready? #t)
|
||||
result))))))))
|
||||
))
|
||||
|
|
Loading…
Add table
Reference in a new issue