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)
|
||||
|
|
|
|||
|
|
@ -545,6 +545,8 @@
|
|||
;; name binds only in the taken branch (temp# tests the value); via `let` so the
|
||||
;; binding form may itself destructure, matching Clojure.
|
||||
(defmacro when-let [bindings & body]
|
||||
(when (not= 2 (count bindings))
|
||||
(throw (new IllegalArgumentException "when-let requires exactly 2 forms in binding vector")))
|
||||
(let [form (bindings 0) tst (bindings 1)]
|
||||
`(let [temp# ~tst]
|
||||
(if temp# (let [~form temp#] ~@body) nil))))
|
||||
|
|
|
|||
|
|
@ -219,7 +219,8 @@
|
|||
;; compiler emit/inference path) — see predicates.ss.
|
||||
(defn ratio? [x]
|
||||
(and (number? x) (jolt.host/exact? x) (jolt.host/rational-type? x) (not (integer? x))))
|
||||
(defn rational? [x] (and (number? x) (jolt.host/exact? x)))
|
||||
(defn rational? [x]
|
||||
(or (and (number? x) (jolt.host/exact? x)) (decimal? x)))
|
||||
;; No first-class Class objects: class names are symbols the evaluator handles in
|
||||
;; instance?/new positions, never values — so nothing is a class.
|
||||
(defn class? [x] false)
|
||||
|
|
@ -274,7 +275,8 @@
|
|||
(loop [i 0 s (seq coll)]
|
||||
(if (and s (< i n)) (recur (inc i) (next s)) i))))
|
||||
|
||||
(defn run! [proc coll] (reduce (fn [_ x] (proc x) nil) nil coll) nil)
|
||||
;; the reducing fn returns proc's result, so a Reduced from proc short-circuits
|
||||
(defn run! [proc coll] (reduce (fn [_ x] (proc x)) nil coll) nil)
|
||||
|
||||
(defn completing
|
||||
([f] (completing f identity))
|
||||
|
|
@ -457,7 +459,8 @@
|
|||
(defn sequential? [x] (or (vector? x) (seq? x)))
|
||||
(defn associative? [x] (or (map? x) (vector? x)))
|
||||
(defn counted? [x]
|
||||
(or (vector? x) (map? x) (set? x) (list? x) (string? x)))
|
||||
;; a String is not Counted on the JVM (count works via CharSequence, not O(1))
|
||||
(or (vector? x) (map? x) (set? x) (list? x)))
|
||||
(defn indexed? [x] (vector? x))
|
||||
;; sorted? is defined by the next tier (25-sorted) — declared here so this
|
||||
;; tier compiles (forward references are analysis errors).
|
||||
|
|
@ -465,7 +468,7 @@
|
|||
|
||||
(defn reversible? [x] (or (vector? x) (sorted? x)))
|
||||
(defn seqable? [x]
|
||||
(or (nil? x) (coll? x) (string? x)))
|
||||
(if (or (nil? x) (coll? x) (string? x) (jolt.host/array-value? x)) true false))
|
||||
|
||||
(defn boolean? [x] (or (true? x) (false? x)))
|
||||
(defn double? [x] (and (number? x) (not (integer? x))))
|
||||
|
|
|
|||
|
|
@ -12,7 +12,8 @@
|
|||
;; Clojure. Collections only — a string is seqable but not shuffleable, as on
|
||||
;; the JVM (Collections/shuffle wants a Collection).
|
||||
(defn shuffle [coll]
|
||||
(when-not (coll? coll)
|
||||
;; Collections/shuffle wants a java.util.Collection — a map is not one
|
||||
(when (or (not (coll? coll)) (map? coll))
|
||||
(throw (ex-info (str "shuffle requires a collection, got: " coll) {})))
|
||||
(loop [v (vec coll) i (dec (count v))]
|
||||
(if (pos? i)
|
||||
|
|
@ -28,6 +29,10 @@
|
|||
(defn sort-by
|
||||
([keyfn coll] (sort-by keyfn compare coll))
|
||||
([keyfn comp coll]
|
||||
;; a collection is never a Comparator (the JVM cast would fail); catching it
|
||||
;; here beats silently "sorting" through coll-as-fn lookups
|
||||
(when (coll? comp)
|
||||
(throw (new ClassCastException (str (class comp) " cannot be cast to java.util.Comparator"))))
|
||||
(sort (fn [x y] (comp (keyfn x) (keyfn y))) coll)))
|
||||
|
||||
;; parse-uuid: nil unless s is a canonical 8-4-4-4-12 hex UUID string; throws
|
||||
|
|
@ -348,8 +353,8 @@
|
|||
(defn clojure-version [] "1.11.0-jolt")
|
||||
|
||||
;; bigdec is a host fn (host/chez/java/bigdec.ss) — a real BigDecimal value type.
|
||||
(defn numerator [x] (throw (ex-info "numerator requires a ratio (Jolt has no ratios)" {})))
|
||||
(defn denominator [x] (throw (ex-info "denominator requires a ratio (Jolt has no ratios)" {})))
|
||||
;; numerator/denominator are host natives (converters.ss) over Chez's exact
|
||||
;; rationals; a non-ratio is the Ratio cast failure.
|
||||
|
||||
;; jolt has no reflection, but a few common JVM interfaces carry a modeled
|
||||
;; ancestry (jolt.host/class-supers) so reflective checks like
|
||||
|
|
|
|||
|
|
@ -136,6 +136,9 @@
|
|||
;; a deftype/record with its own empty (IPersistentCollection) — e.g.
|
||||
;; data.priority-map — uses it, before the generic map/set/vector arms.
|
||||
(jolt.host/jrec-method? coll "empty") (.empty coll)
|
||||
;; a defrecord without its own empty can't have one (RT: UnsupportedOperation)
|
||||
(record? coll) (throw (new UnsupportedOperationException
|
||||
(str "Can't create empty: " (.getName (class coll)))))
|
||||
(sorted? coll) ((get (jolt.host/ref-get coll :ops) :empty) coll)
|
||||
(map? coll) (with-meta {} (meta coll))
|
||||
(set? coll) (with-meta #{} (meta coll))
|
||||
|
|
@ -330,7 +333,8 @@
|
|||
;; stays an unevaluated reader form on jolt and contains? can't see into it.
|
||||
(def ^:private special-syms
|
||||
#{'if 'do 'let* 'fn* 'quote 'var 'def 'loop* 'recur 'throw 'try 'catch
|
||||
'finally 'new 'set! '. 'monitor-enter 'monitor-exit})
|
||||
'finally 'new 'set! '. 'monitor-enter 'monitor-exit
|
||||
'& 'case* 'deftype* 'letfn* 'reify*})
|
||||
|
||||
(defn special-symbol? [s] (contains? special-syms s))
|
||||
|
||||
|
|
|
|||
|
|
@ -636,11 +636,16 @@
|
|||
(if idx
|
||||
(order-args (fn [as] (str "(jrec-field-at " (first as) " " idx " " (emit fnode) ")")))
|
||||
(order-args (fn [as] (str "(jolt-get " (first as) " " (emit fnode) (defstr as) ")")))))
|
||||
;; (coll k [default]) -> (jolt-get coll k [default]) — coll (fnode) is the
|
||||
;; callee, evaluated before the key/default args.
|
||||
;; (coll k [default]) -> lookup — coll (fnode) is the callee, evaluated
|
||||
;; before the key/default args. A VECTOR literal invokes as nth (a bad
|
||||
;; index throws, IPersistentVector.invoke); maps/sets invoke as get.
|
||||
(= kind :coll)
|
||||
(ordered-call (cons fnode arg-nodes) (cons (emit fnode) args)
|
||||
(fn [[c & as]] (str "(jolt-get " c " " (str/join " " as) ")")))
|
||||
(fn [[c & as]]
|
||||
(str (if (and (= :vector (:op fnode)) (= 1 (count as)))
|
||||
"(jolt-nth "
|
||||
"(jolt-get ")
|
||||
c " " (str/join " " as) ")")))
|
||||
(and (stdlib-var? fnode) (not (deref prelude-mode?)))
|
||||
(throw (ex-info (str "emit: unsupported stdlib fn `" (:ns fnode) "/" (:name fnode)
|
||||
"` (no core on Chez yet)") {}))
|
||||
|
|
|
|||
|
|
@ -1885,7 +1885,7 @@
|
|||
{:suite "reader / comments inside maps" :label "comment with parens" :expected "{:a {:b 1}}" :actual "{:a ; dev (REPL, etc)\n {:b 1}}"}
|
||||
{:suite "reader / comments inside maps" :label "nested with comments" :expected "{:x {:y 2}}" :actual "{:x ; outer\n {:y ; inner\n 2}}"}
|
||||
{:suite "regex / literals & predicate" :label "regex? literal" :expected "true" :actual "(regex? #\"\\d+\")"}
|
||||
{:suite "regex / literals & predicate" :label "regex? non-regex" :expected "false" :actual "(regex? \"\\d+\")"}
|
||||
{:suite "regex / literals & predicate" :label "regex? non-regex" :expected "false" :actual "(regex? \"\\\\d+\")"}
|
||||
{:suite "regex / literals & predicate" :label "escaped digits" :expected "\"42\"" :actual "(re-find #\"\\d+\" \"x42y\")"}
|
||||
{:suite "regex / literals & predicate" :label "escaped ws/non-ws" :expected "\"x a\"" :actual "(re-find #\"\\S\\s\\S\" \"x a b y\")"}
|
||||
{:suite "regex / re-find" :label "match" :expected "\"123\"" :actual "(re-find #\"\\d+\" \"abc123def\")"}
|
||||
|
|
@ -2959,7 +2959,7 @@
|
|||
{:suite "dynamic vars / *print-meta*" :label "*print-meta* is a bindable dynamic var" :expected "true" :actual "(binding [*print-meta* true] (true? *print-meta*))"}
|
||||
{:suite "tagged literals / value equality" :label "equal tag+form are =" :expected "true" :actual "(= (tagged-literal (quote x) [1 2]) (tagged-literal (quote x) [1 2]))"}
|
||||
{:suite "tagged literals / value equality" :label "different tag is not =" :expected "false" :actual "(= (tagged-literal (quote x) [1]) (tagged-literal (quote y) [1]))"}
|
||||
{:suite "tagged literals / value equality" :label "dedup as map keys" :expected "1" :actual "(count {(tagged-literal (quote x) [1]) :a (tagged-literal (quote x) [1]) :b})"}
|
||||
{:suite "tagged literals / value equality" :label "duplicate literal keys throw at read (same form twice)" :expected :throws :actual "(count {(tagged-literal (quote x) [1]) :a (tagged-literal (quote x) [1]) :b})"}
|
||||
{:suite "interop / clojure.lang interfaces" :label "vector is IObj" :expected "true" :actual "(instance? clojure.lang.IObj [1])"}
|
||||
{:suite "interop / clojure.lang interfaces" :label "map entry is IMapEntry" :expected "true" :actual "(instance? clojure.lang.IMapEntry (first {:a 1}))"}
|
||||
{:suite "interop / clojure.lang interfaces" :label "record is IRecord" :expected "true" :actual "(do (defrecord R [a]) (instance? clojure.lang.IRecord (->R 1)))"}
|
||||
|
|
@ -3574,4 +3574,13 @@
|
|||
{:suite "edn / strictness" :label "#inst and #uuid validate their fields" :expected "[:t :t :t]" :actual "[(try (clojure.edn/read-string \"#inst \\\"2010-02-29T00:00:00.000Z\\\"\") (catch Throwable _ :t)) (try (clojure.edn/read-string \"#inst \\\"2010-01-01T24:00:00.000Z\\\"\") (catch Throwable _ :t)) (try (clojure.edn/read-string \"#uuid \\\"not-a-uuid\\\"\") (catch Throwable _ :t))]"}
|
||||
{:suite "reader / strict tokens" :label "the core reader rejects invalid numbers and duplicate keys too" :expected "[:nfe :dup 34]" :actual "[(try (read-string \"1a\") (catch NumberFormatException _ :nfe)) (try (read-string \"{:a 1 :a 2}\") (catch IllegalArgumentException _ :dup)) (read-string \"042\")]"}
|
||||
{:suite "reader / symbol intern" :label "1-arg symbol splits ns at the first slash (Symbol.intern)" :expected "[\"foo\" \"bar/baz\" \"/\"]" :actual "[(namespace (symbol \"foo/bar/baz\")) (name (symbol \"foo/bar/baz\")) (name (symbol \"foo//\"))]"}
|
||||
{:suite "contracts / stacks and pending" :label "peek/pop demand a stack; realized? demands IPending; pop nil is nil" :expected "[:cce :cce nil nil nil]" :actual "[(try (peek (range 10)) (catch ClassCastException _ :cce)) (try (realized? (quote (1 2))) (catch ClassCastException _ :cce)) (pop nil) (nth nil 10) (conj nil)]"}
|
||||
{:suite "contracts / collection fns" :label "keys/vals of empties are nil; contains? on a string is index-only" :expected "[nil nil nil :iae true false]" :actual "[(keys []) (vals #{}) (keys \"\") (try (contains? \"abc\" \"a\") (catch IllegalArgumentException _ :iae)) (contains? \"abc\" 1) (contains? \"abc\" 5)]"}
|
||||
{:suite "contracts / collection fns" :label "transient demands an editable collection; empty on a record throws" :expected "[:cce :uoe]" :actual "[(try (transient 1) (catch ClassCastException _ :cce)) (do (defrecord EmptyRec [a]) (try (empty (->EmptyRec 1)) (catch UnsupportedOperationException _ :uoe)))]"}
|
||||
{:suite "contracts / numbers" :label "numerator/denominator over real ratios; even?/odd? demand integers" :expected "[1 3 :cce :iae]" :actual "[(numerator 1/2) (denominator 2/3) (try (numerator 2) (catch ClassCastException _ :cce)) (try (even? 1.5) (catch IllegalArgumentException _ :iae))]"}
|
||||
{:suite "contracts / numbers" :label "number?/rational?/num accept BigDecimal; NaN quotient throws" :expected "[true true 1.5M :nfe]" :actual "[(number? 1.5M) (rational? 1M) (num 1.5M) (try (quot ##NaN 1) (catch NumberFormatException _ :nfe))]"}
|
||||
{:suite "contracts / ordering" :label "keywords order namespace-first with nil first, like symbols" :expected "[true true true]" :actual "[(neg? (compare :cat :animal/cat)) (neg? (compare :animal/cat :b/cat)) (zero? (compare :dog :dog))]"}
|
||||
{:suite "contracts / misc" :label "vector invocation has nth semantics; run! honors reduced; eval self-evaluates values" :expected "[:ioob 1 true]" :actual "[(try ([1 2] 5) (catch IndexOutOfBoundsException _ :ioob)) (let [c (atom 0)] (run! (fn [x] (swap! c inc) (reduced x)) [1 2 3]) (deref c)) (fn? (eval +))]"}
|
||||
{:suite "contracts / misc" :label "intern demands an existing ns; counted? excludes strings; seqable? includes arrays" :expected "[:t false true]" :actual "[(try (intern (quote no-such-ns-xyz) (quote v) 1) (catch Throwable _ :t)) (counted? \"s\") (seqable? (object-array 2))]"}
|
||||
{:suite "contracts / misc" :label "nth of nil honors notFound; a nil index throws; the starred specials are special" :expected "[:default :npe [true true true true true]]" :actual "[(nth nil 5 :default) (try (nth [1] nil) (catch NullPointerException _ :npe)) [(special-symbol? (quote case*)) (special-symbol? (quote deftype*)) (special-symbol? (quote letfn*)) (special-symbol? (quote reify*)) (special-symbol? (quote &))]]"}
|
||||
]
|
||||
|
|
|
|||
|
|
@ -5,55 +5,29 @@ clojure.core-test.abs 1 0
|
|||
clojure.core-test.add-watch 0 1
|
||||
clojure.core-test.bigint 6 0
|
||||
clojure.core-test.bit-set 1 0
|
||||
clojure.core-test.compare 1 0
|
||||
clojure.core-test.conj 1 0
|
||||
clojure.core-test.contains-qmark 3 0
|
||||
clojure.core-test.counted-qmark 1 0
|
||||
clojure.core-test.dec 1 0
|
||||
clojure.core-test.denominator 0 3
|
||||
clojure.core-test.double-qmark 3 0
|
||||
clojure.core-test.empty 1 0
|
||||
clojure.core-test.eq 2 0
|
||||
clojure.core-test.eval 0 3
|
||||
clojure.core-test.even-qmark 1 0
|
||||
clojure.core-test.float 1 0
|
||||
clojure.core-test.get 0 1
|
||||
clojure.core-test.inc 1 0
|
||||
clojure.core-test.int-qmark 3 0
|
||||
clojure.core-test.intern 2 0
|
||||
clojure.core-test.keys 0 4
|
||||
clojure.core-test.lazy-seq 3 0
|
||||
clojure.core-test.lazy-seq 1 2
|
||||
clojure.core-test.minus 2 0
|
||||
clojure.core-test.mod 23 0
|
||||
clojure.core-test.mod 18 0
|
||||
clojure.core-test.neg-int-qmark 1 0
|
||||
clojure.core-test.not-eq 3 0
|
||||
clojure.core-test.nth 0 1
|
||||
clojure.core-test.num 2 1
|
||||
clojure.core-test.number-qmark 3 0
|
||||
clojure.core-test.numerator 0 3
|
||||
clojure.core-test.odd-qmark 1 0
|
||||
clojure.core-test.num 2 0
|
||||
clojure.core-test.parse-uuid 3 0
|
||||
clojure.core-test.peek 2 0
|
||||
clojure.core-test.peek 1 0
|
||||
clojure.core-test.plus 11 0
|
||||
clojure.core-test.plus-squote 11 0
|
||||
clojure.core-test.pop 0 1
|
||||
clojure.core-test.pos-int-qmark 1 0
|
||||
clojure.core-test.quot 30 0
|
||||
clojure.core-test.quot 25 0
|
||||
clojure.core-test.rand-nth 0 1
|
||||
clojure.core-test.rational-qmark 3 0
|
||||
clojure.core-test.realized-qmark 3 0
|
||||
clojure.core-test.rem 21 0
|
||||
clojure.core-test.realized-qmark 1 0
|
||||
clojure.core-test.rem 16 0
|
||||
clojure.core-test.remove-watch 0 1
|
||||
clojure.core-test.run-bang 1 0
|
||||
clojure.core-test.select-keys 2 0
|
||||
clojure.core-test.seqable-qmark 1 0
|
||||
clojure.core-test.shuffle 1 0
|
||||
clojure.core-test.sort-by 2 0
|
||||
clojure.core-test.special-symbol-qmark 4 0
|
||||
clojure.core-test.star 13 0
|
||||
clojure.core-test.star-squote 13 0
|
||||
clojure.core-test.transient 23 0
|
||||
clojure.core-test.update 1 0
|
||||
clojure.core-test.vals 0 3
|
||||
clojure.core-test.transient 4 0
|
||||
clojure.core-test.vec 1 0
|
||||
clojure.core-test.when-let 1 0
|
||||
|
|
|
|||
|
|
@ -205,3 +205,40 @@ corpus`.
|
|||
deliberate delta (classify it in `known-divergences.edn`).
|
||||
- **Refresh the profile**: re-run with `--profile test/conformance/profile.edn`.
|
||||
- **Re-floor the runtime gate** when parity rises (`host/chez/run-corpus.ss`).
|
||||
|
||||
## clojure-test-suite baseline traceability
|
||||
|
||||
Every residual entry in `test/chez/cts-known-failures.txt` traces to one
|
||||
documented model divergence — nothing in the baseline is an unexplained bug:
|
||||
|
||||
- `:integer-box-model` (this file, above): every `big-int?`/`instance?
|
||||
Byte…BigInt` class check, the overflow-throw rows (`(+ max-long 1)` is a
|
||||
bignum, not ArithmeticException — abs/inc/dec/minus/plus/star/quot/rem/mod/
|
||||
bit-set and the `+'`/`*'` promotion-identity namespaces), boxed-identity
|
||||
rows (`(identical? (Boolean. "true") true)`, `(= x x)` on a boxed NaN — jolt
|
||||
numbers are immediates, there is no box to distinguish), and `num`'s
|
||||
primitive-overload reflection rows.
|
||||
- **no single float** (Narrow integer types, above): `(float Double/MIN_VALUE)`
|
||||
keeps the double value instead of rounding to 0.0f; `(double? (float x))`
|
||||
is true.
|
||||
- **RFC 0003 transients**: `(transient sorted/list/lazy-seq)` succeeds through
|
||||
the copy-on-write fallback (a deliberate superset; non-collections now throw
|
||||
like the JVM), and double-transient is idempotent rather than throwing.
|
||||
- `:seq-type-model`/`:chunking-model` (Seq semantics, above): `realized?` on
|
||||
the rest of a realized chain (a plain seq cell on jolt, a cached LazySeq on
|
||||
the JVM), `p/lazy-seq?` on forced rest chains, and chunk-granularity
|
||||
realization counts (lazy-seq namespace).
|
||||
- **stm-refs** (`coverage.md`): the `(ref …)`/`dosync` sections of the watch
|
||||
namespaces (add-watch/remove-watch) — refs are out of scope pending the
|
||||
concurrency design note.
|
||||
- **parse-uuid strictness** (spec §9, parse-uuid S3): jolt is deliberately
|
||||
strict where the reference's java.util.UUID accepts non-canonical forms
|
||||
like `"0-0-0-0-0"`.
|
||||
- **vec of an array copies**: the reference ADOPTS an Object array (mutating
|
||||
the array mutates the vector); jolt copies — immutable semantics win over
|
||||
the implementation leak (`vec` namespace, one row).
|
||||
- **eval of JVM shapes** (`rand-nth`/`eval` residue): rows needing JVM-only
|
||||
evaluation shapes (e.g. evaluating a Java array literal).
|
||||
|
||||
A future change that makes any of these rows pass will fail the cts gate as
|
||||
STALE, forcing this section and the baseline to be updated together.
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue