diff --git a/libs/cyclone/futures.scm b/libs/cyclone/futures.scm index 3de0f9f1..532bbfe4 100644 --- a/libs/cyclone/futures.scm +++ b/libs/cyclone/futures.scm @@ -3,15 +3,26 @@ ;; https://clojure.github.io/clojure/clojure.core-api.html#clojure.core/future? ;; https://purelyfunctional.tv/guide/clojure-concurrency/#future -(import (scheme base) - (scheme write) - (cyclone concurrency) - (srfi 18) -) - -(define *future-sym* (string->symbol " future ")) -(define (future? obj) - (and (vector? obj) (eq? (vector-ref obj 0) *future-sym*))) +(define-library (futures) + (import (scheme base) + (scheme write) + (cyclone concurrency) + (srfi 18) + ) + (export + future? + future-call + future-deref + ) +;(define *future-sym* (string->symbol " future ")) +;(define (future? obj) +; (and (vector? obj) (eq? (vector-ref obj 0) *future-sym*))) + (define-record-type + (make-future done result lock) + future? + (done get-done set-done!) + (result get-result set-result!) + (lock get-lock set-lock!)) ;; TODO: macro (future expr ...) @@ -24,18 +35,38 @@ ; of deref with timeout is used. See also - realized?. (define (future-call thunk) - (let ((ftr (vector *future-sym* 'todo))) - ;; TODO: setup and call the thread here - -;; Sketching out what is needed: -;;(define (sum-entry-pt) -;; (sum-loop (* 100 100 100))) -;; -;;;; Thread - Do something, then let main thread know when we are done -;;(define t9 (make-thread sum-entry-pt)) -;;(thread-start! t1) - + (let* ( + (lock (make-mutex)) + (ftr (make-future #f #f lock) + ; (vector + ; *future-sym* ;; Type indicator + ; #f ;; Done? + ; #f ;; Result + ; lock) + ) + (tfnc (lambda () + (mutex-lock! lock) + (let ((result (thunk))) ;; TODO: Catch exceptions (?) + (set-done! #t) + (set-result! result) + ;(vector-set! ftr 1 #t) ;; Done + ;(vector-set! ftr 2 result) + (mutex-unlock! lock) + ))) + (t (make-thread tfnc)) + ) + (thread-start! t) ftr)) -TODO: custom deref but eventually need to fold that 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) + (when (not (future? ftr)) + (error "Expected future but received" ftr)) + (let ((result #f)) + (mutex-lock! (get-lock ftr)) ;(vector-ref ftr 3)) + (set! result (get-result ftr)) ;(vector-ref ftr 2)) + (mutex-unlock! (get-lock ftr)) ;(vector-ref ftr 3)) + result)) + +))