From eb26ad04010956bec7d7788e50d7f700a7f393eb Mon Sep 17 00:00:00 2001 From: Yogthos Date: Thu, 18 Jun 2026 15:44:10 -0400 Subject: [PATCH] Chez Phase 2 (inc I+J): first-class vars + scalar natives MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit inc I (jolt-n7rz) — vars as first-class objects. (var x)/#'x lowered a :the-var IR op the Chez emitter didn't handle (57 emit-fails, the biggest bucket); emit it to the rt.ss var-cell and shim the static var ops in vars.ss: var?/var-get/deref/var-as-IFn/var =/pr-str (#'ns/name) + a native bound? (the overlay reads (get v :root), nil on a var-cell record). def now RETURNS the var (#'ns/name) like Clojure — def-var!/declare-var! yield the cell, not the value — so (var? (def x 1)) is true and pr-str-of-var/defn pass (un-allowlisted). Dynamic binding (binding/with-bindings*/var-set/ thread-bound?) stays a follow-up; those crash on nil host prims (safe). Var def-time metadata (^:private/^Type/doc) isn't captured yet — allowlisted. inc J (jolt-snry) — scalar natives. natives-misc.ss: a juuid record (random-uuid v4 / parse-uuid / uuid? / #uuid pr-str / str), a %-format engine (%d/%s/%.Nf/%x/%c/%%; printf rides on it), a jtagged record (tagged-literal + :tag/:form + #tag pr-str), bigint/biginteger as near-identity over the all-flonum model. Overlay names (uuid?/random-uuid/ parse-uuid/tagged-literal?) re-asserted in post-prelude.ss. Prelude parity 1898 -> 1951, 0 new divergences. Floor raised to 1951. --- host/chez/emit.janet | 3 + host/chez/natives-misc.ss | 144 +++++++++++++++++++++++++++++ host/chez/post-prelude.ss | 9 ++ host/chez/rt.ss | 25 ++++- host/chez/vars.ss | 57 ++++++++++++ test/chez/run-corpus-prelude.janet | 21 +++-- 6 files changed, 249 insertions(+), 10 deletions(-) create mode 100644 host/chez/natives-misc.ss create mode 100644 host/chez/vars.ss diff --git a/host/chez/emit.janet b/host/chez/emit.janet index ec912a0..faeaeb8 100644 --- a/host/chez/emit.janet +++ b/host/chez/emit.janet @@ -429,6 +429,9 @@ (string "(var-deref " (chez-str-lit (get node :ns)) " " (chez-str-lit (get node :name)) ")"))) :host (errorf "emit: unsupported host ref `%s` (no host interop on Chez yet)" (get node :name)) + # (var x) / #'x -> the var cell itself (the rt.ss var-cell, a first-class var + # object). var?/var-get/deref/invoke/= operate on it (vars.ss). + :the-var (string "(jolt-var " (chez-str-lit (get node :ns)) " " (chez-str-lit (get node :name)) ")") :if (let [test (get node :test) t (if (returns-scheme-bool? test) (emit test) (string "(jolt-truthy? " (emit test) ")"))] diff --git a/host/chez/natives-misc.ss b/host/chez/natives-misc.ss new file mode 100644 index 0000000..02fad88 --- /dev/null +++ b/host/chez/natives-misc.ss @@ -0,0 +1,144 @@ +;; misc scalar natives (jolt-cf1q.3) — UUID, format/printf, tagged-literal, +;; bigint. Seed natives that were jolt-nil on the prelude. +;; +;; Loaded after the printers (pr-str of a uuid is #uuid "…") and converters +;; (jolt-str-render-one for %s / str of a uuid). + +;; --- UUID -------------------------------------------------------------------- +;; A uuid is a record wrapping its canonical 36-char lowercase string. str -> the +;; bare string; pr-str -> #uuid "…"; not map?/coll?. +(define-record-type juuid (fields s) (nongenerative chez-juuid-v1)) +(define (jolt-uuid-pred? x) (juuid? x)) + +(define hexd "0123456789abcdef") +(define (rand-hex) (string-ref hexd (random 16))) +;; v4: 8-4-4-4-12, version nibble (index 14) = 4, variant nibble (index 19) in 8-b. +(define (random-uuid-str) + (let ((cs (make-string 36))) + (let loop ((i 0)) + (if (fx=? i 36) cs + (begin + (string-set! cs i + (cond ((or (fx=? i 8) (fx=? i 13) (fx=? i 18) (fx=? i 23)) #\-) + ((fx=? i 14) #\4) + ((fx=? i 19) (string-ref "89ab" (random 4))) + (else (rand-hex)))) + (loop (fx+ i 1))))))) +(define (jolt-random-uuid) (make-juuid (random-uuid-str))) + +;; parse-uuid: validate the canonical shape (8-4-4-4-12 hex), lowercase, -> uuid; +;; nil if the string doesn't conform (Clojure parse-uuid), error on a non-string. +(define (hex-char? c) (or (and (char>=? c #\0) (char<=? c #\9)) + (and (char>=? c #\a) (char<=? c #\f)) + (and (char>=? c #\A) (char<=? c #\F)))) +(define (uuid-shape? s) + (and (string? s) (fx=? (string-length s) 36) + (let loop ((i 0)) + (if (fx=? i 36) #t + (let ((c (string-ref s i))) + (cond ((or (fx=? i 8) (fx=? i 13) (fx=? i 18) (fx=? i 23)) (and (char=? c #\-) (loop (fx+ i 1)))) + ((hex-char? c) (loop (fx+ i 1))) + (else #f))))))) +(define (jolt-parse-uuid s) + (cond ((not (string? s)) (error #f "parse-uuid: not a string" s)) + ((uuid-shape? s) (make-juuid (string-downcase s))) + (else jolt-nil))) + +;; uuid? / random-uuid / parse-uuid are OVERLAY fns (they read :jolt/type), so +;; the prelude would clobber a def-var! here — they're asserted in post-prelude.ss. + +;; str of a uuid -> the bare 36-char string; pr-str -> #uuid "…". +(define %m-str-render-one jolt-str-render-one) +(set! jolt-str-render-one (lambda (x) (if (juuid? x) (juuid-s x) (%m-str-render-one x)))) +(define (juuid-pr u) (string-append "#uuid \"" (juuid-s u) "\"")) +(define %m-pr-str jolt-pr-str) +(set! jolt-pr-str (lambda (x) (if (juuid? x) (juuid-pr x) (%m-pr-str x)))) +(define %m-pr-readable jolt-pr-readable) +(set! jolt-pr-readable (lambda (x) (if (juuid? x) (juuid-pr x) (%m-pr-readable x)))) +;; two uuids are = iff same string. +(define %m-=2 jolt=2) +(set! jolt=2 (lambda (a b) + (cond ((juuid? a) (and (juuid? b) (string=? (juuid-s a) (juuid-s b)))) + ((juuid? b) #f) + (else (%m-=2 a b))))) + +;; --- bigint / biginteger ----------------------------------------------------- +;; jolt models every number as a double; an integer-valued double prints without +;; a ".0" (jolt-num->string), so bigint is just the number for the corpus range. +;; (Arbitrary-precision beyond 2^53 is a separate concern.) +(define (jolt-bigint x) x) +(def-var! "clojure.core" "bigint" jolt-bigint) +(def-var! "clojure.core" "biginteger" jolt-bigint) + +;; --- tagged-literal ---------------------------------------------------------- +;; (tagged-literal tag form): a tagged value with :tag / :form. tagged-literal? is +;; overlay (reads :jolt/type) so it's overridden in post-prelude.ss. +(define-record-type jtagged (fields tag form) (nongenerative chez-jtagged-v1)) +(define (jolt-tagged-literal tag form) (make-jtagged tag form)) +(define (jolt-tagged-literal-pred? x) (jtagged? x)) +(define kw-tl-tag (keyword #f "tag")) +(define kw-tl-form (keyword #f "form")) +(define %m-get jolt-get) +(set! jolt-get (case-lambda + ((coll k) (if (jtagged? coll) (jolt-get coll k jolt-nil) (%m-get coll k))) + ((coll k d) (if (jtagged? coll) + (cond ((jolt=2 k kw-tl-tag) (jtagged-tag coll)) + ((jolt=2 k kw-tl-form) (jtagged-form coll)) + (else d)) + (%m-get coll k d))))) +(define (jtagged-pr t) (string-append "#" (jolt-pr-str (jtagged-tag t)) " " (jolt-pr-readable (jtagged-form t)))) +(define %m2-pr-str jolt-pr-str) +(set! jolt-pr-str (lambda (x) (if (jtagged? x) (jtagged-pr x) (%m2-pr-str x)))) +(define %m2-pr-readable jolt-pr-readable) +(set! jolt-pr-readable (lambda (x) (if (jtagged? x) (jtagged-pr x) (%m2-pr-readable x)))) +(def-var! "clojure.core" "tagged-literal" jolt-tagged-literal) +;; tagged-literal? is OVERLAY (reads :jolt/type) — asserted in post-prelude.ss. + +;; --- format / printf --------------------------------------------------------- +;; A small %-format engine over the all-flonum number model: %d (integer), %s +;; (str), %f / %.Nf (fixed-point), %x/%X (hex int), %o (octal), %c (char int), +;; %b (boolean), %% (literal). Enough for the corpus; not the full Java spec. +(define (->long x) (exact (truncate x))) +(define (pad-left s n c) (if (fx>=? (string-length s) n) s (string-append (make-string (fx- n (string-length s)) c) s))) +(define (fmt-float x prec) + (let* ((neg (< x 0)) (ax (abs x)) + (scale (expt 10 prec)) + (scaled (round (* (inexact ax) scale))) + (i (exact (truncate (/ scaled scale)))) + (frac (exact (truncate (- scaled (* i scale)))))) + (string-append (if neg "-" "") + (number->string i) + (if (fx>? prec 0) (string-append "." (pad-left (number->string frac) prec #\0)) "")))) +(define (jolt-format fmt . args) + (let ((out (open-output-string))) + (let loop ((i 0) (as args)) + (if (fx>=? i (string-length fmt)) + (get-output-string out) + (let ((c (string-ref fmt i))) + (if (char=? c #\%) + ;; parse a directive: %[.prec]conv + (let scan ((j (fx+ i 1)) (prec #f) (seen-dot #f)) + (let ((d (string-ref fmt j))) + (cond + ((char=? d #\%) (write-char #\% out) (loop (fx+ j 1) as)) + ((char=? d #\.) (scan (fx+ j 1) 0 #t)) + ((and (char>=? d #\0) (char<=? d #\9)) + (scan (fx+ j 1) (fx+ (fx* (or prec 0) 10) (fx- (char->integer d) 48)) seen-dot)) + (else + (let ((a (if (null? as) jolt-nil (car as))) + (rest (if (null? as) '() (cdr as)))) + (display + (case d + ((#\d) (number->string (->long a))) + ((#\s) (jolt-str-render-one a)) + ((#\f) (fmt-float a (or prec 6))) + ((#\x) (number->string (->long a) 16)) + ((#\X) (string-upcase (number->string (->long a) 16))) + ((#\o) (number->string (->long a) 8)) + ((#\b) (if (jolt-truthy? a) "true" "false")) + ((#\c) (string (integer->char (->long a)))) + (else (string #\% d))) + out) + (loop (fx+ j 1) rest)))))) + (begin (write-char c out) (loop (fx+ i 1) as)))))))) +(def-var! "clojure.core" "format" jolt-format) diff --git a/host/chez/post-prelude.ss b/host/chez/post-prelude.ss index 1826bf7..0cc8d39 100644 --- a/host/chez/post-prelude.ss +++ b/host/chez/post-prelude.ss @@ -19,3 +19,12 @@ (def-var! "clojure.core" "vreset!" jolt-vreset!) (def-var! "clojure.core" "vswap!" jolt-vswap!) (def-var! "clojure.core" "volatile?" jolt-volatile-pred?) +;; bound?: the overlay reads (get v :root) — nil on a Chez var-cell record, so it +;; would wrongly report every var unbound. Native version (defined in vars.ss). +(def-var! "clojure.core" "bound?" jolt-bound?) +;; uuid?/random-uuid/parse-uuid/tagged-literal? are overlay (read :jolt/type or +;; build tagged tables) — re-assert the native versions (defined in natives-misc.ss). +(def-var! "clojure.core" "uuid?" jolt-uuid-pred?) +(def-var! "clojure.core" "random-uuid" jolt-random-uuid) +(def-var! "clojure.core" "parse-uuid" jolt-parse-uuid) +(def-var! "clojure.core" "tagged-literal?" jolt-tagged-literal-pred?) diff --git a/host/chez/rt.ss b/host/chez/rt.ss index 7eb4834..5c0f571 100644 --- a/host/chez/rt.ss +++ b/host/chez/rt.ss @@ -70,14 +70,20 @@ (hashtable-set! var-table k c) c)))) (define (var-deref ns name) (var-cell-root (jolt-var ns name))) -(define (def-var! ns name v) (var-cell-root-set! (jolt-var ns name) v) v) +;; def-var! / declare-var! return the VAR CELL, not the value — Clojure's `def` +;; evaluates to #'ns/name (a first-class var), so (var? (def x 1)) is true and +;; (pr-str (def x 1)) is "#'ns/x". The prelude's def-var! forms discard the +;; return, so this is transparent there. +(define (def-var! ns name v) (let ((c (jolt-var ns name))) (var-cell-root-set! c v) c)) ;; declare / (def name) with no init: reserve the cell ONLY if absent. An ;; existing root is left intact — Clojure's (def x) with no init does not clobber -;; a prior binding (do (def x 7) (def x) x) => 7. +;; a prior binding (do (def x 7) (def x) x) => 7. Returns the cell either way. (define (declare-var! ns name) (let ((k (string-append ns "/" name))) - (unless (hashtable-ref var-table k #f) - (hashtable-set! var-table k (make-var-cell ns name jolt-unbound))))) + (or (hashtable-ref var-table k #f) + (let ((c (make-var-cell ns name jolt-unbound))) + (hashtable-set! var-table k c) + c)))) ;; regex (jolt-i0s3): defines regex-t + the re-* fns (def-var!'d into ;; clojure.core), so it loads after def-var! and before the printer below (which @@ -217,3 +223,14 @@ ;; the transduce/sequence entry points over into-xform/reduce-seq. After ;; natives-seq.ss (into-xform), seq.ss (reduce-seq) + atoms.ss (deref). (load "host/chez/natives-xform.ss") + +;; vars as first-class objects (jolt-n7rz, Phase 2): var?/var-get/deref/invoke/=/ +;; pr-str over the rt.ss var-cell. After natives-xform.ss (chains deref) + the +;; printers. emit lowers :the-var to (jolt-var ns name). +(load "host/chez/vars.ss") + +;; misc scalar natives (jolt-cf1q.3): UUID (random-uuid/parse-uuid/uuid?), format/ +;; printf, tagged-literal, bigint. After the printers + converters (str/pr-str of +;; a uuid). Overlay names (uuid?/random-uuid/parse-uuid/tagged-literal?) re-asserted +;; in post-prelude.ss. +(load "host/chez/natives-misc.ss") diff --git a/host/chez/vars.ss b/host/chez/vars.ss new file mode 100644 index 0000000..938721b --- /dev/null +++ b/host/chez/vars.ss @@ -0,0 +1,57 @@ +;; vars as first-class objects (jolt-cf1q.3, jolt-n7rz) — (var x) / #'x. +;; +;; The emitter lowers :the-var to (jolt-var ns name) — the rt.ss var-cell, which +;; is now also a Clojure VAR value. var? / var-get / deref-of-var / var-as-IFn / +;; var equality / pr-str(#'ns/name) operate on it. bound? is overridden natively +;; in post-prelude.ss (the overlay reads (get v :root), nil on a record). +;; +;; Dynamic binding (binding / with-bindings* / var-set / thread-bound? / +;; with-redefs) is a separate follow-up — those crash on nil host primitives, +;; which is safe (a crash stays a crash, not a divergence). +;; +;; Loaded LAST (after natives-xform.ss): chains jolt-deref (atom/volatile arms) +;; and the printers. + +(define (jolt-var-pred? x) (var-cell? x)) + +;; the var's current root; unbound is an error (Clojure throws on an unbound var). +(define (jolt-var-get v) + (if (var-cell? v) + (let ((r (var-cell-root v))) + (if (eq? r jolt-unbound) (error #f "Unbound var" v) r)) + (error #f "var-get: not a var" v))) + +;; deref of a var -> its root. +(define %v-deref jolt-deref) +(set! jolt-deref (lambda (x) (if (var-cell? x) (jolt-var-get x) (%v-deref x)))) + +;; a var is an IFn — invoking it invokes its root value ((var f) args -> (f args)). +(define %v-invoke jolt-invoke) +(set! jolt-invoke (lambda (f . args) + (if (var-cell? f) (apply jolt-invoke (var-cell-root f) args) (apply %v-invoke f args)))) + +;; two var cells are = iff same ns/name (Clojure var identity). +(define %v-=2 jolt=2) +(set! jolt=2 (lambda (a b) + (cond ((var-cell? a) (and (var-cell? b) + (string=? (var-cell-ns a) (var-cell-ns b)) + (string=? (var-cell-name a) (var-cell-name b)))) + ((var-cell? b) #f) + (else (%v-=2 a b))))) + +;; pr-str / str of a var -> #'ns/name. +(define (var->str v) (string-append "#'" (var-cell-ns v) "/" (var-cell-name v))) +(define %v-pr-str jolt-pr-str) +(set! jolt-pr-str (lambda (x) (if (var-cell? x) (var->str x) (%v-pr-str x)))) +(define %v-pr-readable jolt-pr-readable) +(set! jolt-pr-readable (lambda (x) (if (var-cell? x) (var->str x) (%v-pr-readable x)))) +(define %v-str-render-one jolt-str-render-one) +(set! jolt-str-render-one (lambda (x) (if (var-cell? x) (var->str x) (%v-str-render-one x)))) + +;; bound? — native (the overlay's (get v :root) is nil on a var-cell record). +(define (jolt-var-bound-one? v) (and (var-cell? v) (not (eq? (var-cell-root v) jolt-unbound)))) +(define (jolt-bound? . vars) (if (for-all jolt-var-bound-one? vars) #t #f)) + +(def-var! "clojure.core" "var?" jolt-var-pred?) +(def-var! "clojure.core" "var-get" jolt-var-get) +(def-var! "clojure.core" "deref" jolt-deref) diff --git a/test/chez/run-corpus-prelude.janet b/test/chez/run-corpus-prelude.janet index f298140..25e5c65 100644 --- a/test/chez/run-corpus-prelude.janet +++ b/test/chez/run-corpus-prelude.janet @@ -61,12 +61,9 @@ "inf inside coll" true # Phase 2 inc B (jolt-9zhh) made pr-str run; these now render via the readable # FALLBACK instead of the seed's print-method / var semantics — separate gaps: - # - def returns the VALUE on Chez, not the var (#'ns/name) — def-returns-var - # is a later increment; (pr-str (def x 1)) -> "1" not "#'user/x" # - a custom (defmethod print-method ...) isn't consulted by the Chez printer # (print-method multimethod integration is deferred) - "pr-str of a var" true - "pr-str of a defn" true + # (pr-str of a var / defn now PASS — inc I made def return the var #'ns/name.) "atom override fires nested" true # Phase 2 inc D (jolt-jgoc) made records run; pr-str of a record uses the # built-in #ns.Name{...} form, not a user (defmethod print-method 'ns.Name …) @@ -74,7 +71,14 @@ "defmethod overrides a record, top level" true "defmethod fires nested in a map" true "defmethod fires through prn" true - "methods table inspectable" true}) + "methods table inspectable" true + # Phase 2 inc I (jolt-n7rz) made (var x)/#'x emit + the static var ops run; a + # var's def-time metadata (^:private / ^Type tag / docstring) isn't captured on + # the Chez var-cell yet, so (meta (var v)) is nil — var-metadata capture is a + # later increment. + "^:private on var" true + "^Type tag on var" true + "(def name doc val) doc" true}) (def ctx (d/make-ctx)) @@ -180,8 +184,13 @@ # existing into-xform/reduce-seq — unblocks (sequence xform coll), (transduce # xform f coll), and the stateful transducer xforms take-nth/map-indexed/ # partition-by that drive a volatile) 1898. +# Phase 2 inc I (jolt-n7rz: first-class vars — emit :the-var to the rt.ss var-cell +# + var?/var-get/deref/invoke/=/pr-str + bound?; def now RETURNS the var (#'ns/name) +# matching Clojure, which also un-allowlists pr-str-of-var/defn) and inc J +# (jolt-snry: scalar natives — UUID random-uuid/parse-uuid/uuid?, format/printf, +# tagged-literal, bigint) 1951. # Strided runs scale down. -(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_PRELUDE_FLOOR") "1898"))) +(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_PRELUDE_FLOOR") "1951"))) (def floor (if (os/getenv "JOLT_CORPUS_LIMIT") 0 base-floor)) (when (or (> (length diverged) 0) (< pass floor)) (printf "REGRESSION: pass %d < floor %d or %d new divergence(s)" pass floor (length diverged)))