From 4a1a9a9f5228536a625c758a12b3341d3dee696a Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 11 Jul 2019 11:13:25 -0400 Subject: [PATCH] WIP --- libs/cyclone/delay-promise.scm | 67 +++++++++++++++++++++++----------- 1 file changed, 46 insertions(+), 21 deletions(-) diff --git a/libs/cyclone/delay-promise.scm b/libs/cyclone/delay-promise.scm index cd5d956c..3bd26af7 100644 --- a/libs/cyclone/delay-promise.scm +++ b/libs/cyclone/delay-promise.scm @@ -3,34 +3,34 @@ (import (scheme write) (scheme base) (cyclone concurrent) (srfi 18)) -(define-record-type - (%make-delay done result lock) - delay? - (done delay:done delay:set-done!) - (value delay:value delay:set-value!) ;; Either thunk or result - (lock delay:lock delay:set-lock!)) +(define-record-type + (%make-shared-delay done result lock) + shared-delay? + (done sd:done sd:set-done!) + (value sd:value sd:set-value!) ;; Either thunk or result + (lock sd:lock sd:set-lock!)) -(define (make-delay thunk) - (%make-delay #f thunk (make-mutex))) +(define (make-shared-delay thunk) + (%make-shared-delay #f thunk (make-mutex))) -(define (delay-deref d) - (when (not (delay? d)) +(define (shared-delay-deref d) + (when (not (shared-delay? d)) (error "Expected future but received" d)) - (mutex-lock! (delay:lock d)) + (mutex-lock! (sd:lock d)) (cond - ((delay:done d) - (delay:value d)) + ((sd:done d) + (sd:value d)) (else - (delay:set-value! d - (make-shared ((delay:value d)))) ;; Exec thunk and store result - (delay:set-done! d #t))) - (mutex-unlock! (delay:lock d)) + (sd:set-value! d + (make-shared ((sd:value d)))) ;; Exec thunk and store result + (sd:set-done! d #t))) + (mutex-unlock! (sd:lock d)) ) (define-syntax shared-delay (er-macro-transformer (lambda (expr rename compare) - `(make-delay (lambda () ,(cadr expr)))))) + `(make-shared-delay (lambda () ,(cadr expr)))))) (define (test) @@ -38,6 +38,31 @@ 'done) (define d (shared-delay (test))) -(write (delay-deref d))(newline) -(write (delay-deref d))(newline) -(write (delay-deref d))(newline) +(write (shared-delay-deref d))(newline) +(write (shared-delay-deref d))(newline) +(write (shared-delay-deref d))(newline) + + +;; Promises + +(define-record-type + (%make-shared-promise done value lock cv) + shared-promise? + (done sp:done sp:set-done!) + (value sp:value sp:set-value!) + (lock sp:lock sp:set-lock!) + (cv sp:cv sp:set-cv!)) + +(define (make-shared-promise) + (%make-shared-promise #f #f (make-mutex) (make-condition-variable))) + +(define (shared-promise-deref obj) + ;; TODO: block on CV until ready + ;; return sp:value +) + +(define (deliver obj) + ;; TODO: if not delivered, compute value and signal all on the cv + ;; else, do nothing +) +