From bb6c9eeb295daeabf1545c1fc4450e4a1e80526b Mon Sep 17 00:00:00 2001 From: Yogthos Date: Sun, 21 Jun 2026 19:12:40 -0400 Subject: [PATCH] Class refinements: per-type class names, FQN tokens, instance? built-ins - (class x) returns per-type JVM class names (Long/Double/Ratio/Character/Atom), not a blanket java.lang.Number. - register fully-qualified class tokens (java.lang.Long, clojure.lang.Keyword, clojure.lang.Atom, ...) that self-evaluate to their name, so (= (class 1) java.lang.Long) and (instance? clojure.lang.Atom x) resolve. - instance? recognizes Long/Double/Ratio/Character/Symbol/Atom/IFn built-ins. Closes class number/string/keyword/name, instance? Atom, atom?. Corpus 2699->2705. --- host/chez/host-class.ss | 21 +++++++++++++++++++++ host/chez/records.ss | 12 ++++++++++-- host/chez/run-corpus.ss | 4 ++-- test/chez/unit.edn | 6 +++--- 4 files changed, 36 insertions(+), 7 deletions(-) diff --git a/host/chez/host-class.ss b/host/chez/host-class.ss index 6d0002a..905d07d 100644 --- a/host/chez/host-class.ss +++ b/host/chez/host-class.ss @@ -17,10 +17,17 @@ (cond ((jolt-nil? x) jolt-nil) ((boolean? x) "java.lang.Boolean") + ;; per-type number classes, like the JVM: integer -> Long, flonum -> Double, + ;; exact non-integer -> Ratio. + ((and (number? x) (flonum? x)) "java.lang.Double") + ((and (number? x) (exact? x) (integer? x)) "java.lang.Long") + ((and (number? x) (exact? x) (rational? x)) "clojure.lang.Ratio") ((number? x) "java.lang.Number") ((string? x) "java.lang.String") ((keyword? x) "clojure.lang.Keyword") ((symbol-t? x) "clojure.lang.Symbol") + ((jolt-atom? x) "clojure.lang.Atom") + ((char? x) "java.lang.Character") ((procedure? x) "clojure.lang.IFn") (else (jolt-str-render-one (jolt-type x))))) @@ -44,3 +51,17 @@ ("IllegalArgumentException" . "java.lang.IllegalArgumentException") ("InterruptedException" . "java.lang.InterruptedException") ("Throwable" . "java.lang.Throwable"))) + +;; fully-qualified canonical class names self-evaluate to their own name string, +;; so (= (class 1) java.lang.Long) and (instance? clojure.lang.Atom x) resolve the +;; class token (= what jolt-class / instance-check key on). +(for-each + (lambda (nm) (def-var! "clojure.core" nm nm)) + '("java.lang.Long" "java.lang.Integer" "java.lang.Double" "java.lang.Float" + "java.lang.Number" "java.lang.String" "java.lang.Boolean" "java.lang.Character" + "java.lang.Object" "java.lang.CharSequence" "java.lang.Comparable" + "clojure.lang.Keyword" "clojure.lang.Symbol" "clojure.lang.Ratio" "clojure.lang.BigInt" + "clojure.lang.Atom" "clojure.lang.IFn" "clojure.lang.Fn" "clojure.lang.ISeq" + "clojure.lang.IPersistentMap" "clojure.lang.IPersistentVector" "clojure.lang.IPersistentCollection" + "clojure.lang.PersistentVector" "clojure.lang.Var" "clojure.lang.Namespace" + "clojure.lang.MapEntry")) diff --git a/host/chez/records.ss b/host/chez/records.ss index 93f527e..5001755 100644 --- a/host/chez/records.ss +++ b/host/chez/records.ss @@ -270,10 +270,18 @@ (else (case-string tname val))))) (define (case-string tname val) (cond - ((member tname '("Number" "java.lang.Number" "Long" "java.lang.Long" "Integer" "Double")) (number? val)) + ((member tname '("Number" "java.lang.Number")) (number? val)) + ((member tname '("Long" "java.lang.Long" "Integer" "java.lang.Integer")) + (and (number? val) (exact? val) (integer? val))) + ((member tname '("Double" "java.lang.Double" "Float" "java.lang.Float")) (and (number? val) (flonum? val))) + ((member tname '("Ratio" "clojure.lang.Ratio")) (and (number? val) (exact? val) (rational? val) (not (integer? val)))) ((member tname '("String" "java.lang.String" "CharSequence" "java.lang.CharSequence")) (string? val)) ((member tname '("Boolean" "java.lang.Boolean")) (boolean? val)) - ((member tname '("Keyword")) (keyword? val)) + ((member tname '("Character" "java.lang.Character")) (char? val)) + ((member tname '("Keyword" "clojure.lang.Keyword")) (keyword? val)) + ((member tname '("Symbol" "clojure.lang.Symbol")) (jolt-symbol? val)) + ((member tname '("Atom" "clojure.lang.Atom")) (jolt-atom? val)) + ((member tname '("IFn" "clojure.lang.IFn" "Fn" "clojure.lang.Fn")) (procedure? val)) (else #f))) ;; str of a record uses a custom (Object toString) impl if the type defines one diff --git a/host/chez/run-corpus.ss b/host/chez/run-corpus.ss index 471dcf3..019ccfd 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 2698) +;; JOLT_CHEZ_ZJ_FLOOR=N override the regression floor (default 2705) ;; JOLT_CORPUS_LIMIT=N every-Nth stride (fast iteration; floor drops to 0) ;; JOLT_DUMP_CRASH_LABELS=1 list crash + allowlisted labels (import (chezscheme)) @@ -203,7 +203,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) 2698))) + (if s (string->number s) 2705))) (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/unit.edn b/test/chez/unit.edn index 6c8f03b..93f5718 100644 --- a/test/chez/unit.edn +++ b/test/chez/unit.edn @@ -15,15 +15,15 @@ {:suite "class" :expr "File" :expected "java.io.File"} {:suite "class" :expr "Exception" :expected "java.lang.Exception"} {:suite "class" :expr "MapEntry" :expected "clojure.lang.MapEntry"} - {:suite "class" :expr "(class 1)" :expected "java.lang.Number"} - {:suite "class" :expr "(class 1.5)" :expected "java.lang.Number"} + {:suite "class" :expr "(class 1)" :expected "java.lang.Long"} + {:suite "class" :expr "(class 1.5)" :expected "java.lang.Double"} {:suite "class" :expr "(class \"s\")" :expected "java.lang.String"} {:suite "class" :expr "(class :k)" :expected "clojure.lang.Keyword"} {:suite "class" :expr "(class true)" :expected "java.lang.Boolean"} {:suite "class" :expr "(class false)" :expected "java.lang.Boolean"} {:suite "class" :expr "(class nil)" :expected ""} {:suite "class" :expr "(= String (class \"abc\"))" :expected "true"} - {:suite "class" :expr "(= Number (class 7))" :expected "true"} + {:suite "class" :expr "(= Number (class 7))" :expected "false"} {:suite "class" :expr "(= String (class 7))" :expected "false"} {:suite "class" :expr "(do (defmulti cm (fn [x] (class x))) (defmethod cm String [x] :str) (cm \"a\"))" :expected ":str"} {:suite "class" :expr "(do (defmulti cn (fn [x] (class x))) (defmethod cn nil [x] :nil) (defmethod cn String [x] :str) (cn nil))" :expected ":nil"}