delay exception memoization, deftype cross-protocol method merge, more map-like dispatch
Further clojure.core.cache fixes (198 -> 257 of its assertions): - delay: a throwing body re-ran on every force and never became realized?. Run it once like Clojure's Delay — cache the exception, mark realized, re-throw the same on each deref. Fixes value-fn memoization / cache-stampede protection. - deftype/defrecord: a method name appearing in two protocols with different arities (data.priority-map's seq is in IPersistentMap [this] AND Sorted [this asc]) registered per-protocol and shadowed; merge clauses by name across all protocols into one multi-arity fn. - empty?/peek/pop (IPersistentStack) dispatch through a deftype's methods; (= a- deftype other) uses its equiv method (so caches compare to their backing map); seq handles a host iterator (iterator-seq over .iterator). - pop of an empty PersistentQueue returns it, like the JVM (was an error). JVM-certified corpus rows. make test + shakesmoke green.
This commit is contained in:
parent
c445aaeaa2
commit
5d0989a860
7 changed files with 614 additions and 581 deletions
|
|
@ -228,15 +228,21 @@
|
|||
;; (delay body) -> (make-delay (fn [] body)) (overlay macro); force/deref run the
|
||||
;; thunk once under a lock and cache the value (JVM delays are thread-safe). force
|
||||
;; (overlay) is (if (delay? x) (deref x) x), so it works once delay?/deref do.
|
||||
(define-record-type jolt-delay (fields thunk (mutable realized?) (mutable value) mu)
|
||||
(define-record-type jolt-delay (fields thunk (mutable realized?) (mutable value) (mutable exn) mu)
|
||||
(nongenerative jolt-delay-v1))
|
||||
(define (jolt-make-delay thunk) (make-jolt-delay thunk #f jolt-nil (make-mutex)))
|
||||
(define (jolt-make-delay thunk) (make-jolt-delay thunk #f jolt-nil #f (make-mutex)))
|
||||
;; run the thunk once, like Clojure's Delay: if it throws, cache the exception
|
||||
;; (the delay IS realized) and re-throw it on every deref — do NOT re-run the
|
||||
;; body (so value-fns memoize and there is no cache-stampede / retried side
|
||||
;; effect). Store the exception inside the lock, re-raise outside it so the mutex
|
||||
;; is always released.
|
||||
(define (jolt-delay-force d)
|
||||
(with-mutex (jolt-delay-mu d)
|
||||
(unless (jolt-delay-realized? d)
|
||||
(jolt-delay-value-set! d (jolt-invoke (jolt-delay-thunk d)))
|
||||
(jolt-delay-realized?-set! d #t)))
|
||||
(jolt-delay-value d))
|
||||
(guard (e (#t (jolt-delay-exn-set! d e) (jolt-delay-realized?-set! d #t)))
|
||||
(jolt-delay-value-set! d (jolt-invoke (jolt-delay-thunk d)))
|
||||
(jolt-delay-realized?-set! d #t))))
|
||||
(if (jolt-delay-exn d) (raise (jolt-delay-exn d)) (jolt-delay-value d)))
|
||||
|
||||
;; --- deref extension --------------------------------------------------------
|
||||
;; Chain the fully-built jolt-deref (atoms/vars/volatiles/reduced) with futures,
|
||||
|
|
|
|||
|
|
@ -19,7 +19,9 @@
|
|||
(define (queue-peek q) (if (null? (jolt-queue-front q)) jolt-nil (car (jolt-queue-front q))))
|
||||
(define (queue-pop q)
|
||||
(let ((f (jolt-queue-front q)))
|
||||
(cond ((null? f) (error 'pop "can't pop empty queue"))
|
||||
;; popping an empty PersistentQueue returns it (Clojure's pop: if f==null
|
||||
;; return this) — unlike a vector, which throws.
|
||||
(cond ((null? f) q)
|
||||
((null? (cdr f)) (make-jolt-queue (reverse (jolt-queue-rear q)) '() (fx- (jolt-queue-cnt q) 1)))
|
||||
(else (make-jolt-queue (cdr f) (jolt-queue-rear q) (fx- (jolt-queue-cnt q) 1))))))
|
||||
|
||||
|
|
|
|||
|
|
@ -62,8 +62,16 @@
|
|||
"}"))
|
||||
|
||||
;; ---- extend the collection dispatchers with a jrec arm ----------------------
|
||||
;; equality for a jrec: a deftype implementing IPersistentCollection/equiv (e.g.
|
||||
;; core.cache's caches, which equiv to their backing map) compares through that
|
||||
;; method, so (= cache {…}) works; a plain record has no equiv and falls back to
|
||||
;; field-wise jrec=? (and a record is never = a plain map).
|
||||
(register-eq-arm! (lambda (a b) (or (jrec? a) (jrec? b)))
|
||||
(lambda (a b) (and (jrec? a) (jrec? b) (jrec=? a b))))
|
||||
(lambda (a b)
|
||||
(cond ((and (jrec? a) (jrec-cl a "equiv")) => (lambda (m) (if (jolt-truthy? (jolt-invoke m a b)) #t #f)))
|
||||
((and (jrec? b) (jrec-cl b "equiv")) => (lambda (m) (if (jolt-truthy? (jolt-invoke m b a)) #t #f)))
|
||||
((and (jrec? a) (jrec? b)) (jrec=? a b))
|
||||
(else #f))))
|
||||
(register-hash-arm! jrec? jrec-hash)
|
||||
;; get on a jrec: a real field reads raw (so a deftype method's own field bindings,
|
||||
;; compiled to (get inst :field), never recurse); a NON-field key on a deftype that
|
||||
|
|
@ -131,6 +139,10 @@
|
|||
(else (%r-jolt-conj1 coll x)))))
|
||||
;; peek/pop on a deftype implementing IPersistentStack (data.priority-map, which
|
||||
;; core.cache's LRU/LU caches lean on) dispatch to its methods.
|
||||
;; empty? over a jrec: a map-like deftype is empty iff its entry seq is (data
|
||||
;; .priority-map's peek calls (.isEmpty this) -> empty?). jolt-seq is method-first.
|
||||
(define %r-jolt-empty? jolt-empty?)
|
||||
(set! jolt-empty? (lambda (coll) (if (jrec? coll) (jolt-nil? (jolt-seq coll)) (%r-jolt-empty? coll))))
|
||||
(define %r-jolt-peek jolt-peek)
|
||||
(set! jolt-peek (lambda (coll)
|
||||
(cond ((jrec-cl coll "peek") => (lambda (m) (jolt-invoke m coll)))
|
||||
|
|
@ -357,6 +369,10 @@
|
|||
;; holding a mutable cursor over (seq coll); (.hasNext it)/(.next it) walk it.
|
||||
;; hiccup/compiler's run! loop iterates collections this way.
|
||||
(define-record-type jiterator (fields (mutable cur)) (nongenerative jolt-iterator-v1))
|
||||
;; (seq an-iterator) / (iterator-seq it): a jiterator wraps the remaining seq in
|
||||
;; cur, so seq just yields it — clojure.test's (iterator-seq (.iterator coll)).
|
||||
(let ((prev-seq jolt-seq))
|
||||
(set! jolt-seq (lambda (x) (if (jiterator? x) (jiterator-cur x) (prev-seq x)))))
|
||||
;; A Chez condition's message string (for Throwable .getMessage/.toString): the
|
||||
;; &message text plus any &irritants, or display-condition output as a fallback.
|
||||
(define (condition->message-string c)
|
||||
|
|
|
|||
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
Loading…
Add table
Add a link
Reference in a new issue