Chez Phase 2 (inc I+J): first-class vars + scalar natives

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

@@ -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) ")"))]

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)

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?)

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")

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)

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)))