Host interop fixes: ==/time/subvec/defonce + corpus cleanup
- == 1-arg returns true for any value (Clojure short-circuits before the number check), not 'requires numbers'. - current-time-ms wired to now-millis so the time macro works. - subvec truncates float/ratio indices via long (Scheme quotient rejects flonums). - defonce checks bound? not var-get — in a top-level do the name is already an unbound interned cell, which var-get throws on. - drop the line-seq corpus row (used janet/spit, N/A); allowlist char-array (needs Class/forName "[C"). Corpus 2678->2683, floor raised. Re-minted. Full gate green; CI green. jolt-cf1q.7
This commit is contained in:
parent
dd0e0b55cc
commit
cf0b544baf
7 changed files with 23 additions and 13 deletions
|
|
@ -167,6 +167,9 @@
|
||||||
(define (now-millis)
|
(define (now-millis)
|
||||||
(let ((t (current-time 'time-utc)))
|
(let ((t (current-time 'time-utc)))
|
||||||
(+ (* 1000 (time-second t)) (quotient (time-nanosecond t) 1000000))))
|
(+ (* 1000 (time-second t)) (quotient (time-nanosecond t) 1000000))))
|
||||||
|
|
||||||
|
;; clojure.core/current-time-ms — epoch milliseconds; backs the `time` macro.
|
||||||
|
(def-var! "clojure.core" "current-time-ms" (lambda () (->num (now-millis))))
|
||||||
(register-class-statics! "System"
|
(register-class-statics! "System"
|
||||||
(list (cons "currentTimeMillis" (lambda () (->num (now-millis))))
|
(list (cons "currentTimeMillis" (lambda () (->num (now-millis))))
|
||||||
(cons "nanoTime" (lambda () (->num (* 1000000 (now-millis)))))
|
(cons "nanoTime" (lambda () (->num (* 1000000 (now-millis)))))
|
||||||
|
|
|
||||||
|
|
@ -66,11 +66,15 @@
|
||||||
;; 1-arity is trivially true; 2+ args must all be numbers (Numbers.equiv throws
|
;; 1-arity is trivially true; 2+ args must all be numbers (Numbers.equiv throws
|
||||||
;; otherwise). Uses Scheme = (value across the tower), not jolt= (category-aware).
|
;; otherwise). Uses Scheme = (value across the tower), not jolt= (category-aware).
|
||||||
(define (jolt-num-equiv . xs)
|
(define (jolt-num-equiv . xs)
|
||||||
(let all-num? ((ys xs))
|
;; 1-arity short-circuits to true for ANY value (Clojure's == 1-arg returns true
|
||||||
(cond
|
;; before the number check); 2+ args must all be numbers.
|
||||||
((null? ys) (or (null? xs) (null? (cdr xs)) (apply = xs)))
|
(if (and (pair? xs) (null? (cdr xs)))
|
||||||
((number? (car ys)) (all-num? (cdr ys)))
|
#t
|
||||||
(else (error #f "== requires numbers" xs)))))
|
(let all-num? ((ys xs))
|
||||||
|
(cond
|
||||||
|
((null? ys) (or (null? xs) (apply = xs)))
|
||||||
|
((number? (car ys)) (all-num? (cdr ys)))
|
||||||
|
(else (error #f "== requires numbers" xs))))))
|
||||||
(def-var! "clojure.core" "==" jolt-num-equiv)
|
(def-var! "clojure.core" "==" jolt-num-equiv)
|
||||||
(def-var! "clojure.core" "symbol?" jolt-symbol?)
|
(def-var! "clojure.core" "symbol?" jolt-symbol?)
|
||||||
(def-var! "clojure.core" "keyword?" keyword?)
|
(def-var! "clojure.core" "keyword?" keyword?)
|
||||||
|
|
|
||||||
|
|
@ -11,7 +11,7 @@
|
||||||
;; reset between cases so there is no leakage — same isolation a fresh process gives.
|
;; reset between cases so there is no leakage — same isolation a fresh process gives.
|
||||||
;;
|
;;
|
||||||
;; chez --script host/chez/run-corpus.ss
|
;; chez --script host/chez/run-corpus.ss
|
||||||
;; JOLT_CHEZ_ZJ_FLOOR=N override the regression floor (default 2678)
|
;; JOLT_CHEZ_ZJ_FLOOR=N override the regression floor (default 2683)
|
||||||
;; JOLT_CORPUS_LIMIT=N every-Nth stride (fast iteration; floor drops to 0)
|
;; JOLT_CORPUS_LIMIT=N every-Nth stride (fast iteration; floor drops to 0)
|
||||||
;; JOLT_DUMP_CRASH_LABELS=1 list crash + allowlisted labels
|
;; JOLT_DUMP_CRASH_LABELS=1 list crash + allowlisted labels
|
||||||
(import (chezscheme))
|
(import (chezscheme))
|
||||||
|
|
@ -106,6 +106,7 @@
|
||||||
"make-array" "into-array" "to-array" "aclone vec"
|
"make-array" "into-array" "to-array" "aclone vec"
|
||||||
"boolean-array" "int-array" "long-array" "double-array"
|
"boolean-array" "int-array" "long-array" "double-array"
|
||||||
"float-array" "short-array" "doubles" "floats" "reader over char[]"
|
"float-array" "short-array" "doubles" "floats" "reader over char[]"
|
||||||
|
"char-array of string"
|
||||||
"atom?" "instance? Atom"
|
"atom?" "instance? Atom"
|
||||||
"cancel an in-flight future returns true" "future-cancelled? after cancel"
|
"cancel an in-flight future returns true" "future-cancelled? after cancel"
|
||||||
"no param vector"))
|
"no param vector"))
|
||||||
|
|
@ -201,7 +202,7 @@
|
||||||
|
|
||||||
;; Regression floor: fail on any NEW divergence or if pass drops below the floor.
|
;; Regression floor: fail on any NEW divergence or if pass drops below the floor.
|
||||||
(define base-floor (let ((s (getenv "JOLT_CHEZ_ZJ_FLOOR")))
|
(define base-floor (let ((s (getenv "JOLT_CHEZ_ZJ_FLOOR")))
|
||||||
(if s (string->number s) 2678)))
|
(if s (string->number s) 2683)))
|
||||||
(define floor (if limit 0 base-floor))
|
(define floor (if limit 0 base-floor))
|
||||||
(when (or (> (length diverged) 0) (< pass floor))
|
(when (or (> (length diverged) 0) (< pass floor))
|
||||||
(printf "REGRESSION: pass ~a < floor ~a or ~a new divergence(s)\n"
|
(printf "REGRESSION: pass ~a < floor ~a or ~a new divergence(s)\n"
|
||||||
|
|
|
||||||
|
|
@ -107,7 +107,7 @@
|
||||||
(guard (e (#t #f))
|
(guard (e (#t #f))
|
||||||
(def-var! "clojure.core" "peek" (letrec ((peek (lambda (coll) (let fnrec1039 ((coll coll)) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "nil?") coll)) jolt-nil (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "vector?") coll)) (if (jolt-zero? (jolt-count coll)) jolt-nil (jolt-nth coll (jolt-dec (jolt-count coll)))) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "seq?") coll)) (jolt-first coll) (if (jolt-truthy? (keyword #f "else")) (jolt-throw (jolt-invoke (var-deref "clojure.core" "str") "peek not supported on: " coll)) jolt-nil)))))))) peek)))
|
(def-var! "clojure.core" "peek" (letrec ((peek (lambda (coll) (let fnrec1039 ((coll coll)) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "nil?") coll)) jolt-nil (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "vector?") coll)) (if (jolt-zero? (jolt-count coll)) jolt-nil (jolt-nth coll (jolt-dec (jolt-count coll)))) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "seq?") coll)) (jolt-first coll) (if (jolt-truthy? (keyword #f "else")) (jolt-throw (jolt-invoke (var-deref "clojure.core" "str") "peek not supported on: " coll)) jolt-nil)))))))) peek)))
|
||||||
(guard (e (#t #f))
|
(guard (e (#t #f))
|
||||||
(def-var! "clojure.core" "subvec" (letrec ((subvec (case-lambda ((v start) (let fnrec1040 ((v v) (start start)) (jolt-invoke subvec v start (jolt-count v)))) ((v start end) (let fnrec1041 ((v v) (start start) (end end)) (begin (if (jolt-not (jolt-invoke (var-deref "clojure.core" "vector?") v)) (jolt-throw (jolt-invoke (var-deref "clojure.core" "str") "subvec requires a vector")) jolt-nil) (let* ((coerce (lambda (x) (let fnrec1043 ((x x)) (if (jolt-not (jolt-invoke (var-deref "clojure.core" "number?") x)) (jolt-throw (jolt-invoke (var-deref "clojure.core" "str") "subvec index must be a number")) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "not=") x x)) 0 (if (jolt-truthy? (keyword #f "else")) (quotient x 1) jolt-nil)))))) (s (jolt-invoke coerce start)) (e (jolt-invoke coerce end))) (begin (if (jolt-truthy? (let* ((or__14__auto (< s 0))) (if (jolt-truthy? or__14__auto) or__14__auto (let* ((or__14__auto (< e s))) (if (jolt-truthy? or__14__auto) or__14__auto (< (jolt-count v) e)))))) (jolt-throw (jolt-invoke (var-deref "clojure.core" "str") "subvec index out of range: " s " " e)) jolt-nil) (let* ((i s) (acc (jolt-vector))) (let loop1042 ((i i) (acc acc)) (if (< i e) (loop1042 (jolt-inc i) (jolt-conj acc (jolt-nth v i))) acc))))))))))) subvec)))
|
(def-var! "clojure.core" "subvec" (letrec ((subvec (case-lambda ((v start) (let fnrec1040 ((v v) (start start)) (jolt-invoke subvec v start (jolt-count v)))) ((v start end) (let fnrec1041 ((v v) (start start) (end end)) (begin (if (jolt-not (jolt-invoke (var-deref "clojure.core" "vector?") v)) (jolt-throw (jolt-invoke (var-deref "clojure.core" "str") "subvec requires a vector")) jolt-nil) (let* ((coerce (lambda (x) (let fnrec1043 ((x x)) (if (jolt-not (jolt-invoke (var-deref "clojure.core" "number?") x)) (jolt-throw (jolt-invoke (var-deref "clojure.core" "str") "subvec index must be a number")) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "not=") x x)) 0 (if (jolt-truthy? (keyword #f "else")) (jolt-invoke (var-deref "clojure.core" "long") x) jolt-nil)))))) (s (jolt-invoke coerce start)) (e (jolt-invoke coerce end))) (begin (if (jolt-truthy? (let* ((or__14__auto (< s 0))) (if (jolt-truthy? or__14__auto) or__14__auto (let* ((or__14__auto (< e s))) (if (jolt-truthy? or__14__auto) or__14__auto (< (jolt-count v) e)))))) (jolt-throw (jolt-invoke (var-deref "clojure.core" "str") "subvec index out of range: " s " " e)) jolt-nil) (let* ((i s) (acc (jolt-vector))) (let loop1042 ((i i) (acc acc)) (if (< i e) (loop1042 (jolt-inc i) (jolt-conj acc (jolt-nth v i))) acc))))))))))) subvec)))
|
||||||
(guard (e (#t #f))
|
(guard (e (#t #f))
|
||||||
(def-var! "clojure.core" "mapv" (letrec ((mapv (lambda (f . colls) (let fnrec1044 ((f f) (colls (list->cseq colls))) (jolt-invoke (var-deref "clojure.core" "vec") (jolt-apply jolt-map f colls)))))) mapv)))
|
(def-var! "clojure.core" "mapv" (letrec ((mapv (lambda (f . colls) (let fnrec1044 ((f f) (colls (list->cseq colls))) (jolt-invoke (var-deref "clojure.core" "vec") (jolt-apply jolt-map f colls)))))) mapv)))
|
||||||
(guard (e (#t #f))
|
(guard (e (#t #f))
|
||||||
|
|
@ -794,7 +794,7 @@
|
||||||
(mark-macro! "clojure.core" "bound-fn"))
|
(mark-macro! "clojure.core" "bound-fn"))
|
||||||
(guard (e (#t #f))
|
(guard (e (#t #f))
|
||||||
(def-var! "clojure.core" "defonce"
|
(def-var! "clojure.core" "defonce"
|
||||||
(lambda (name expr) (let fnrec423 ((name name) (expr expr)) (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "let")) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqvec") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol #f "v__3__auto")) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "resolve")) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol #f "quote")) (jolt-invoke (var-deref "clojure.core" "__sq1") name))))))) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol #f "if")) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "and")) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol #f "v__3__auto")) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "some?")) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "var-get")) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol #f "v__3__auto")))))))) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol #f "v__3__auto")) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol #f "def")) (jolt-invoke (var-deref "clojure.core" "__sq1") name) (jolt-invoke (var-deref "clojure.core" "__sq1") expr)))))))))
|
(lambda (name expr) (let fnrec423 ((name name) (expr expr)) (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "let")) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqvec") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol #f "v__3__auto")) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "resolve")) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol #f "quote")) (jolt-invoke (var-deref "clojure.core" "__sq1") name))))))) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol #f "if")) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "and")) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol #f "v__3__auto")) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "bound?")) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol #f "v__3__auto")))))) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol #f "v__3__auto")) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol #f "def")) (jolt-invoke (var-deref "clojure.core" "__sq1") name) (jolt-invoke (var-deref "clojure.core" "__sq1") expr)))))))))
|
||||||
(mark-macro! "clojure.core" "defonce"))
|
(mark-macro! "clojure.core" "defonce"))
|
||||||
(guard (e (#t #f))
|
(guard (e (#t #f))
|
||||||
(def-var! "clojure.core" "if-not"
|
(def-var! "clojure.core" "if-not"
|
||||||
|
|
|
||||||
|
|
@ -27,12 +27,12 @@
|
||||||
([v start end]
|
([v start end]
|
||||||
(when (not (vector? v)) (throw (str "subvec requires a vector")))
|
(when (not (vector? v)) (throw (str "subvec requires a vector")))
|
||||||
;; Clojure coerces indices with (int ...): NaN -> 0, floats/ratios truncate
|
;; Clojure coerces indices with (int ...): NaN -> 0, floats/ratios truncate
|
||||||
;; toward zero ((quot x 1)); non-numbers throw. Only then range-check.
|
;; toward zero; non-numbers throw. Only then range-check.
|
||||||
(let [coerce (fn [x]
|
(let [coerce (fn [x]
|
||||||
(cond
|
(cond
|
||||||
(not (number? x)) (throw (str "subvec index must be a number"))
|
(not (number? x)) (throw (str "subvec index must be a number"))
|
||||||
(not= x x) 0
|
(not= x x) 0
|
||||||
:else (quot x 1)))
|
:else (long x)))
|
||||||
s (coerce start)
|
s (coerce start)
|
||||||
e (coerce end)]
|
e (coerce end)]
|
||||||
(when (or (< s 0) (< e s) (< (count v) e))
|
(when (or (< s 0) (< e s) (< (count v) e))
|
||||||
|
|
|
||||||
|
|
@ -122,8 +122,11 @@
|
||||||
`(bound-fn* (fn ~@fntail)))
|
`(bound-fn* (fn ~@fntail)))
|
||||||
|
|
||||||
(defmacro defonce [name expr]
|
(defmacro defonce [name expr]
|
||||||
|
;; only def when the var has no root value. In a top-level (do ...) the name is
|
||||||
|
;; already interned (an unbound cell) by the time this runs, so check bound? —
|
||||||
|
;; var-get would throw on the unbound cell.
|
||||||
`(let [v# (resolve (quote ~name))]
|
`(let [v# (resolve (quote ~name))]
|
||||||
(if (and v# (some? (var-get v#)))
|
(if (and v# (bound? v#))
|
||||||
v#
|
v#
|
||||||
(def ~name ~expr))))
|
(def ~name ~expr))))
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -511,7 +511,6 @@
|
||||||
{:suite "interop / StringReader & StringBuilder" :label "setLength truncates" :expected "\"ab\"" :actual "(let [sb (StringBuilder.)] (.append sb \"abcd\") (.setLength sb 2) (.toString sb))"}
|
{:suite "interop / StringReader & StringBuilder" :label "setLength truncates" :expected "\"ab\"" :actual "(let [sb (StringBuilder.)] (.append sb \"abcd\") (.setLength sb 2) (.toString sb))"}
|
||||||
{:suite "interop / StringReader & StringBuilder" :label "char-array of string" :expected "true" :actual "(instance? (Class/forName \"[C\") (char-array \"ab\"))"}
|
{:suite "interop / StringReader & StringBuilder" :label "char-array of string" :expected "true" :actual "(instance? (Class/forName \"[C\") (char-array \"ab\"))"}
|
||||||
{:suite "interop / StringReader & StringBuilder" :label "reader over char[]" :expected "97" :actual "(do (require (quote clojure.java.io)) (.read (clojure.java.io/reader (char-array \"abc\"))))"}
|
{:suite "interop / StringReader & StringBuilder" :label "reader over char[]" :expected "97" :actual "(do (require (quote clojure.java.io)) (.read (clojure.java.io/reader (char-array \"abc\"))))"}
|
||||||
{:suite "interop / StringReader & StringBuilder" :label "line-seq over file reader" :expected "[\"a\" \"b\"]" :actual "(do (require (quote clojure.java.io)) (janet/spit \"/tmp/jolt-lineseq-spec.txt\" \"a\\nb\\n\") (vec (line-seq (clojure.java.io/reader \"/tmp/jolt-lineseq-spec.txt\"))))"}
|
|
||||||
{:suite "interop / StringReader & StringBuilder" :label "with-open closes shim" :expected "97" :actual "(with-open [r (StringReader. \"a\")] (.read r))"}
|
{:suite "interop / StringReader & StringBuilder" :label "with-open closes shim" :expected "97" :actual "(with-open [r (StringReader. \"a\")] (.read r))"}
|
||||||
{:suite "interop / StringReader & StringBuilder" :label "File.toURL methods read it back" :expected "\"file:/tmp/x\"" :actual "(do (require (quote clojure.java.io)) (.toString (.toURL (clojure.java.io/file \"/tmp/x\"))))"}
|
{:suite "interop / StringReader & StringBuilder" :label "File.toURL methods read it back" :expected "\"file:/tmp/x\"" :actual "(do (require (quote clojure.java.io)) (.toString (.toURL (clojure.java.io/file \"/tmp/x\"))))"}
|
||||||
{:suite "interop / StringReader & StringBuilder" :label "vector :import shares deftype ctor" :expected "\"hi!\"" :actual "(do (ns spec.nodea) (defprotocol SpecP (spec-pm [this])) (deftype SpecTN [t] SpecP (spec-pm [this] (str t \"!\"))) (ns spec.nodeb (:import [spec.nodea SpecTN])) (.spec-pm (SpecTN. \"hi\")))"}
|
{:suite "interop / StringReader & StringBuilder" :label "vector :import shares deftype ctor" :expected "\"hi!\"" :actual "(do (ns spec.nodea) (defprotocol SpecP (spec-pm [this])) (deftype SpecTN [t] SpecP (spec-pm [this] (str t \"!\"))) (ns spec.nodeb (:import [spec.nodea SpecTN])) (.spec-pm (SpecTN. \"hi\")))"}
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue