diff --git a/host/chez/host-static.ss b/host/chez/host-static.ss index 46571b9..23d571c 100644 --- a/host/chez/host-static.ss +++ b/host/chez/host-static.ss @@ -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))))) diff --git a/host/chez/predicates.ss b/host/chez/predicates.ss index 5fe7767..2eb4823 100644 --- a/host/chez/predicates.ss +++ b/host/chez/predicates.ss @@ -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?) diff --git a/host/chez/run-corpus.ss b/host/chez/run-corpus.ss index d408481..2242524 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 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" diff --git a/host/chez/seed/prelude.ss b/host/chez/seed/prelude.ss index 8926b9c..ca5c88c 100644 --- a/host/chez/seed/prelude.ss +++ b/host/chez/seed/prelude.ss @@ -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" diff --git a/jolt-core/clojure/core/00-kernel.clj b/jolt-core/clojure/core/00-kernel.clj index c390de5..1e6d326 100644 --- a/jolt-core/clojure/core/00-kernel.clj +++ b/jolt-core/clojure/core/00-kernel.clj @@ -27,12 +27,12 @@ ([v start end] (when (not (vector? v)) (throw (str "subvec requires a vector"))) ;; 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] (cond (not (number? x)) (throw (str "subvec index must be a number")) (not= x x) 0 - :else (quot x 1))) + :else (long x))) s (coerce start) e (coerce end)] (when (or (< s 0) (< e s) (< (count v) e)) diff --git a/jolt-core/clojure/core/30-macros.clj b/jolt-core/clojure/core/30-macros.clj index a0af4e2..14036c3 100644 --- a/jolt-core/clojure/core/30-macros.clj +++ b/jolt-core/clojure/core/30-macros.clj @@ -122,8 +122,11 @@ `(bound-fn* (fn ~@fntail))) (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))] - (if (and v# (some? (var-get v#))) + (if (and v# (bound? v#)) v# (def ~name ~expr)))) diff --git a/test/chez/corpus.edn b/test/chez/corpus.edn index e3f59e4..003f92c 100644 --- a/test/chez/corpus.edn +++ b/test/chez/corpus.edn @@ -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 "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 "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 "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\")))"}