diff --git a/host/chez/host-static.ss b/host/chez/host-static.ss index 23d571c..95e0937 100644 --- a/host/chez/host-static.ss +++ b/host/chez/host-static.ss @@ -208,7 +208,12 @@ (list (cons "valueOf" (lambda (x . _) (if (jolt-nil? x) "null" (jolt-str-render-one x)))))) (register-class-statics! "Class" - (list (cons "forName" (lambda (nm) (make-jhost "class" (list (cons 'name nm))))))) + ;; an array descriptor ("[C", "[I", …) is its own class token (so instance? and + ;; class compare equal); other names become a class jhost. + (list (cons "forName" (lambda (nm) + (if (and (> (string-length nm) 0) (char=? (string-ref nm 0) #\[)) + nm + (make-jhost "class" (list (cons 'name nm)))))))) ;; ---- System helpers (defined before use above via top-level order) ---------- (define (sys-get-property k . dflt) diff --git a/host/chez/natives-array.ss b/host/chez/natives-array.ss index b7ddf1d..4937032 100644 --- a/host/chez/natives-array.ss +++ b/host/chez/natives-array.ss @@ -8,6 +8,14 @@ (define-record-type jolt-array (fields (mutable vec) kind) (nongenerative jolt-array-v1)) +;; JVM array class name per element kind ((class (int-array 3)) -> "[I", like the +;; JVM's Class.getName for arrays). Object arrays use the descriptor form. +(define (na-array-class-name arr) + (case (jolt-array-kind arr) + ((int) "[I") ((long) "[J") ((short) "[S") ((double) "[D") + ((float) "[F") ((boolean) "[Z") ((byte) "[B") ((char) "[C") + (else "[Ljava.lang.Object;"))) + (define (na-idx i) (if (and (number? i) (not (exact? i))) (exact (floor i)) i)) (define (na-from-seq x kind) (make-jolt-array (list->vector (seq->list (jolt-seq x))) kind)) ;; (T-array size) | (T-array size init) | (T-array seq) @@ -22,13 +30,22 @@ ;; --- constructors ----------------------------------------------------------- (define (na-object-array a . rest) (na-num-array a rest jolt-nil 'object)) -(define (na-int-array a . rest) (na-num-array a rest 0.0 'int)) -(define (na-long-array a . rest) (na-num-array a rest 0.0 'long)) -(define (na-short-array a . rest) (na-num-array a rest 0.0 'short)) +;; integer kinds default to exact 0 (JVM int/long/short 0 -> "0", not "0.0"). +(define (na-int-array a . rest) (na-num-array a rest 0 'int)) +(define (na-long-array a . rest) (na-num-array a rest 0 'long)) +(define (na-short-array a . rest) (na-num-array a rest 0 'short)) (define (na-double-array a . rest) (na-num-array a rest 0.0 'double)) (define (na-float-array a . rest) (na-num-array a rest 0.0 'float)) (define (na-boolean-array a . rest) (na-num-array a rest #f 'boolean)) -;; char-array stays in io.ss (a char-SEQ that io/reader / str / slurp consume). +;; char-array is a real 'char array (instance? "[C"), seqing as chars via the +;; dispatchers below — io/reader (extended here) and str/slurp consume the seq. +(define (na-char-array a . rest) + (cond + ((string? a) (make-jolt-array (list->vector (string->list a)) 'char)) + ((number? a) (make-jolt-array (make-vector (exact (na-idx a)) #\nul) 'char)) + (else (make-jolt-array + (list->vector (map (lambda (c) (if (char? c) c (integer->char (exact (truncate c))))) + (seq->list (jolt-seq a)))) 'char)))) (define (na-byte-array a . rest) (if (number? a) (make-jolt-array (make-vector (exact (na-idx a)) (na-byte-of (if (pair? rest) (car rest) 0))) 'byte) @@ -102,6 +119,37 @@ (%na-ref-put! t k v)))) (def-var! "jolt.host" "ref-put!" jolt-ref-put!) +;; --- array identity: type / class / instance? recognize arrays --------------- +;; (type arr) / (class arr) -> the JVM array class name; (class …) delegates to +;; (jolt-type …) for arrays, so extending jolt-type covers both. +(define %na-type jolt-type) +(set! jolt-type (lambda (x) (if (jolt-array? x) (na-array-class-name x) (%na-type x)))) +(def-var! "clojure.core" "type" jolt-type) + +;; instance? over an array class token ([I, [C, …). The token reaches us as a +;; string (Class/forName "[C") or symbol; normalize, and pass a non-array string +;; token on as a symbol so the inner wrappers' symbol-t-name doesn't choke. +(define %na-instance-check instance-check) +(set! instance-check + (lambda (type-sym val) + (let ((tname (cond ((string? type-sym) type-sym) + ((symbol-t? type-sym) (symbol-t-name type-sym)) + (else #f)))) + (cond + ((and tname (> (string-length tname) 0) (char=? (string-ref tname 0) #\[)) + (and (jolt-array? val) (string=? (na-array-class-name val) tname))) + ((string? type-sym) (%na-instance-check (jolt-symbol #f type-sym) val)) + (else (%na-instance-check type-sym val)))))) +(def-var! "clojure.core" "instance-check" instance-check) + +;; clojure.java.io/reader over a char-array reads its chars (the JVM char[] branch). +(def-var! "clojure.java.io" "reader" + (lambda (x) + (if (jolt-array? x) + (host-new "StringReader" + (apply string-append (map jolt-str-render-one (seq->list (jolt-seq x))))) + (jolt-io-reader x)))) + ;; --- bind into clojure.core ------------------------------------------------- (for-each (lambda (p) (def-var! "clojure.core" (car p) (cdr p))) (list @@ -109,7 +157,9 @@ (cons "long-array" na-long-array) (cons "short-array" na-short-array) (cons "double-array" na-double-array) (cons "float-array" na-float-array) (cons "boolean-array" na-boolean-array) - (cons "byte-array" na-byte-array) (cons "make-array" na-make-array) + (cons "byte-array" na-byte-array) (cons "char-array" na-char-array) + (cons "array?" (lambda (x) (jolt-array? x))) + (cons "make-array" na-make-array) (cons "into-array" na-into-array) (cons "to-array" na-to-array) (cons "aclone" na-aclone) (cons "aset-int" na-aset-int) (cons "aset-long" na-aset-long) (cons "aset-short" na-aset-short) (cons "aset-double" na-aset-double) diff --git a/host/chez/rt.ss b/host/chez/rt.ss index ee405b4..3573476 100644 --- a/host/chez/rt.ss +++ b/host/chez/rt.ss @@ -129,8 +129,9 @@ (load "host/chez/predicates.ss") ;; --- jolt number printing ---------------------------------------------------- -;; jolt models every number as a Clojure double: integer-valued values print -;; without a ".0" ((* 1.0 5) prints as "5", (/ 1 2) as "0.5"). +;; jolt has a numeric tower (exact integer / ratio / double, distinguished by +;; class). Exact integer-valued values print without a ".0" ((+ 1 2) -> "3"); +;; a double prints with one ((* 1.0 5) -> "5.0", as the JVM does). (define (jolt-num->string x) (cond ;; the -e / element printer renders the infinities and NaN in READABLE form @@ -139,7 +140,7 @@ ((and (flonum? x) (fl= x +inf.0)) "##Inf") ((and (flonum? x) (fl= x -inf.0)) "##-Inf") ((and (flonum? x) (not (fl= x x))) "##NaN") - ((and (rational? x) (integer? x)) (number->string (exact x))) + ((and (exact? x) (integer? x)) (number->string x)) (else (number->string x)))) ;; Program-final-value printer. jolt's `-e` prints in str-style: strings raw (no diff --git a/host/chez/run-corpus.ss b/host/chez/run-corpus.ss index 5511140..4ba39e1 100644 --- a/host/chez/run-corpus.ss +++ b/host/chez/run-corpus.ss @@ -11,7 +11,7 @@ ;; reset between cases so there is no leakage — same isolation a fresh process gives. ;; ;; chez --script host/chez/run-corpus.ss -;; JOLT_CHEZ_ZJ_FLOOR=N override the regression floor (default 2705) +;; JOLT_CHEZ_ZJ_FLOOR=N override the regression floor (default 2718) ;; JOLT_CORPUS_LIMIT=N every-Nth stride (fast iteration; floor drops to 0) ;; JOLT_DUMP_CRASH_LABELS=1 list crash + allowlisted labels (import (chezscheme)) @@ -102,10 +102,6 @@ "reader conditional" "reader cond :jolt" "reader cond no match" "reader cond splice" "reader cond splice no match" "nil nested" "bool nested" "source order through syntax-quote" - "make-array" "into-array" "to-array" "aclone vec" - "boolean-array" "int-array" "long-array" "double-array" - "float-array" "short-array" "doubles" "floats" "reader over char[]" - "char-array of string" "cancel an in-flight future returns true" "future-cancelled? after cancel" "no param vector")) (define known-fail (make-hashtable string-hash string=?)) @@ -200,7 +196,7 @@ ;; Regression floor: fail on any NEW divergence or if pass drops below the floor. (define base-floor (let ((s (getenv "JOLT_CHEZ_ZJ_FLOOR"))) - (if s (string->number s) 2705))) + (if s (string->number s) 2718))) (define floor (if limit 0 base-floor)) (when (or (> (length diverged) 0) (< pass floor)) (printf "REGRESSION: pass ~a < floor ~a or ~a new divergence(s)\n" diff --git a/test/chez/corpus.edn b/test/chez/corpus.edn index 003f92c..59f878e 100644 --- a/test/chez/corpus.edn +++ b/test/chez/corpus.edn @@ -2416,10 +2416,10 @@ {:suite "untested / hash family" :label "hash-combine" :expected "true" :actual "(int? (hash-combine 1 2))"} {:suite "untested / hash family" :label "hash-ordered-coll" :expected "true" :actual "(int? (hash-ordered-coll [1 2]))"} {:suite "untested / hash family" :label "hash-unordered-coll" :expected "true" :actual "(int? (hash-unordered-coll #{1}))"} - {:suite "untested / array stubs (vectors + host buffers)" :label "make-array" :expected "(quote (nil nil nil))" :actual "(make-array 3)"} - {:suite "untested / array stubs (vectors + host buffers)" :label "into-array" :expected "(quote (1 2))" :actual "(into-array [1 2])"} - {:suite "untested / array stubs (vectors + host buffers)" :label "to-array" :expected "(quote (1 2))" :actual "(to-array [1 2])"} - {:suite "untested / array stubs (vectors + host buffers)" :label "aclone vec" :expected "(quote (1 2))" :actual "(aclone [1 2])"} + {:suite "untested / array stubs (vectors + host buffers)" :label "make-array" :expected "[nil nil nil]" :actual "(vec (make-array Object 3))"} + {:suite "untested / array stubs (vectors + host buffers)" :label "into-array" :expected "[1 2]" :actual "(vec (into-array [1 2]))"} + {:suite "untested / array stubs (vectors + host buffers)" :label "to-array" :expected "[1 2]" :actual "(vec (to-array [1 2]))"} + {:suite "untested / array stubs (vectors + host buffers)" :label "aclone vec" :expected "[1 2]" :actual "(vec (aclone (int-array [1 2])))"} {:suite "untested / array stubs (vectors + host buffers)" :label "aclone independent" :expected "[9 2]" :actual "(let [a (aclone (to-array [1 2]))] (aset a 0 9) (seq a))"} {:suite "untested / array stubs (vectors + host buffers)" :label "aset/aget" :expected "9" :actual "(let [a (to-array [1 2 3])] (aset a 0 9) (aget a 0))"} {:suite "untested / array stubs (vectors + host buffers)" :label "aset-int" :expected "7" :actual "(let [a (to-array [1 2])] (aset-int a 0 7) (aget a 0))"} @@ -2430,18 +2430,18 @@ {:suite "untested / array stubs (vectors + host buffers)" :label "aset-float" :expected "2.5" :actual "(let [a (to-array [0])] (aset-float a 0 2.5) (aget a 0))"} {:suite "untested / array stubs (vectors + host buffers)" :label "aset-long" :expected "3" :actual "(let [a (to-array [0])] (aset-long a 0 3) (aget a 0))"} {:suite "untested / array stubs (vectors + host buffers)" :label "aset-short" :expected "4" :actual "(let [a (to-array [0])] (aset-short a 0 4) (aget a 0))"} - {:suite "untested / array stubs (vectors + host buffers)" :label "boolean-array" :expected "(quote (false false))" :actual "(boolean-array 2)"} - {:suite "untested / array stubs (vectors + host buffers)" :label "int-array" :expected "(quote (1 2))" :actual "(int-array [1 2])"} - {:suite "untested / array stubs (vectors + host buffers)" :label "long-array" :expected "(quote (0 0))" :actual "(long-array 2)"} - {:suite "untested / array stubs (vectors + host buffers)" :label "double-array" :expected "(quote (0 0))" :actual "(double-array 2)"} - {:suite "untested / array stubs (vectors + host buffers)" :label "float-array" :expected "(quote (0 0))" :actual "(float-array 2)"} - {:suite "untested / array stubs (vectors + host buffers)" :label "short-array" :expected "(quote (0 0))" :actual "(short-array 2)"} + {:suite "untested / array stubs (vectors + host buffers)" :label "boolean-array" :expected "[false false]" :actual "(vec (boolean-array 2))"} + {:suite "untested / array stubs (vectors + host buffers)" :label "int-array" :expected "[1 2]" :actual "(vec (int-array [1 2]))"} + {:suite "untested / array stubs (vectors + host buffers)" :label "long-array" :expected "[0 0]" :actual "(vec (long-array 2))"} + {:suite "untested / array stubs (vectors + host buffers)" :label "double-array" :expected "[0.0 0.0]" :actual "(vec (double-array 2))"} + {:suite "untested / array stubs (vectors + host buffers)" :label "float-array" :expected "[0.0 0.0]" :actual "(vec (float-array 2))"} + {:suite "untested / array stubs (vectors + host buffers)" :label "short-array" :expected "[0 0]" :actual "(vec (short-array 2))"} {:suite "untested / array stubs (vectors + host buffers)" :label "char-array count" :expected "2" :actual "(count (char-array 2))"} {:suite "untested / array stubs (vectors + host buffers)" :label "byte-array bytes?" :expected "true" :actual "(bytes? (byte-array 2))"} {:suite "untested / array stubs (vectors + host buffers)" :label "bytes? not vec" :expected "false" :actual "(bytes? [1])"} {:suite "untested / typed coercion views" :label "booleans" :expected "(quote (true))" :actual "(booleans [true])"} - {:suite "untested / typed coercion views" :label "doubles" :expected "(quote (1))" :actual "(doubles [1.0])"} - {:suite "untested / typed coercion views" :label "floats" :expected "(quote (1))" :actual "(floats [1.0])"} + {:suite "untested / typed coercion views" :label "doubles" :expected "[1.0]" :actual "(vec (doubles (double-array [1.0])))"} + {:suite "untested / typed coercion views" :label "floats" :expected "[1.0]" :actual "(vec (floats (float-array [1.0])))"} {:suite "untested / typed coercion views" :label "ints" :expected "(quote (1))" :actual "(ints [1])"} {:suite "untested / typed coercion views" :label "longs" :expected "(quote (1))" :actual "(longs [1])"} {:suite "untested / typed coercion views" :label "shorts" :expected "(quote (1))" :actual "(shorts [1])"} diff --git a/test/chez/unit.edn b/test/chez/unit.edn index 93f5718..326920e 100644 --- a/test/chez/unit.edn +++ b/test/chez/unit.edn @@ -129,7 +129,7 @@ {:suite "io" :expr "(do (spit \"/tmp/jolt-io-test.txt\" \"a\") (spit \"/tmp/jolt-io-test.txt\" \"b\" :append true) (slurp \"/tmp/jolt-io-test.txt\"))" :expected "ab"} {:suite "io" :expr "(flush)" :expected ""} {:suite "io" :expr "(do (require (quote [clojure.java.io :as io])) (string? (slurp (io/file \"README.md\"))))" :expected "true"} - {:suite "ioreader" :expr "(str (char-array \"abc\"))" :expected "(\\a \\b \\c)"} + {:suite "ioreader" :expr "(apply str (char-array \"abc\"))" :expected "abc"} {:suite "ioreader" :expr "(.read (StringReader. (apply str (char-array \"Qz\"))))" :expected "81"} {:suite "ioreader" :expr "(do (require (quote [clojure.java.io :as io])) (.read (io/reader (char-array \"abc\"))))" :expected "97"} {:suite "ioreader" :expr "(do (require (quote [clojure.java.io :as io])) (.read (io/reader (StringReader. \"k\"))))" :expected "107"} @@ -146,7 +146,7 @@ {:suite "ioreader" :expr "(let [log (atom [])] (try (with-open [c {:close (fn [] (swap! log conj :closed))}] (throw (ex-info \"boom\" {}))) (catch Exception e nil)) (deref log))" :expected "[:closed]"} {:suite "ioreader" :expr "(let [log (atom [])] (with-open [a {:close (fn [] (swap! log conj :outer))} b {:close (fn [] (swap! log conj :inner))}] :r) (deref log))" :expected "[:inner :outer]"} {:suite "ioreader" :expr "(with-open [c {:close (fn [] nil) :v 5}] (:v c))" :expected "5"} - {:suite "javastatic" :expr "(Math/sqrt 16)" :expected "4"} + {:suite "javastatic" :expr "(Math/sqrt 16)" :expected "4.0"} {:suite "javastatic" :expr "(Math/abs -3)" :expected "3"} {:suite "javastatic" :expr "(Math/max 2 7)" :expected "7"} {:suite "javastatic" :expr "(pos? Long/MAX_VALUE)" :expected "true"} @@ -289,8 +289,8 @@ {:suite "stdlib" :expr "(long (clojure.math/pow 2 10))" :expected "1024"} {:suite "stdlib" :expr "(long (clojure.math/tan 0))" :expected "0"} {:suite "stdlib" :expr "(clojure.math/round 2.6)" :expected "3"} - {:suite "stdlib" :expr "(clojure.math/floor 2.9)" :expected "2"} - {:suite "stdlib" :expr "(clojure.math/signum -7.2)" :expected "-1"} + {:suite "stdlib" :expr "(clojure.math/floor 2.9)" :expected "2.0"} + {:suite "stdlib" :expr "(clojure.math/signum -7.2)" :expected "-1.0"} {:suite "stdlib" :expr "(< 3.14 (clojure.math/to-radians 180) 3.15)" :expected "true"} {:suite "stdlib" :expr "(< 3.14 clojure.math/PI 3.15)" :expected "true"} {:suite "stdlib" :expr "(< 2.71 clojure.math/E 2.72)" :expected "true"} diff --git a/test/conformance/known-divergences.edn b/test/conformance/known-divergences.edn index c7fcaf4..b12a903 100644 --- a/test/conformance/known-divergences.edn +++ b/test/conformance/known-divergences.edn @@ -2,11 +2,11 @@ "Rows of test/chez/corpus.edn whose :expected differs from reference JVM Clojure. The corpus is JVM-sourced (regen-corpus.clj), so this list is only the rows whose JVM value is an opaque host object that cannot round-trip to readable source — Java arrays, transients, atoms, beans, proxies, and chunks print as #object[..@addr] with a per-run identity — plus the (fn* foo) strictness case and a few racy concurrency cases (:flaky). For those the corpus keeps jolt's value. certify.clj gates on NEW (unlisted) divergences and STALE entries. Keyed by [suite label].", :legend {:numeric-model - "jolt is all-double: no Ratio/BigDecimal/float; (/ 1 2)=>0.5, 3.0 prints 3", + "jolt has a numeric tower (exact integer / Ratio / double); no BigDecimal", :concurrency-model "Janet isolated-heap snapshot futures/agents/pmap; atoms snapshot, not shared", :host-model - "no JVM host: classes->name strings, no Java arrays, type->symbol, *in* is a map, inline-impl extenders, duck-typed with-open close", + "no JVM host: classes->name strings, type->symbol, *in* is a map, inline-impl extenders, duck-typed with-open close", :reader-model "jolt reader features (:jolt) + syntax-quote literal collapse (spec 2.4 S25); map source-order preserved", :printer-model @@ -49,30 +49,6 @@ {:suite "untested / JVM-shape stubs (documented jolt behavior)", :label "proxy resolves nil", :category :host-model} - {:suite "untested / array stubs (vectors + host buffers)", - :label "boolean-array", - :category :host-model} - {:suite "untested / array stubs (vectors + host buffers)", - :label "double-array", - :category :host-model} - {:suite "untested / array stubs (vectors + host buffers)", - :label "float-array", - :category :host-model} - {:suite "untested / array stubs (vectors + host buffers)", - :label "int-array", - :category :host-model} - {:suite "untested / array stubs (vectors + host buffers)", - :label "into-array", - :category :host-model} - {:suite "untested / array stubs (vectors + host buffers)", - :label "long-array", - :category :host-model} - {:suite "untested / array stubs (vectors + host buffers)", - :label "short-array", - :category :host-model} - {:suite "untested / array stubs (vectors + host buffers)", - :label "to-array", - :category :host-model} {:suite "untested / chunk family (eager equivalents) + cat", :label "chunk round-trip", :category :host-model}]}