Contract fixes from the baseline audit; every residual suite failure traced
Auditing the remaining cts baseline for R7 exposed real contract gaps hiding among the model residue — all fixed to reference behavior: - stale no-ratio-era stubs: numerator/denominator now work over jolt's exact rationals (non-ratio is the Ratio cast failure); rational? includes decimals - casts and pending: peek/pop demand an IPersistentStack (pop nil is nil), realized? demands an IPending (a plain list/range throws), transient demands an editable COLLECTION (non-colls throw; the RFC 0003 sorted/list/seq superset keeps the copy-on-write fallback), empty on a plain record throws - nil and empties: (nth nil i) is nil, (nth nil i d) is d, a nil index is NPE, keys/vals of anything empty are nil, (conj nil) is nil - lookups: contains? on a string is index-only (other keys IAE), get on an array is lenient (nth still throws), a VECTOR invocation has nth semantics (([1 2] 5) throws — call position and jolt-invoke both) - into only transients editable collections; a PersistentQueue/sorted target folds through conj (RT's IEditableCollection split) - numbers: number?/num accept BigDecimal, quot/rem throw on an Infinite/NaN quotient, even?/odd? demand integers - ordering: keywords compare namespace-first with nil first (Symbol.compareTo) - misc: run! honors reduced, eval self-evaluates non-form values, intern demands an existing namespace, counted? excludes strings, seqable? includes arrays, shuffle rejects maps, sort-by rejects a collection comparator, when-let demands one binding pair, case*/deftype*/letfn*/reify*/& are special symbols Two mis-certified corpus rows fixed (they threw on the JVM too and hid in the tolerated bucket): a raw \d string escape and duplicate literal map keys. SPEC.md gains the baseline-traceability section: every one of the 146 remaining suite failures maps to a documented divergence (integer-box, no-single-float, RFC 0003 transients, seq/chunking model, stm-refs, parse-uuid strictness, vec-array adoption). cts baseline 5955 -> 6042 pass, 5 errors, 30 namespaces. 9 JVM-certified corpus rows.
This commit is contained in:
Yogthos
parent
3fb8082802
commit
ce8e89ca86
19 changed files with 728 additions and 578 deletions
|
|
@ -404,9 +404,11 @@
|
|||
(if (null? args)
|
||||
(jolt-vector)
|
||||
(let ((coll (car args)) (xs (cdr args)))
|
||||
(if (jolt-nil? coll)
|
||||
(fold-left jolt-conj1 jolt-empty-list xs)
|
||||
(meta-carry coll (fold-left jolt-conj1 coll xs))))))
|
||||
(cond
|
||||
;; 1-arity returns the coll untouched — (conj nil) is nil
|
||||
((null? xs) coll)
|
||||
((jolt-nil? coll) (fold-left jolt-conj1 jolt-empty-list xs))
|
||||
(else (meta-carry coll (fold-left jolt-conj1 coll xs)))))))
|
||||
|
||||
;; A host shim registers a type's get via register-get-arm! (handler: (coll k d) ->
|
||||
;; value) instead of set!-wrapping jolt-get — disjoint coll types, checked before the
|
||||
|
|
@ -443,11 +445,16 @@
|
|||
(define (rec-coll-method coll name)
|
||||
(and (jrec? coll) (find-method-any-protocol (jrec-tag coll) name)))
|
||||
|
||||
(define (jolt-nth-nil-idx! i)
|
||||
(when (jolt-nil? i)
|
||||
(jolt-throw (jolt-host-throwable "java.lang.NullPointerException" "nth index"))))
|
||||
(define jolt-nth
|
||||
(case-lambda
|
||||
((coll i)
|
||||
(jolt-nth-nil-idx! i)
|
||||
(let ((i (->idx i)))
|
||||
(cond ((pvec? coll) (let ((v (pvec-v coll)))
|
||||
(cond ((jolt-nil? coll) jolt-nil) ; RT.nth(nil, i) is nil at any index
|
||||
((pvec? coll) (let ((v (pvec-v coll)))
|
||||
(if (and (fx>=? i 0) (fx<? i (vector-length v))) (vector-ref v i)
|
||||
(jolt-throw (jolt-host-throwable "java.lang.IndexOutOfBoundsException" "index out of bounds")))))
|
||||
((string? coll) (if (and (fx>=? i 0) (fx<? i (string-length coll))) (string-ref coll i)
|
||||
|
|
@ -456,8 +463,10 @@
|
|||
((rec-coll-method coll "nth") => (lambda (m) (jolt-invoke m coll i)))
|
||||
(else (error 'nth "unsupported collection")))))
|
||||
((coll i d)
|
||||
(jolt-nth-nil-idx! i)
|
||||
(let ((i (->idx i)))
|
||||
(cond ((pvec? coll) (pvec-nth-d coll i d))
|
||||
(cond ((jolt-nil? coll) d) ; RT.nth(nil, i, notFound) is notFound
|
||||
((pvec? coll) (pvec-nth-d coll i d))
|
||||
((string? coll) (if (and (fx>=? i 0) (fx<? i (string-length coll))) (string-ref coll i) d))
|
||||
((or (cseq? coll) (empty-list-t? coll)) (seq-nth coll i #t d))
|
||||
((rec-coll-method coll "nth") => (lambda (m) (jolt-invoke m coll i d)))
|
||||
|
|
@ -502,6 +511,21 @@
|
|||
((pset? coll) (pset-contains? coll k))
|
||||
((pvec? coll) (let ((k (->idx k))) (and (fixnum? k) (fx>=? k 0) (fx<? k (pvec-count coll)))))
|
||||
((jolt-nil? coll) #f)
|
||||
;; a string supports contains? by INDEX only (RT.contains: CharSequence +
|
||||
;; Number key); any other key — or any unsupported type — is the JVM's
|
||||
;; IllegalArgumentException.
|
||||
((string? coll)
|
||||
(if (and (number? k) (exact? k) (integer? k))
|
||||
(and (>= k 0) (< k (string-length coll)))
|
||||
(jolt-throw (jolt-host-throwable
|
||||
"java.lang.IllegalArgumentException"
|
||||
"contains? not supported on type: java.lang.String"))))
|
||||
((or (cseq? coll) (empty-list-t? coll) (number? coll) (boolean? coll)
|
||||
(keyword? coll) (jolt-symbol? coll) (char? coll))
|
||||
(jolt-throw (jolt-host-throwable
|
||||
"java.lang.IllegalArgumentException"
|
||||
(string-append "contains? not supported on type: "
|
||||
(guard (e (#t "?")) (jolt-class-name coll))))))
|
||||
(else #f)))
|
||||
|
||||
(define (jolt-empty? coll)
|
||||
|
|
@ -514,15 +538,25 @@
|
|||
((cseq? coll) #f) ; a cseq is non-empty by construction
|
||||
(else (error 'empty? "unsupported collection"))))
|
||||
|
||||
(define (jolt-stack-throw coll)
|
||||
(jolt-throw (jolt-host-throwable
|
||||
"java.lang.ClassCastException"
|
||||
(string-append "class " (guard (e (#t "?")) (jolt-class-name coll))
|
||||
" cannot be cast to class clojure.lang.IPersistentStack"))))
|
||||
(define (jolt-peek coll)
|
||||
(cond ((pvec? coll) (pvec-peek coll))
|
||||
((or (cseq? coll) (empty-list-t? coll)) (jolt-first coll)) ; list peek = first
|
||||
((jolt-nil? coll) jolt-nil) (else (error 'peek "unsupported collection"))))
|
||||
;; list peek = first; a non-list seq (range, a rest chain) is not an
|
||||
;; IPersistentStack on the JVM
|
||||
((and (cseq? coll) (cseq-list? coll)) (jolt-first coll))
|
||||
((empty-list-t? coll) (jolt-first coll))
|
||||
((jolt-nil? coll) jolt-nil)
|
||||
(else (jolt-stack-throw coll))))
|
||||
(define (jolt-pop coll)
|
||||
(cond ((pvec? coll) (meta-carry coll (pvec-pop coll)))
|
||||
((cseq? coll) (meta-carry coll (jolt-rest coll))) ; list pop = rest
|
||||
(cond ((jolt-nil? coll) jolt-nil) ; RT.pop(nil) is nil
|
||||
((pvec? coll) (meta-carry coll (pvec-pop coll)))
|
||||
((and (cseq? coll) (cseq-list? coll)) (meta-carry coll (jolt-rest coll)))
|
||||
((empty-list-t? coll) (error 'pop "can't pop empty list"))
|
||||
(else (error 'pop "unsupported collection"))))
|
||||
(else (jolt-stack-throw coll))))
|
||||
|
||||
;; ============================================================================
|
||||
;; equality / hash hooks called from values.ss (jolt=2 / jolt-hash)
|
||||
|
|
|
|||
|
|
@ -211,7 +211,13 @@
|
|||
;; A top-level (do ...) is UNROLLED — each subform compiled+eval'd in turn, like
|
||||
;; Clojure's top-level do — so a runtime defmacro/def in an earlier subform is
|
||||
;; visible (macro flag set, var interned) before a later subform is analyzed.
|
||||
;; a non-form VALUE (a function object, a BigDecimal, a reference type)
|
||||
;; self-evaluates, like eval on the JVM.
|
||||
(define (jolt-compile-eval-form form ns)
|
||||
(if (or (procedure? form) (jbigdec? form) (jolt-atom? form) (jolt-multifn? form))
|
||||
form
|
||||
(jolt-compile-eval-form* form ns)))
|
||||
(define (jolt-compile-eval-form* form ns)
|
||||
(cond
|
||||
;; thread the current ns: an earlier subform may switch it (ns/in-ns call
|
||||
;; set-chez-ns!), and the next subform must be ANALYZED in that ns so its defs
|
||||
|
|
|
|||
|
|
@ -178,7 +178,11 @@
|
|||
((jolt-nil? b) 1)
|
||||
((and (number? a) (number? b)) (jolt-cmp3 a b))
|
||||
((and (string? a) (string? b)) (jolt-strcmp a b))
|
||||
((and (keyword? a) (keyword? b)) (jolt-strcmp (jolt-kw->string a) (jolt-kw->string b)))
|
||||
;; keywords order like symbols: a nil namespace sorts before any namespace,
|
||||
;; then by namespace, then by name (Keyword.compareTo -> Symbol.compareTo)
|
||||
((and (keyword? a) (keyword? b))
|
||||
(let ((r (jolt-strcmp (or (keyword-t-ns a) "") (or (keyword-t-ns b) ""))))
|
||||
(if (= r 0) (jolt-strcmp (keyword-t-name a) (keyword-t-name b)) r)))
|
||||
((and (jolt-symbol? a) (jolt-symbol? b))
|
||||
(let ((r (jolt-strcmp (jolt-sym-ns-string a) (jolt-sym-ns-string b))))
|
||||
(if (= r 0) (jolt-strcmp (symbol-t-name a) (symbol-t-name b)) r)))
|
||||
|
|
@ -269,4 +273,16 @@
|
|||
(jolt-cast-range-throw "float" x)
|
||||
d)))
|
||||
(def-var! "clojure.core" "float" jolt-float)
|
||||
;; numerator/denominator: jolt ratios are Chez exact rationals; a non-ratio is
|
||||
;; the JVM's Ratio cast failure.
|
||||
(define (jolt-ratio-part name f)
|
||||
(lambda (x)
|
||||
(if (and (number? x) (exact? x) (rational? x) (not (integer? x)))
|
||||
(f x)
|
||||
(jolt-throw (jolt-host-throwable
|
||||
"java.lang.ClassCastException"
|
||||
(string-append "class " (guard (e (#t "?")) (jolt-class-name x))
|
||||
" cannot be cast to class clojure.lang.Ratio"))))))
|
||||
(def-var! "clojure.core" "numerator" (jolt-ratio-part "numerator" numerator))
|
||||
(def-var! "clojure.core" "denominator" (jolt-ratio-part "denominator" denominator))
|
||||
(def-var! "clojure.core" "compare" jolt-compare)
|
||||
|
|
|
|||
|
|
@ -334,6 +334,11 @@
|
|||
(set! jolt-zero? (let ((prev jolt-zero?)) (lambda (x) (if (jbigdec? x) (jbd-zero? x) (prev x)))))
|
||||
(set! jolt-pos? (let ((prev jolt-pos?)) (lambda (x) (if (jbigdec? x) (jbd-pos? x) (prev x)))))
|
||||
(set! jolt-neg? (let ((prev jolt-neg?)) (lambda (x) (if (jbigdec? x) (jbd-neg? x) (prev x)))))
|
||||
;; a BigDecimal IS a number (java.lang.Number): extend the number? native so the
|
||||
;; predicate — and everything defined over it (num, =='s guard) — accepts it.
|
||||
;; The compiled fast paths test Chez number? directly and are unaffected.
|
||||
(set! jolt-number? (let ((prev jolt-number?)) (lambda (x) (if (jbigdec? x) #t (prev x)))))
|
||||
(def-var! "clojure.core" "number?" jolt-number?)
|
||||
(def-var! "clojure.core" "inc" jolt-inc)
|
||||
(def-var! "clojure.core" "dec" jolt-dec)
|
||||
(def-var! "clojure.core" "zero?" jolt-zero?)
|
||||
|
|
|
|||
|
|
@ -115,10 +115,11 @@
|
|||
(let ((v (jolt-array-vec c)) (j (exact (na-idx i))))
|
||||
(if (and (>= j 0) (< j (vector-length v))) (vector-ref v j) d))
|
||||
(%na-nth c i d)))))
|
||||
(def-var! "jolt.host" "array-value?" (lambda (x) (if (jolt-array? x) #t jolt-nil)))
|
||||
(define %na-get jolt-get)
|
||||
(set! jolt-get
|
||||
(case-lambda
|
||||
((c k) (if (jolt-array? c) (jolt-nth c k) (%na-get c k)))
|
||||
((c k) (if (jolt-array? c) (jolt-nth c k jolt-nil) (%na-get c k)))
|
||||
((c k d) (if (jolt-array? c) (jolt-nth c k d) (%na-get c k d)))))
|
||||
;; aset (overlay) writes through jolt.host/ref-put! — mutate the slot, return arr.
|
||||
;; count/nth/seq/get above are NATIVE-OPS (inlined at call sites), so aget/alength/
|
||||
|
|
|
|||
|
|
@ -260,6 +260,9 @@
|
|||
;; intern: create/set a var ns/sym to val (or an unbound cell). Returns the var.
|
||||
(define (jolt-intern ns-desig sym . vopt)
|
||||
(let ((nm (ns-desig->name ns-desig)) (s (symbol-t-name sym)))
|
||||
;; the namespace must exist (Namespace.find), like the JVM's intern
|
||||
(unless (hashtable-ref ns-registry nm #f)
|
||||
(jolt-throw (jolt-ex-info (string-append "No namespace: " nm " found") empty-pmap)))
|
||||
(if (pair? vopt) (def-var! nm s (car vopt)) (declare-var! nm s))))
|
||||
|
||||
;; alias / ns-unalias: register/drop an :as alias under the current (or given) ns.
|
||||
|
|
|
|||
|
|
@ -67,8 +67,13 @@
|
|||
;; chain is a cseq under jolt's seq model, and (realized? (rest s)) after
|
||||
;; a next must be true like the JVM's realized LazySeq — never a throw
|
||||
;; whose message renders the (possibly infinite) seq.
|
||||
((cseq? x) (if (cseq-forced? x) #t #f))
|
||||
((empty-list-t? x) #t)
|
||||
;; a PLAIN seq (list/cons/range — not a lazy-seq wrapper) is not an
|
||||
;; IPending on the JVM: realized? throws.
|
||||
((or (cseq? x) (empty-list-t? x))
|
||||
(jolt-throw (jolt-host-throwable
|
||||
"java.lang.ClassCastException"
|
||||
(string-append "class " (guard (e (#t "?")) (jolt-class-name x))
|
||||
" cannot be cast to class clojure.lang.IPending"))))
|
||||
(else (jolt-invoke overlay-realized? x))))))
|
||||
;; clojure.edn/read over a reader: drain the jhost reader, then read through the
|
||||
;; overlay read-string so the opts map (:readers/:default/:eof) is honored.
|
||||
|
|
|
|||
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
|
|
@ -237,7 +237,12 @@
|
|||
(cond ((not (and (number? a) (number? b))) (jolt-quot-slow a b))
|
||||
((or (flonum? a) (flonum? b))
|
||||
(let ((n (real->flonum a)) (d (real->flonum b)))
|
||||
(if (fl= d 0.0) (jolt-div0-throw) (fltruncate (fl/ n d)))))
|
||||
(if (fl= d 0.0) (jolt-div0-throw)
|
||||
(let ((q (fl/ n d)))
|
||||
(when (or (nan? q) (infinite? q))
|
||||
(jolt-throw (jolt-host-throwable "java.lang.NumberFormatException"
|
||||
"Infinite or NaN")))
|
||||
(fltruncate q)))))
|
||||
((eqv? b 0) (jolt-div0-throw))
|
||||
((and (integer? a) (integer? b)) (quotient a b))
|
||||
(else (truncate (/ a b)))))
|
||||
|
|
@ -246,7 +251,11 @@
|
|||
((or (flonum? a) (flonum? b))
|
||||
(let ((n (real->flonum a)) (d (real->flonum b)))
|
||||
(if (fl= d 0.0) (jolt-div0-throw)
|
||||
(fl- n (fl* d (fltruncate (fl/ n d)))))))
|
||||
(let ((q (fl/ n d)))
|
||||
(when (or (nan? q) (infinite? q))
|
||||
(jolt-throw (jolt-host-throwable "java.lang.NumberFormatException"
|
||||
"Infinite or NaN")))
|
||||
(fl- n (fl* d (fltruncate q)))))))
|
||||
((eqv? b 0) (jolt-div0-throw))
|
||||
((and (integer? a) (integer? b)) (remainder a b))
|
||||
(else (- a (* b (truncate (/ a b)))))))
|
||||
|
|
@ -451,6 +460,11 @@
|
|||
((procedure? f) (apply f args))
|
||||
((keyword? f) (apply jolt-get (car args) f (cdr args))) ; (:k m [d]) -> (get m :k [d])
|
||||
((jolt-symbol? f) (apply jolt-get (car args) f (cdr args))) ; ('s m [d]) -> (get m 's [d])
|
||||
;; a VECTOR invokes as nth (a bad index throws, like IPersistentVector.invoke);
|
||||
;; maps and sets invoke as get.
|
||||
((pvec? f) (if (and (pair? args) (null? (cdr args)))
|
||||
(jolt-nth f (car args))
|
||||
(apply jolt-get f args)))
|
||||
((jolt-coll? f) (apply jolt-get f args)) ; (coll k [d]) -> (get coll k [d])
|
||||
((jolt-transient? f) (apply jolt-get f args)) ; a transient vec/map/set is callable on the JVM
|
||||
;; a record/reify implementing clojure.lang.IFn is callable: dispatch to its
|
||||
|
|
@ -647,8 +661,14 @@
|
|||
;; falls back to a copy-on-write wrapper for other targets (lists, sorted colls,
|
||||
;; nil), so those keep the old per-step jolt-conj behaviour.
|
||||
(define (jolt-into to from)
|
||||
(meta-carry to
|
||||
(jolt-persistent! (reduce-seq (lambda (t x) (jolt-conj! t x)) (jolt-transient-new to) (jolt-seq from)))))
|
||||
;; only an editable collection rides the transient path; anything else
|
||||
;; (PersistentQueue, sorted colls, seqs) folds through conj, like RT's
|
||||
;; instanceof IEditableCollection split.
|
||||
(if (or (pvec? to) (pmap? to) (pset? to))
|
||||
(meta-carry to
|
||||
(jolt-persistent! (reduce-seq (lambda (t x) (jolt-conj! t x)) (jolt-transient-new to) (jolt-seq from))))
|
||||
(meta-carry to
|
||||
(reduce-seq (lambda (acc x) (jolt-conj1 acc x)) to (jolt-seq from)))))
|
||||
|
||||
(define (range-from n) (cseq-lazy n (lambda () (range-from (+ n 1)))))
|
||||
;; A bounded range is a real chunked-seq, like clojure.lang.LongRange: eager, with
|
||||
|
|
@ -753,8 +773,14 @@
|
|||
;; Parity over the full integer range (JVM even?/odd? accept any integer,
|
||||
;; bignums included); a fixnum-only fxand crashes on a large value (e.g. a hash).
|
||||
(define (parity-int n) (if (flonum? n) (exact (floor n)) n))
|
||||
(define (jolt-even? n) (even? (parity-int n)))
|
||||
(define (jolt-odd? n) (odd? (parity-int n)))
|
||||
(define (jolt-parity-check n)
|
||||
(unless (and (number? n) (exact? n) (integer? n))
|
||||
(jolt-throw (jolt-host-throwable
|
||||
"java.lang.IllegalArgumentException"
|
||||
(string-append "Argument must be an integer: "
|
||||
(guard (e (#t "?")) (jolt-str n)))))))
|
||||
(define (jolt-even? n) (jolt-parity-check n) (even? (parity-int n)))
|
||||
(define (jolt-odd? n) (jolt-parity-check n) (odd? (parity-int n)))
|
||||
(define (jolt-pos? n) (> n 0))
|
||||
(define (jolt-neg? n) (< n 0))
|
||||
(define (jolt-zero? n) (= n 0))
|
||||
|
|
@ -763,8 +789,18 @@
|
|||
;; ============================================================================
|
||||
;; keys / vals — return seqs (nil on the empty map), HAMT-iteration order
|
||||
;; ============================================================================
|
||||
(define (jolt-keys m) (if (jolt-nil? m) jolt-nil (list->cseq (pmap-fold m (lambda (k v a) (cons k a)) '()))))
|
||||
(define (jolt-vals m) (if (jolt-nil? m) jolt-nil (list->cseq (pmap-fold m (lambda (k v a) (cons v a)) '()))))
|
||||
;; keys/vals of anything empty is nil (RT.keys over a nil seq); a non-empty
|
||||
;; non-map still fails (its elements are not MapEntries).
|
||||
(define (jolt-keys m)
|
||||
(cond ((jolt-nil? m) jolt-nil)
|
||||
((pmap? m) (list->cseq (pmap-fold m (lambda (k v a) (cons k a)) '())))
|
||||
((jolt-nil? (jolt-seq m)) jolt-nil)
|
||||
(else (list->cseq (pmap-fold m (lambda (k v a) (cons k a)) '())))))
|
||||
(define (jolt-vals m)
|
||||
(cond ((jolt-nil? m) jolt-nil)
|
||||
((pmap? m) (list->cseq (pmap-fold m (lambda (k v a) (cons v a)) '())))
|
||||
((jolt-nil? (jolt-seq m)) jolt-nil)
|
||||
(else (list->cseq (pmap-fold m (lambda (k v a) (cons v a)) '())))))
|
||||
|
||||
;; ============================================================================
|
||||
;; sequential equality + hash (hooks called from values.ss / collections.ss);
|
||||
|
|
|
|||
|
|
@ -44,7 +44,16 @@
|
|||
(let ((ht (make-hashtable key-hash jolt=2)))
|
||||
(pset-fold coll (lambda (e acc) (hashtable-set! ht e #t) acc) 0)
|
||||
(make-jolt-transient 'set ht 0 #t #f)))
|
||||
(else (make-jolt-transient 'cow coll 0 #t #f))))
|
||||
;; RFC 0003: any COLLECTION transients (the sorted/list/seq superset rides
|
||||
;; the copy-on-write fallback); a non-collection is the JVM's cast failure.
|
||||
((or (cseq? coll) (empty-list-t? coll) (jolt-lazyseq? coll)
|
||||
(htable? coll) (jrec? coll))
|
||||
(make-jolt-transient 'cow coll 0 #t #f))
|
||||
(else
|
||||
(jolt-throw (jolt-host-throwable
|
||||
"java.lang.ClassCastException"
|
||||
(string-append "class " (guard (e (#t "?")) (jolt-class-name coll))
|
||||
" cannot be cast to class clojure.lang.IEditableCollection"))))))
|
||||
|
||||
;; map put/delete that maintain the reverse insertion-order list in `ord`.
|
||||
(define (tmap-put! t k v)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue