Chez concurrency pt.1: real OS-thread futures + blocking promises (shared heap)
future/future-call run the body on a native thread (fork-thread) over the SAME heap — JVM semantics, not Janet's isolated-heap snapshot. deref blocks on a mutex+condition latch; timed (deref f ms val) uses an absolute deadline. promise is a real blocking promise (deref parks until deliver), replacing the Janet non-blocking atom shim. future?/future-done?/future-cancelled?/future-cancel /realized? are native (the overlay versions read Janet map keys); re-asserted in post-prelude over the overlay. pmap/pcalls/pvalues (overlay, over future) light up for free. Thread-safety this forces: - atoms get a per-atom mutex; swap!/swap-vals! are a JVM-style CAS loop (f runs outside the lock, so a watch/validator can deref the same atom); reset!/ compare-and-set! are atomic. - the dynamic binding stack becomes a Chez thread-parameter, so each future/thread has its own; Chez inherits it at fork, giving binding conveyance (the shim also installs an explicit snapshot). - Thread/sleep really sleeps now (a worker sleeping doesn't block the parent). Re-minted the seed: future-call now resolves at compile time, so pmap compiles to a var-deref instead of the host-static-call fallback that crashed. image.ss unchanged. Corpus: the 2 snapshot cases now match the JVM (shared) not Janet (isolated) — allowlisted on both Chez gates; the two racy future-cancel cases allowlisted; "promise undelivered" (blocks on JVM/Chez, profile :bucket :timeout) skipped like :throws. Zero-Janet corpus 2544 -> 2569, 0 new divergences, floor raised. Full Janet gate + JVM cert green. jolt-byjr
This commit is contained in:
Yogthos
parent
a23095b502
commit
ec30c9e405
10 changed files with 330 additions and 42 deletions
|
|
@ -16,16 +16,21 @@
|
|||
;; Janet table, which a Chez atom record is not — so the peripheral ops + the
|
||||
;; notify/validate behaviour live natively here, and post-prelude.ss re-asserts
|
||||
;; them over the overlay's def-var! (jolt-mn9o).
|
||||
;; `lock` (jolt-byjr) is a per-atom mutex guarding the read-modify-write critical
|
||||
;; sections, so swap!/reset!/compare-and-set! are atomic under real OS threads
|
||||
;; (futures/go blocks share the heap on Chez). The user fn in swap! runs OUTSIDE
|
||||
;; the lock (a CAS retry loop, like the JVM) so it never deadlocks on re-entrant
|
||||
;; access and a watch/validator can deref the same atom.
|
||||
(define-record-type jolt-atom
|
||||
(fields (mutable val) (mutable watches) (mutable validator))
|
||||
(nongenerative jolt-atom-v2))
|
||||
(fields (mutable val) (mutable watches) (mutable validator) lock)
|
||||
(nongenerative jolt-atom-v3))
|
||||
|
||||
;; (atom init) / (atom init :validator f :meta m): scan the trailing keyword opts
|
||||
;; for :validator (the only one with runtime behaviour; :meta is accepted/ignored).
|
||||
(define (jolt-atom-new v . opts)
|
||||
(let loop ((o opts) (validator jolt-nil))
|
||||
(cond
|
||||
((or (null? o) (null? (cdr o))) (make-jolt-atom v '() validator))
|
||||
((or (null? o) (null? (cdr o))) (make-jolt-atom v '() validator (make-mutex)))
|
||||
((and (keyword-t? (car o)) (string=? (keyword-t-name (car o)) "validator"))
|
||||
(loop (cddr o) (cadr o)))
|
||||
(else (loop (cddr o) validator)))))
|
||||
|
|
@ -50,37 +55,57 @@
|
|||
((jolt-reduced? x) (jolt-reduced-val x))
|
||||
(else (error #f "deref: unsupported reference type" x))))
|
||||
|
||||
;; (swap! a f arg*) -> (reset! a (f @a arg*)); f is invoked through jolt-invoke.
|
||||
;; Validate the new value BEFORE storing, notify watches AFTER (the seed order).
|
||||
;; CAS the val from `old` to `nv` by identity (eq?), atomically. Returns #t on
|
||||
;; success. The compute step (f) runs outside this, so we re-check under the lock.
|
||||
(define (jolt-atom-cas! a old nv)
|
||||
(with-mutex (jolt-atom-lock a)
|
||||
(if (eq? (jolt-atom-val a) old)
|
||||
(begin (jolt-atom-val-set! a nv) #t)
|
||||
#f)))
|
||||
|
||||
;; (swap! a f arg*): JVM-style CAS loop — read, compute f OUTSIDE the lock, then
|
||||
;; atomically compare-and-set; retry if another thread changed it. Validate the
|
||||
;; new value before storing, notify watches after (the seed order).
|
||||
(define (jolt-swap! a f . args)
|
||||
(let* ((old (jolt-atom-val a))
|
||||
(nv (apply jolt-invoke f old args)))
|
||||
(jolt-atom-validate a nv)
|
||||
(jolt-atom-val-set! a nv)
|
||||
(jolt-atom-notify a old nv)
|
||||
nv))
|
||||
(let retry ()
|
||||
(let* ((old (jolt-atom-val a))
|
||||
(nv (apply jolt-invoke f old args)))
|
||||
(jolt-atom-validate a nv)
|
||||
(if (jolt-atom-cas! a old nv)
|
||||
(begin (jolt-atom-notify a old nv) nv)
|
||||
(retry)))))
|
||||
|
||||
(define (jolt-reset! a v)
|
||||
(let ((old (jolt-atom-val a)))
|
||||
(jolt-atom-validate a v)
|
||||
(jolt-atom-val-set! a v)
|
||||
(jolt-atom-validate a v)
|
||||
(let ((old (with-mutex (jolt-atom-lock a)
|
||||
(let ((o (jolt-atom-val a))) (jolt-atom-val-set! a v) o))))
|
||||
(jolt-atom-notify a old v)
|
||||
v))
|
||||
|
||||
;; compare-and-set! keeps jolt= (value) semantics, done atomically under the lock.
|
||||
(define (jolt-compare-and-set! a oldv newv)
|
||||
(if (jolt= (jolt-atom-val a) oldv)
|
||||
(begin (jolt-reset! a newv) #t)
|
||||
#f))
|
||||
(jolt-atom-validate a newv)
|
||||
(let ((swapped (with-mutex (jolt-atom-lock a)
|
||||
(if (jolt= (jolt-atom-val a) oldv)
|
||||
(begin (jolt-atom-val-set! a newv) #t)
|
||||
#f))))
|
||||
(when swapped (jolt-atom-notify a oldv newv))
|
||||
swapped))
|
||||
|
||||
(define (jolt-swap-vals! a f . args)
|
||||
(let* ((old (jolt-atom-val a))
|
||||
(nv (apply jolt-invoke f old args)))
|
||||
(jolt-reset! a nv)
|
||||
(jolt-vector old nv)))
|
||||
(let retry ()
|
||||
(let* ((old (jolt-atom-val a))
|
||||
(nv (apply jolt-invoke f old args)))
|
||||
(jolt-atom-validate a nv)
|
||||
(if (jolt-atom-cas! a old nv)
|
||||
(begin (jolt-atom-notify a old nv) (jolt-vector old nv))
|
||||
(retry)))))
|
||||
|
||||
(define (jolt-reset-vals! a v)
|
||||
(let ((old (jolt-atom-val a)))
|
||||
(jolt-reset! a v)
|
||||
(jolt-atom-validate a v)
|
||||
(let ((old (with-mutex (jolt-atom-lock a)
|
||||
(let ((o (jolt-atom-val a))) (jolt-atom-val-set! a v) o))))
|
||||
(jolt-atom-notify a old v)
|
||||
(jolt-vector old v)))
|
||||
|
||||
;; --- watches / validators (jolt-mn9o) ---------------------------------------
|
||||
|
|
|
|||
176
host/chez/concurrency.ss
Normal file
176
host/chez/concurrency.ss
Normal file
|
|
@ -0,0 +1,176 @@
|
|||
;; concurrency.ss (jolt-byjr) — real OS-thread futures + promises for the Chez host.
|
||||
;;
|
||||
;; SHARED-HEAP semantics (JVM Clojure), NOT Janet's isolated-heap snapshot: a
|
||||
;; future body runs on a native thread (fork-thread) over the SAME heap, so a
|
||||
;; captured atom is shared and the body's mutations are visible to the parent —
|
||||
;; matching `clojure.core` on the JVM. deref blocks on a mutex+condition latch.
|
||||
;;
|
||||
;; future / future-call / future-cancel / future? / future-done? / future-cancelled?
|
||||
;; promise / deliver, and the deref extension for both, are bound here (some
|
||||
;; re-asserted in post-prelude.ss over the overlay's Janet-shaped versions).
|
||||
;;
|
||||
;; pmap / pcalls / pvalues live in the clojure.core overlay (40-lazy) expressed
|
||||
;; over `future`, so they light up for free once future-call exists.
|
||||
;;
|
||||
;; Loaded near the end of rt.ss — after atoms.ss (jolt-deref, the atom lock) and
|
||||
;; dyn-binding.ss (the thread-local binding stack we convey into the worker).
|
||||
;; Requires a threaded Chez build (fork-thread / make-mutex / make-condition).
|
||||
|
||||
;; --- time helpers -----------------------------------------------------------
|
||||
;; A relative duration / absolute deadline from a millisecond count (a jolt number).
|
||||
(define (ms->duration ms)
|
||||
(let* ((ms* (exact (floor ms)))
|
||||
(secs (quotient ms* 1000))
|
||||
(nanos (* (remainder ms* 1000) 1000000)))
|
||||
(make-time 'time-duration nanos secs)))
|
||||
(define (ms->deadline ms) (add-duration (current-time 'time-utc) (ms->duration ms)))
|
||||
|
||||
;; --- futures ----------------------------------------------------------------
|
||||
;; A future is a mutable cell guarded by `mu`; workers/derefs coordinate on `cv`.
|
||||
;; done? — result (or cancellation) is final; derefs may proceed
|
||||
;; cancelled? — future-cancel won before the body finished
|
||||
;; ok? — payload is a value (else payload is a raised condition/value)
|
||||
;; payload — the result value, or the captured throw
|
||||
(define-record-type jolt-future
|
||||
(fields (mutable done?) (mutable cancelled?) (mutable ok?) (mutable payload) mu cv)
|
||||
(nongenerative jolt-future-v1))
|
||||
|
||||
;; (future-call thunk): spawn a thread running (thunk). The dynamic bindings in
|
||||
;; effect now are conveyed into the worker (Chez inherits thread-parameters at
|
||||
;; fork; we also install an explicit snapshot for certainty). The result — value
|
||||
;; or thrown condition — is latched and broadcast; a cancel that already finalized
|
||||
;; the future makes the late result a no-op.
|
||||
(define (jolt-future-call thunk)
|
||||
(let ((f (make-jolt-future #f #f #f jolt-nil (make-mutex) (make-condition)))
|
||||
(snap (dyn-binding-stack)))
|
||||
(fork-thread
|
||||
(lambda ()
|
||||
(dyn-binding-stack snap)
|
||||
(let ((r (guard (e (#t (cons #f e))) (cons #t (jolt-invoke thunk)))))
|
||||
(with-mutex (jolt-future-mu f)
|
||||
(unless (jolt-future-done? f) ; not already cancelled
|
||||
(jolt-future-ok?-set! f (car r))
|
||||
(jolt-future-payload-set! f (cdr r))
|
||||
(jolt-future-done?-set! f #t))
|
||||
(condition-broadcast (jolt-future-cv f))))))
|
||||
f))
|
||||
|
||||
;; Final value of a settled future (called OUTSIDE the lock): re-raise a captured
|
||||
;; throw, signal a cancellation, else the value.
|
||||
(define (jolt-future-finish f)
|
||||
(cond
|
||||
((jolt-future-cancelled? f)
|
||||
(jolt-throw (jolt-ex-info "Future cancelled" (jolt-hash-map))))
|
||||
((jolt-future-ok? f) (jolt-future-payload f))
|
||||
(else (raise (jolt-future-payload f)))))
|
||||
|
||||
(define (jolt-future-deref f)
|
||||
(with-mutex (jolt-future-mu f)
|
||||
(let loop ()
|
||||
(unless (jolt-future-done? f)
|
||||
(condition-wait (jolt-future-cv f) (jolt-future-mu f))
|
||||
(loop))))
|
||||
(jolt-future-finish f))
|
||||
|
||||
;; (deref f timeout-ms timeout-val): wait up to timeout-ms; return timeout-val if
|
||||
;; it has not settled by the absolute deadline.
|
||||
(define (jolt-future-deref-timed f ms timeout-val)
|
||||
(let* ((deadline (ms->deadline ms))
|
||||
(settled (with-mutex (jolt-future-mu f)
|
||||
(let loop ()
|
||||
(cond ((jolt-future-done? f) #t)
|
||||
((condition-wait (jolt-future-cv f) (jolt-future-mu f) deadline)
|
||||
(loop)) ; woken — recheck
|
||||
(else (jolt-future-done? f))))))) ; timed out: final check
|
||||
(if settled (jolt-future-finish f) timeout-val)))
|
||||
|
||||
;; future-cancel: the running thread can't be interrupted, but the future object
|
||||
;; reflects the cancellation — if not already settled, mark it cancelled+done so
|
||||
;; derefs raise and the predicates flip. Returns true iff this call cancelled it.
|
||||
(define (jolt-future-cancel f)
|
||||
(let ((cancelled (with-mutex (jolt-future-mu f)
|
||||
(if (jolt-future-done? f)
|
||||
#f
|
||||
(begin (jolt-future-cancelled?-set! f #t)
|
||||
(jolt-future-done?-set! f #t)
|
||||
(condition-broadcast (jolt-future-cv f))
|
||||
#t)))))
|
||||
cancelled))
|
||||
|
||||
(define (jolt-future-done?* f) (and (jolt-future? f) (jolt-future-done? f)))
|
||||
(define (jolt-native-future-done? x)
|
||||
(if (jolt-future? x) (jolt-future-done? x)
|
||||
(jolt-throw (jolt-ex-info "future-done? requires a future" (jolt-hash-map)))))
|
||||
(define (jolt-native-future-cancelled? x)
|
||||
(and (jolt-future? x) (jolt-future-cancelled? x)))
|
||||
|
||||
;; --- promises ---------------------------------------------------------------
|
||||
;; A blocking promise (JVM), not Janet's non-blocking atom shim: deref parks until
|
||||
;; deliver, then caches the value. deliver wins once; later delivers return nil.
|
||||
(define-record-type jolt-promise
|
||||
(fields (mutable delivered?) (mutable value) mu cv)
|
||||
(nongenerative jolt-promise-v1))
|
||||
|
||||
(define (jolt-promise-new) (make-jolt-promise #f jolt-nil (make-mutex) (make-condition)))
|
||||
|
||||
(define (jolt-deliver p v)
|
||||
(if (jolt-promise? p)
|
||||
(let ((won (with-mutex (jolt-promise-mu p)
|
||||
(if (jolt-promise-delivered? p)
|
||||
#f
|
||||
(begin (jolt-promise-value-set! p v)
|
||||
(jolt-promise-delivered?-set! p #t)
|
||||
(condition-broadcast (jolt-promise-cv p))
|
||||
#t)))))
|
||||
(if won p jolt-nil))
|
||||
(jolt-throw (jolt-ex-info "deliver requires a promise" (jolt-hash-map)))))
|
||||
|
||||
(define (jolt-promise-deref p)
|
||||
(with-mutex (jolt-promise-mu p)
|
||||
(let loop ()
|
||||
(unless (jolt-promise-delivered? p)
|
||||
(condition-wait (jolt-promise-cv p) (jolt-promise-mu p))
|
||||
(loop))))
|
||||
(jolt-promise-value p))
|
||||
|
||||
(define (jolt-promise-deref-timed p ms timeout-val)
|
||||
(let* ((deadline (ms->deadline ms))
|
||||
(got (with-mutex (jolt-promise-mu p)
|
||||
(let loop ()
|
||||
(cond ((jolt-promise-delivered? p) #t)
|
||||
((condition-wait (jolt-promise-cv p) (jolt-promise-mu p) deadline)
|
||||
(loop))
|
||||
(else (jolt-promise-delivered? p)))))))
|
||||
(if got (jolt-promise-value p) timeout-val)))
|
||||
|
||||
;; --- deref extension --------------------------------------------------------
|
||||
;; Chain the fully-built jolt-deref (atoms/vars/volatiles/reduced) with futures +
|
||||
;; promises, and accept the timed (deref ref ms val) arity for both.
|
||||
(define %pre-conc-deref jolt-deref)
|
||||
(set! jolt-deref
|
||||
(lambda (x . opts)
|
||||
(cond
|
||||
((jolt-future? x)
|
||||
(if (null? opts) (jolt-future-deref x)
|
||||
(jolt-future-deref-timed x (car opts) (cadr opts))))
|
||||
((jolt-promise? x)
|
||||
(if (null? opts) (jolt-promise-deref x)
|
||||
(jolt-promise-deref-timed x (car opts) (cadr opts))))
|
||||
(else (apply %pre-conc-deref x opts)))))
|
||||
|
||||
;; realized? for a Chez future/promise (the overlay reads Janet map keys). Wrap the
|
||||
;; overlay version in post-prelude.ss; here just the future/promise predicate.
|
||||
(define (jolt-conc-realized? x)
|
||||
(cond ((jolt-future? x) (jolt-future-done? x))
|
||||
((jolt-promise? x) (jolt-promise-delivered? x))
|
||||
(else #f)))
|
||||
|
||||
;; --- bind into clojure.core -------------------------------------------------
|
||||
(def-var! "clojure.core" "future-call" jolt-future-call)
|
||||
(def-var! "clojure.core" "future-cancel" jolt-future-cancel)
|
||||
(def-var! "clojure.core" "future?" jolt-future?)
|
||||
(def-var! "clojure.core" "future-done?" jolt-native-future-done?)
|
||||
(def-var! "clojure.core" "future-cancelled?" jolt-native-future-cancelled?)
|
||||
(def-var! "clojure.core" "promise" jolt-promise-new)
|
||||
(def-var! "clojure.core" "deliver" jolt-deliver)
|
||||
(def-var! "clojure.core" "deref" jolt-deref)
|
||||
|
|
@ -15,11 +15,15 @@
|
|||
;; the stack before falling back to the cell root. Loaded LAST (after vars.ss and
|
||||
;; ns.ss) so it chains the fully-extended jolt-var-get and overrides rt.ss var-deref.
|
||||
|
||||
(define dyn-binding-stack '())
|
||||
;; THREAD-LOCAL (jolt-byjr): a Chez thread parameter, so each OS thread (a future
|
||||
;; / go block) has its own binding stack. Chez initializes a new thread's parameter
|
||||
;; to the spawning thread's value at fork time, giving Clojure binding conveyance
|
||||
;; for free (the future shim also installs an explicit snapshot, belt-and-suspenders).
|
||||
(define dyn-binding-stack (make-thread-parameter '()))
|
||||
|
||||
;; find the innermost (cell . value) pair binding CELL, or #f.
|
||||
(define (dyn-find-binding cell)
|
||||
(let loop ((frames dyn-binding-stack))
|
||||
(let loop ((frames (dyn-binding-stack)))
|
||||
(and (pair? frames)
|
||||
(or (assq cell (car frames))
|
||||
(loop (cdr frames))))))
|
||||
|
|
@ -28,7 +32,7 @@
|
|||
;; value happens to be jolt-nil.
|
||||
(define dyn-no-binding (list 'no-binding))
|
||||
(define (dyn-binding-value cell)
|
||||
(if (pair? dyn-binding-stack)
|
||||
(if (pair? (dyn-binding-stack))
|
||||
(let ((p (dyn-find-binding cell)))
|
||||
(if p
|
||||
(let ((val (cdr p)))
|
||||
|
|
@ -39,21 +43,21 @@
|
|||
;; push-thread-bindings: frame is a jolt map of var-cell -> value. Fold it into an
|
||||
;; identity-keyed alist of mutable pairs and push.
|
||||
(define (jolt-push-thread-bindings frame)
|
||||
(set! dyn-binding-stack
|
||||
(cons (pmap-fold frame (lambda (k v acc) (cons (cons k v) acc)) '())
|
||||
dyn-binding-stack))
|
||||
(dyn-binding-stack
|
||||
(cons (pmap-fold frame (lambda (k v acc) (cons (cons k v) acc)) '())
|
||||
(dyn-binding-stack)))
|
||||
jolt-nil)
|
||||
|
||||
(define (jolt-pop-thread-bindings)
|
||||
(when (pair? dyn-binding-stack)
|
||||
(set! dyn-binding-stack (cdr dyn-binding-stack)))
|
||||
(when (pair? (dyn-binding-stack))
|
||||
(dyn-binding-stack (cdr (dyn-binding-stack))))
|
||||
jolt-nil)
|
||||
|
||||
;; get-thread-bindings: a jolt map of every currently-bound cell -> value,
|
||||
;; innermost wins. Merge oldest-frame-first (the stack head is innermost). The
|
||||
;; result can be re-pushed by with-bindings* / bound-fn*.
|
||||
(define (jolt-get-thread-bindings)
|
||||
(let loop ((frames (reverse dyn-binding-stack)) (m (jolt-hash-map)))
|
||||
(let loop ((frames (reverse (dyn-binding-stack))) (m (jolt-hash-map)))
|
||||
(if (null? frames)
|
||||
m
|
||||
(loop (cdr frames)
|
||||
|
|
|
|||
|
|
@ -128,9 +128,16 @@
|
|||
(cons "PI" (->num (* 4 (atan 1)))) (cons "E" (->num (exp 1)))
|
||||
(cons "random" (lambda args (->num (random 1.0))))))
|
||||
|
||||
;; Thread: no real threading here (futures/timing are jolt-byjr). sleep is a no-op.
|
||||
;; Thread: real OS threads back futures/promises (jolt-byjr), so sleep genuinely
|
||||
;; parks the calling thread for `ms` milliseconds (a worker sleeping doesn't block
|
||||
;; the parent). yield hands off the scheduler.
|
||||
(register-class-statics! "Thread"
|
||||
(list (cons "sleep" (lambda (ms . _) jolt-nil))
|
||||
(list (cons "sleep" (lambda (ms . _)
|
||||
(let* ((ms* (exact (floor ms)))
|
||||
(secs (quotient ms* 1000))
|
||||
(nanos (* (remainder ms* 1000) 1000000)))
|
||||
(sleep (make-time 'time-duration nanos secs)))
|
||||
jolt-nil))
|
||||
(cons "yield" (lambda () jolt-nil))
|
||||
(cons "interrupted" (lambda () #f))
|
||||
(cons "currentThread" (lambda () (make-jhost "thread" '())))))
|
||||
|
|
|
|||
|
|
@ -38,3 +38,20 @@
|
|||
;; ns-name: the overlay reads (get ns :name) — nil on a jns namespace record.
|
||||
;; Native version (defined in ns.ss) returns the namespace's name symbol.
|
||||
(def-var! "clojure.core" "ns-name" jolt-ns-name)
|
||||
;; concurrency (jolt-byjr): the overlay's future-done?/future-cancelled?/realized?
|
||||
;; read a Janet future-map's :cached/:cancelled keys, and promise/deliver are a
|
||||
;; non-blocking atom shim. A Chez future/promise is a record, and we want JVM
|
||||
;; (blocking, shared-heap) semantics — re-assert the native versions. realized?
|
||||
;; wraps the overlay (which still handles delay/lazy-seq/atom) for non-futures.
|
||||
(def-var! "clojure.core" "future-done?" jolt-native-future-done?)
|
||||
(def-var! "clojure.core" "future-cancelled?" jolt-native-future-cancelled?)
|
||||
(def-var! "clojure.core" "future?" jolt-future?)
|
||||
(def-var! "clojure.core" "promise" jolt-promise-new)
|
||||
(def-var! "clojure.core" "deliver" jolt-deliver)
|
||||
(def-var! "clojure.core" "deref" jolt-deref)
|
||||
(let ((overlay-realized? (var-deref "clojure.core" "realized?")))
|
||||
(def-var! "clojure.core" "realized?"
|
||||
(lambda (x)
|
||||
(if (or (jolt-future? x) (jolt-promise? x))
|
||||
(jolt-conc-realized? x)
|
||||
(jolt-invoke overlay-realized? x)))))
|
||||
|
|
|
|||
|
|
@ -325,3 +325,9 @@
|
|||
;; on Chez, inc6b) calls these to build its expansion as reader forms. Needs the
|
||||
;; collection/seq layer + def-var!; order-independent past those.
|
||||
(load "host/chez/syntax-quote.ss")
|
||||
|
||||
;; concurrency (jolt-byjr): real OS-thread futures + blocking promises, shared-heap
|
||||
;; (JVM) semantics. Loaded LAST — chains the fully-built jolt-deref and conveys the
|
||||
;; thread-local binding stack (dyn-binding.ss) into workers. pmap/pcalls/pvalues
|
||||
;; (overlay, over `future`) light up once future-call exists here.
|
||||
(load "host/chez/concurrency.ss")
|
||||
|
|
|
|||
|
|
@ -945,7 +945,7 @@
|
|||
(guard (e (#t #f))
|
||||
(def-var! "clojure.core" "take-nth" (letrec ((take-nth (case-lambda ((n) (let fnrec177 ((n n)) (lambda (rf) (let fnrec178 ((rf rf)) (let* ((iv (jolt-invoke (var-deref "clojure.core" "volatile!") -1.0))) (case-lambda (() (let fnrec179 () (jolt-invoke rf ))) ((result) (let fnrec180 ((result result)) (jolt-invoke rf result))) ((result input) (let fnrec181 ((result result) (input input)) (let* ((i (jolt-invoke (var-deref "clojure.core" "vswap!") iv jolt-inc))) (if (jolt-zero? (remainder i n)) (jolt-invoke rf result input) result)))))))))) ((n coll) (let fnrec182 ((n n) (coll coll)) (jolt-invoke (var-deref "clojure.core" "make-lazy-seq") (lambda () (let fnrec183 () (jolt-invoke (var-deref "clojure.core" "coll->cells") (let* ((temp__15__auto (jolt-seq coll))) (if (jolt-truthy? temp__15__auto) (let* ((s temp__15__auto)) (jolt-cons (jolt-first s) (jolt-invoke take-nth n (jolt-drop n s)))) jolt-nil))))))))))) take-nth)))
|
||||
(guard (e (#t #f))
|
||||
(def-var! "clojure.core" "pmap" (letrec ((pmap (case-lambda ((f coll) (let fnrec184 ((f f) (coll coll)) (jolt-map (var-deref "clojure.core" "deref") (jolt-invoke (var-deref "clojure.core" "doall") (jolt-map (lambda (x) (let fnrec185 ((x x)) (host-static-call "clojure.core" "future-call" (lambda () (let fnrec186 () (jolt-invoke f x)))))) coll))))) ((f coll . colls) (let fnrec187 ((f f) (coll coll) (colls (list->cseq colls))) (jolt-invoke pmap (lambda (xs) (let fnrec188 ((xs xs)) (jolt-apply f xs))) (jolt-apply jolt-map jolt-vector coll colls))))))) pmap)))
|
||||
(def-var! "clojure.core" "pmap" (letrec ((pmap (case-lambda ((f coll) (let fnrec184 ((f f) (coll coll)) (jolt-map (var-deref "clojure.core" "deref") (jolt-invoke (var-deref "clojure.core" "doall") (jolt-map (lambda (x) (let fnrec185 ((x x)) (jolt-invoke (var-deref "clojure.core" "future-call") (lambda () (let fnrec186 () (jolt-invoke f x)))))) coll))))) ((f coll . colls) (let fnrec187 ((f f) (coll coll) (colls (list->cseq colls))) (jolt-invoke pmap (lambda (xs) (let fnrec188 ((xs xs)) (jolt-apply f xs))) (jolt-apply jolt-map jolt-vector coll colls))))))) pmap)))
|
||||
(guard (e (#t #f))
|
||||
(def-var! "clojure.core" "pcalls" (letrec ((pcalls (lambda fns (let fnrec189 ((fns (list->cseq fns))) (jolt-invoke (var-deref "clojure.core" "pmap") (lambda (f) (let fnrec190 ((f f)) (jolt-invoke f ))) fns))))) pcalls)))
|
||||
(guard (e (#t #f))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue