Run core.memoize's test suite on jolt
Shaking out clojure.core.memoize (207 assertions, 0 fail) cleared several
general gaps:
- deref/@ on a deftype or reify implementing clojure.lang.IDeref dispatches to
its deref method (RetryingDelay / make-derefable).
- deftype mutable fields (^:unsynchronized-mutable / ^:volatile-mutable) are
read live: a set! within a method is observed by a later read in the same
invocation, not the entry-time capture. Needed for double-checked locking.
Immutable fields stay let-bound. Field reads rewrite to (.-field inst) with
lexical-shadow tracking.
- def metadata values are evaluated, like Clojure: ^{:k (f)} stores (f)'s
result and ^{:af some-fn} the fn. :tag stays a literal hint.
- try dispatches catch clauses by class in order via the exception supertype
hierarchy; a non-matching value re-throws, an untyped host condition is caught
by a RuntimeException/Exception/Throwable clause. Previously the last clause
won and the class was ignored.
- locking takes a real per-object monitor (recursive Chez mutex) now that
futures/agents/threads share one heap; it was a no-op.
- supers/ancestors reflect a small modeled JVM interface hierarchy, so
(ancestors (class f)) yields Runnable/Callable (core.memoize's arg check).
- AssertionError / Error constructors.
JOLT_FEATURES is gone from the docs: it isn't read anywhere on Chez, and the
reader already includes :clj in its default feature set. RFC 0002's
{:jolt :default} design was reverted in the reader; docs now match the code.
Raises the SCI floor 205 -> 210.
This commit is contained in:
parent
3dde290f1a
commit
d21ab77e7e
18 changed files with 1179 additions and 939 deletions
|
|
@ -260,6 +260,12 @@
|
|||
(jolt-promise-deref-timed x (car opts) (cadr opts))))
|
||||
((jolt-agent? x) (jolt-agent-state x))
|
||||
((jolt-delay? x) (jolt-delay-force x))
|
||||
;; a record/reify implementing clojure.lang.IDeref: @x calls its `deref`
|
||||
;; method with the value itself as the leading `this`.
|
||||
((and (jrec? x) (find-method-any-protocol (jrec-tag x) "deref"))
|
||||
=> (lambda (m) (jolt-invoke m x)))
|
||||
((and (reified-methods x) (hashtable-ref (reified-methods x) "deref" #f))
|
||||
=> (lambda (m) (jolt-invoke m x)))
|
||||
(else (apply %pre-conc-deref x opts)))))
|
||||
|
||||
;; realized? for a future/promise/delay. Wrapped over the overlay version in
|
||||
|
|
@ -289,6 +295,26 @@
|
|||
(def-var! "clojure.core" "delay?" jolt-delay?)
|
||||
(def-var! "clojure.core" "deref" jolt-deref)
|
||||
|
||||
;; --- object monitors (locking) ----------------------------------------------
|
||||
;; (locking obj body…) takes obj's monitor for the body — a real per-object lock
|
||||
;; now that futures/agents/threads share one heap. Each object gets a recursive
|
||||
;; Chez mutex (a thread may re-enter a monitor it already holds, like the JVM),
|
||||
;; held in an identity-keyed weak table so monitors are reclaimed with their
|
||||
;; objects. dynamic-wind releases on normal, exceptional, and continuation exit.
|
||||
(define monitor-table (make-weak-eq-hashtable))
|
||||
(define monitor-table-lock (make-mutex))
|
||||
(define (object-monitor obj)
|
||||
(with-mutex monitor-table-lock
|
||||
(or (hashtable-ref monitor-table obj #f)
|
||||
(let ((m (make-mutex))) (hashtable-set! monitor-table obj m) m))))
|
||||
(define (jolt-with-monitor obj thunk)
|
||||
(let ((m (object-monitor obj)))
|
||||
(dynamic-wind
|
||||
(lambda () (mutex-acquire m))
|
||||
thunk
|
||||
(lambda () (mutex-release m)))))
|
||||
(def-var! "jolt.host" "with-monitor" jolt-with-monitor)
|
||||
|
||||
;; --- cooperative thread interrupt -------------------------------------------
|
||||
;; Chez has no force-kill, but its engine timer (set-timer + timer-interrupt-
|
||||
;; handler, thread-local) is polled at procedure-call / loop back-edges — so a
|
||||
|
|
|
|||
|
|
@ -456,7 +456,8 @@
|
|||
'("Throwable" "Exception" "RuntimeException" "IllegalArgumentException" "IllegalStateException"
|
||||
"InterruptedException" "UnsupportedOperationException" "IOException" "NumberFormatException"
|
||||
"ArithmeticException" "NullPointerException" "ClassCastException" "IndexOutOfBoundsException"
|
||||
"FileNotFoundException" "UnsupportedEncodingException" "EOFException" "java.io.EOFException"))
|
||||
"FileNotFoundException" "UnsupportedEncodingException" "EOFException" "java.io.EOFException"
|
||||
"Error" "AssertionError"))
|
||||
|
||||
;; ---- URLEncoder / URLDecoder (www-form-urlencoded) --------------------------
|
||||
(define (url-unreserved? b)
|
||||
|
|
@ -742,3 +743,42 @@
|
|||
|
||||
;; (jolt.host/table? x) — is x a host tagged-table?
|
||||
(def-var! "jolt.host" "table?" (lambda (x) (if (htable? x) #t #f)))
|
||||
|
||||
;; --- minimal JVM class/interface ancestry -----------------------------------
|
||||
;; A handful of libraries reflect over the class hierarchy — e.g. core.memoize
|
||||
;; validates its first argument with (some #{IFn AFn Runnable Callable}
|
||||
;; (ancestors (class f))). jolt models a class as its name string and has no
|
||||
;; reflection, so supers/ancestors return nothing on their own. This table gives
|
||||
;; the common interfaces the direct supers the JVM reports, and the overlay's
|
||||
;; supers/ancestors fold it in. Keyed by canonical class name; value = direct
|
||||
;; supers. Extend as more interfaces are exercised.
|
||||
(define class-supers-tbl (make-hashtable string-hash string=?))
|
||||
(define (reg-class-supers! name supers) (hashtable-set! class-supers-tbl name supers))
|
||||
(reg-class-supers! "clojure.lang.IFn" '("java.lang.Runnable" "java.util.concurrent.Callable"))
|
||||
(reg-class-supers! "clojure.lang.AFn" '("clojure.lang.IFn" "java.lang.Runnable" "java.util.concurrent.Callable"))
|
||||
(reg-class-supers! "clojure.lang.AFunction" '("clojure.lang.AFn" "clojure.lang.IFn" "clojure.lang.Fn"
|
||||
"java.lang.Runnable" "java.util.concurrent.Callable"))
|
||||
|
||||
;; transitive closure of direct supers (set semantics via an accumulator list)
|
||||
(define (class-ancestors-list name)
|
||||
(let loop ((pending (hashtable-ref class-supers-tbl name '())) (seen '()))
|
||||
(cond ((null? pending) (reverse seen))
|
||||
((member (car pending) seen) (loop (cdr pending) seen))
|
||||
(else (loop (append (hashtable-ref class-supers-tbl (car pending) '()) (cdr pending))
|
||||
(cons (car pending) seen))))))
|
||||
|
||||
;; (jolt.host/class-supers name) / (jolt.host/class-ancestors name) — a jolt seq of
|
||||
;; super / ancestor class-name strings, or nil when jolt models no hierarchy for it.
|
||||
(def-var! "jolt.host" "class-supers"
|
||||
(lambda (x)
|
||||
(let ((name (class-key x)))
|
||||
(if (and name (hashtable-contains? class-supers-tbl name))
|
||||
(list->cseq (hashtable-ref class-supers-tbl name '()))
|
||||
jolt-nil))))
|
||||
(def-var! "jolt.host" "class-ancestors"
|
||||
(lambda (x)
|
||||
(let ((name (class-key x)))
|
||||
(if name
|
||||
(let ((as (class-ancestors-list name)))
|
||||
(if (null? as) jolt-nil (list->cseq as)))
|
||||
jolt-nil))))
|
||||
|
|
|
|||
|
|
@ -119,3 +119,26 @@
|
|||
;; records.ss, so this set! sees the registry — forward refs resolve at call time.
|
||||
|
||||
(def-var! "clojure.core" "instance-check" instance-check)
|
||||
|
||||
;; Broad-catch fallback for catch-clause dispatch (analyze-try desugars
|
||||
;; (catch C e …) to (or (instance? C e) (__catch-broad? "C" e))). A jolt host
|
||||
;; condition or a raw raised value carries no jolt exception class, so instance?
|
||||
;; can't place it; a Clojure (catch C e) over such a value matches when C is
|
||||
;; RuntimeException (or a subclass) / Exception / Throwable — most host runtime
|
||||
;; errors are RuntimeExceptions. Typed throwables (ex-info, (SomeException. …)) are
|
||||
;; recognized by instance? as Throwable, so untyped? is false and they dispatch
|
||||
;; precisely through the instance? arm instead.
|
||||
(define throwable-type-sym (jolt-symbol #f "Throwable"))
|
||||
(define (simple-class-name nm)
|
||||
(let loop ((i (- (string-length nm) 1)))
|
||||
(cond ((< i 0) nm)
|
||||
((char=? (string-ref nm i) #\.) (substring nm (+ i 1) (string-length nm)))
|
||||
(else (loop (- i 1))))))
|
||||
(define (jolt-catch-broad? nm v)
|
||||
(and (not (instance-check throwable-type-sym v))
|
||||
(let ((s (simple-class-name nm)))
|
||||
(or (exception-isa? s "RuntimeException")
|
||||
(string=? s "Exception")
|
||||
(string=? s "Throwable")))))
|
||||
(def-var! "clojure.core" "__catch-broad?"
|
||||
(lambda (nm v) (if (jolt-catch-broad? nm v) #t #f)))
|
||||
|
|
|
|||
|
|
@ -1,11 +1,11 @@
|
|||
;; run-sci.ss — SCI conformance: load borkdude/sci's own source (vendor/sci) through
|
||||
;; joltc and require its forms to compile+eval. A real-world Clojure-compatibility
|
||||
;; stress test. Floor-gated like the corpus: a regression below
|
||||
;; the floor (or the count today, 205/218) fails. Raise the floor as host gaps close
|
||||
;; the floor (or the count today, 210/218) fails. Raise the floor as host gaps close
|
||||
;; (the tail is genuine gaps — set! on vars, some macro/def shapes).
|
||||
;;
|
||||
;; chez --script host/chez/run-sci.ss
|
||||
;; JOLT_SCI_FLOOR=N override the floor (default 205)
|
||||
;; JOLT_SCI_FLOOR=N override the floor (default 210)
|
||||
;; SCI_VERBOSE=1 print each failing form's error
|
||||
(import (chezscheme))
|
||||
|
||||
|
|
@ -74,7 +74,7 @@
|
|||
load-order)
|
||||
|
||||
(printf "\nSCI load: ~a/~a forms ok (~a fail)\n" total-ok (+ total-ok total-fail) total-fail)
|
||||
(define floor (let ((s (getenv "JOLT_SCI_FLOOR"))) (if s (string->number s) 205)))
|
||||
(define floor (let ((s (getenv "JOLT_SCI_FLOOR"))) (if s (string->number s) 210)))
|
||||
(when (< total-ok floor)
|
||||
(printf "REGRESSION: ~a forms loaded < floor ~a\n" total-ok floor))
|
||||
(flush-output-port)
|
||||
|
|
|
|||
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