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:
Yogthos
parent
dd0e0b55cc
commit
cf0b544baf
7 changed files with 23 additions and 13 deletions
|
|
@ -167,6 +167,9 @@
|
|||
(define (now-millis)
|
||||
(let ((t (current-time 'time-utc)))
|
||||
(+ (* 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"
|
||||
(list (cons "currentTimeMillis" (lambda () (->num (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
|
||||
;; otherwise). Uses Scheme = (value across the tower), not jolt= (category-aware).
|
||||
(define (jolt-num-equiv . xs)
|
||||
(let all-num? ((ys xs))
|
||||
(cond
|
||||
((null? ys) (or (null? xs) (null? (cdr xs)) (apply = xs)))
|
||||
((number? (car ys)) (all-num? (cdr ys)))
|
||||
(else (error #f "== requires numbers" xs)))))
|
||||
;; 1-arity short-circuits to true for ANY value (Clojure's == 1-arg returns true
|
||||
;; before the number check); 2+ args must all be numbers.
|
||||
(if (and (pair? xs) (null? (cdr xs)))
|
||||
#t
|
||||
(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" "symbol?" jolt-symbol?)
|
||||
(def-var! "clojure.core" "keyword?" keyword?)
|
||||
|
|
|
|||
|
|
@ -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 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_DUMP_CRASH_LABELS=1 list crash + allowlisted labels
|
||||
(import (chezscheme))
|
||||
|
|
@ -106,6 +106,7 @@
|
|||
"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"
|
||||
"atom?" "instance? Atom"
|
||||
"cancel an in-flight future returns true" "future-cancelled? after cancel"
|
||||
"no param vector"))
|
||||
|
|
@ -201,7 +202,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) 2678)))
|
||||
(if s (string->number s) 2683)))
|
||||
(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"
|
||||
|
|
|
|||
|
|
@ -107,7 +107,7 @@
|
|||
(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)))
|
||||
(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))
|
||||
(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))
|
||||
|
|
@ -794,7 +794,7 @@
|
|||
(mark-macro! "clojure.core" "bound-fn"))
|
||||
(guard (e (#t #f))
|
||||
(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"))
|
||||
(guard (e (#t #f))
|
||||
(def-var! "clojure.core" "if-not"
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue