First working version

This commit is contained in:
Justin Ethier 2019-06-21 13:26:42 -04:00
parent a108d39ea0
commit 31dfdbfd4f

View file

@ -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))
)) ))