Typed-array identity + JVM flonum printing (Inc 3)
This commit is contained in:
Yogthos
parent
f2747679e9
commit
9e0a930eb4
7 changed files with 85 additions and 57 deletions
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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])"}
|
||||
|
|
|
|||
|
|
@ -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"}
|
||||
|
|
|
|||
|
|
@ -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}]}
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue