mirror of
https://github.com/justinethier/cyclone.git
synced 2025-07-13 15:57:36 +02:00
First working version
This commit is contained in:
parent
a108d39ea0
commit
31dfdbfd4f
1 changed files with 27 additions and 26 deletions
|
@ -6,19 +6,17 @@
|
||||||
(define-library (futures)
|
(define-library (futures)
|
||||||
(import (scheme base)
|
(import (scheme base)
|
||||||
(scheme write)
|
(scheme write)
|
||||||
(cyclone concurrent)
|
;(cyclone concurrent)
|
||||||
(srfi 18)
|
(srfi 18)
|
||||||
)
|
)
|
||||||
(export
|
(export
|
||||||
future?
|
future?
|
||||||
|
future
|
||||||
future-call
|
future-call
|
||||||
future-deref
|
future-deref
|
||||||
)
|
)
|
||||||
(begin
|
(begin
|
||||||
|
|
||||||
;(define *future-sym* (string->symbol " future "))
|
|
||||||
;(define (future? obj)
|
|
||||||
; (and (vector? obj) (eq? (vector-ref obj 0) *future-sym*)))
|
|
||||||
(define-record-type <future>
|
(define-record-type <future>
|
||||||
(make-future done result lock)
|
(make-future done result lock)
|
||||||
future?
|
future?
|
||||||
|
@ -26,33 +24,28 @@
|
||||||
(result get-result set-result!)
|
(result get-result set-result!)
|
||||||
(lock get-lock set-lock!))
|
(lock get-lock set-lock!))
|
||||||
|
|
||||||
|
;; macro: (future expr ...)
|
||||||
|
(define-syntax future
|
||||||
|
(er-macro-transformer
|
||||||
|
(lambda (expr rename compare)
|
||||||
|
`(future-call (lambda () ,@(cdr expr))))))
|
||||||
|
|
||||||
;; TODO: macro (future expr ...)
|
;; From the clojure docs:
|
||||||
|
;;
|
||||||
;; From clojure docs:
|
;; Takes a function of no args and yields a future object that will
|
||||||
; Takes a function of no args and yields a future object that will
|
;; invoke the function in another thread, and will cache the result and
|
||||||
; invoke the function in another thread, and will cache the result and
|
;; return it on all subsequent calls to deref/@. If the computation has
|
||||||
; return it on all subsequent calls to deref/@. If the computation has
|
;; not yet finished, calls to deref/@ will block, unless the variant
|
||||||
; not yet finished, calls to deref/@ will block, unless the variant
|
;; of deref with timeout is used. See also - realized?.
|
||||||
; of deref with timeout is used. See also - realized?.
|
|
||||||
|
|
||||||
(define (future-call thunk)
|
(define (future-call thunk)
|
||||||
(let* (
|
(let* (
|
||||||
(lock (make-mutex))
|
(lock (make-mutex))
|
||||||
(ftr (make-future #f #f lock)
|
(ftr (make-future #f #f lock))
|
||||||
; (vector
|
|
||||||
; *future-sym* ;; Type indicator
|
|
||||||
; #f ;; Done?
|
|
||||||
; #f ;; Result
|
|
||||||
; lock)
|
|
||||||
)
|
|
||||||
(tfnc (lambda ()
|
(tfnc (lambda ()
|
||||||
(mutex-lock! lock)
|
(mutex-lock! lock)
|
||||||
(let ((result (thunk))) ;; TODO: Catch exceptions (?)
|
(let ((result (thunk))) ;; TODO: Catch exceptions (?)
|
||||||
(set-done! ftr #t)
|
|
||||||
(set-result! ftr result)
|
(set-result! ftr result)
|
||||||
;(vector-set! ftr 1 #t) ;; Done
|
(set-done! ftr #t)
|
||||||
;(vector-set! ftr 2 result)
|
|
||||||
(mutex-unlock! lock)
|
(mutex-unlock! lock)
|
||||||
)))
|
)))
|
||||||
(t (make-thread tfnc))
|
(t (make-thread tfnc))
|
||||||
|
@ -60,15 +53,23 @@
|
||||||
(thread-start! t)
|
(thread-start! t)
|
||||||
ftr))
|
ftr))
|
||||||
|
|
||||||
|
;;(define (future-done? ftr)
|
||||||
|
;; (when (not (future? ftr))
|
||||||
|
;; (error "Expected future but received" ftr))
|
||||||
|
;; TODO: may be a good candidate for a timed mutex lock, just return #f if minimum timeout is exceeded
|
||||||
|
;;)
|
||||||
|
|
||||||
|
;; TODO: (future-cancel ftr)
|
||||||
|
;; TODO: (future-cancelled? ftr)
|
||||||
|
|
||||||
;;TODO: custom deref but eventually need to fold this functionality back into the main one
|
;;TODO: custom deref but eventually need to fold this functionality back into the main one
|
||||||
(define (future-deref ftr)
|
(define (future-deref ftr)
|
||||||
(when (not (future? ftr))
|
(when (not (future? ftr))
|
||||||
(error "Expected future but received" ftr))
|
(error "Expected future but received" ftr))
|
||||||
(let ((result #f))
|
(let ((result #f))
|
||||||
(mutex-lock! (get-lock ftr)) ;(vector-ref ftr 3))
|
(mutex-lock! (get-lock ftr))
|
||||||
(set! result (get-result ftr)) ;(vector-ref ftr 2))
|
(set! result (get-result ftr))
|
||||||
(mutex-unlock! (get-lock ftr)) ;(vector-ref ftr 3))
|
(mutex-unlock! (get-lock ftr))
|
||||||
result))
|
result))
|
||||||
|
|
||||||
))
|
))
|
||||||
|
|
Loading…
Add table
Reference in a new issue