Chez Phase 2 (inc R): . / .-field dot-form desugar (jolt-kuic)

The analyzer lowers the `.` special form (. target member arg*) and the
.-field field-access head to a :host-call instead of leaving them
uncompilable. Janet behaviour is unchanged — its back end punts :host-call
to the interpreter, which re-runs the original `.` form via eval-dot.

The Chez back end routes a non-shimmed :host-call through
record-method-dispatch, extended by a new host/chez/dot-forms.ss with the
arms dispatch-member covers but the record/string base did not, mirroring
src/jolt/interop/collections.janet precedence:

  - collection interop first (count/seq/nth/get/valAt/containsKey on a
    vector/map/set), so (. {:count 9} count) is the entry count like the seed
  - field access for a "-name" member (records and maps)
  - the seed's universal object-methods (getMessage/getCause/toString/
    hashCode/equals) on a non-record map, winning over a field lookup
  - non-record map member: a stored fn is a method called with self, else
    the field value

Raw seqs are excluded from coll interop — the seed's behaviour there is
representation-dependent (plain (seq v) vs a lazy-seq) and a normalized cseq
can't mirror it. Also added getMessage/getLocalizedMessage/equals to the
string method surface so a thrown string / Exception. ctor (which keeps the
message string) answers .getMessage.

Parity 2134 -> 2150, 0 new divergences. New test/chez/_dotform.janet 26/26;
emit-test 331/331.

host/chez/dot-forms.ss

@@ -0,0 +1,82 @@
+;; dot-forms.ss — generic dispatch for the `.` special-form / `.-field` desugar
+;; (jolt-kuic). The analyzer lowers (. target member arg*) and (.-field target)
+;; to a :host-call; the Chez emit routes a non-shimmed :host-call through
+;; record-method-dispatch. This file extends that dispatcher with the collection
+;; arms the interpreter's dispatch-member covers but the record/string base does
+;; not, mirroring src/jolt/interop/collections.janet precedence exactly:
+;;
+;;   * collection interop wins first — count/seq/nth/get/valAt/containsKey on a
+;;     vector/map/set/seq/record (so (. {:count 9} count) is the entry count, 1,
+;;     like the seed, NOT the :count field).
+;;   * field access — a "-name" member reads the field (records and maps).
+;;   * map member   — a stored fn is a method (called with self + args); any
+;;                    other value is returned as a field.
+;;
+;; Anything not recognized falls through to the previous dispatcher (jhost /
+;; number / regex / jrec protocol / string). Loaded LAST (after host-static.ss).
+;; A record (jrec) is jolt-map? here (records.ss makes it so) and a collection,
+;; so its protocol method (no dash, not a coll method) lands in the base.
+
+(define %dot-rmd record-method-dispatch)
+
+;; Vectors / maps / sets only (records are jolt-map? here). Raw seqs are excluded:
+;; the seed's coll-interop accepts some seq representations and not others (a
+;; plain (seq v) returns nil from .count, a lazy-seq returns the count), an
+;; inconsistency Chez's normalized cseq can't mirror — so a raw seq target falls
+;; through to the base dispatcher rather than risk a divergence the corpus would
+;; never exercise but a future case might.
+(define (dot-coll? obj)
+  (or (jolt-vector? obj) (jolt-map? obj) (pset? obj)))
+
+;; Mirror coll-interop: return a one-element list boxing the result (so a jolt-nil
+;; result is still distinguishable from "not a collection method"), or #f.
+(define (dot-coll-method obj name args)
+  (cond
+    ((string=? name "count") (list (jolt-count obj)))
+    ((string=? name "seq")   (list (jolt-seq obj)))
+    ((string=? name "nth")   (list (apply jolt-nth obj args)))
+    ((or (string=? name "get") (string=? name "valAt"))
+     (list (apply jolt-get obj args)))
+    ((string=? name "containsKey") (list (jolt-contains? obj (car args))))
+    (else #f)))
+
+;; Mirror the seed's universal object-methods (src/jolt/eval_resolve.janet): on a
+;; non-record map these win OVER a field lookup, like dispatch-member. getMessage
+;; on an ex-info reads its :message (the one the corpus exercises); getCause reads
+;; :cause; toString/hashCode/equals round out the set. Returns a boxed result or
+;; #f. Strings/numbers/records/jhost keep the base dispatcher (it shims them).
+(define (dot-object-method obj name args)
+  (cond
+    ((string=? name "getMessage")
+     (list (if (jolt=2 (jolt-get obj jolt-kw-ex-type jolt-nil) jolt-kw-ex-info)
+               (jolt-get obj jolt-kw-message jolt-nil)
+               (jolt-str-render-one obj))))
+    ((string=? name "getCause")  (list (jolt-get obj jolt-kw-cause jolt-nil)))
+    ((string=? name "toString")  (list (jolt-str-render-one obj)))
+    ((string=? name "hashCode")  (list (jolt-hash obj)))
+    ((string=? name "equals")    (list (if (jolt= obj (car args)) #t #f)))
+    (else #f)))
+
+(set! record-method-dispatch
+  (lambda (obj method-name rest-args)
+    (let* ((rest (if (jolt-nil? rest-args) '() (seq->list rest-args)))
+           (field? (and (> (string-length method-name) 0)
+                        (char=? (string-ref method-name 0) #\-)))
+           (mname (if field?
+                      (substring method-name 1 (string-length method-name))
+                      method-name)))
+      (cond
+        ;; collection interop first (entry count / seq / nth / get / containsKey).
+        ((and (dot-coll? obj) (dot-coll-method obj mname rest))
+         => (lambda (box) (car box)))
+        ;; (.-field obj) / (. obj -field): field read on a record or map.
+        (field? (jolt-get obj (keyword #f mname) jolt-nil))
+        ;; non-record map: a universal object-method (getMessage/...) wins first,
+        ;; then a stored procedure is a method (call with self), else the field.
+        ((and (jolt-map? obj) (not (jrec? obj)))
+         (cond
+           ((dot-object-method obj mname rest) => car)
+           (else
+            (let ((v (jolt-get obj (keyword #f mname) jolt-nil)))
+              (if (procedure? v) (apply jolt-invoke v obj rest) v)))))
+        (else (%dot-rmd obj method-name rest-args))))))

host/chez/jolt-chez.janet

@@ -22,7 +22,7 @@
            "host/chez/atoms.ss" "host/chez/predicates.ss" "host/chez/regex.ss"
            "host/chez/ns.ss" "host/chez/post-prelude.ss" "host/chez/natives-meta.ss"
            "host/chez/natives-str.ss" "host/chez/records.ss"
-           "host/chez/host-static.ss"
+           "host/chez/host-static.ss" "host/chez/dot-forms.ss"
            "src/jolt/clojure/string.clj"]
     (array/push parts (slurp f)))
   (string/slice (string (hash (string/join parts))) 0))

host/chez/natives-str.ss

@@ -124,6 +124,11 @@
     ((string=? method "replaceFirst") (irregex-replace (str-irx (arg 0)) s (arg 1)))
     ((string=? method "split")
      (apply jolt-vector (str-split-drop-trailing (irregex-split (str-irx (arg 0)) s))))
+    ;; universal object-methods that reach a string target (seed object-methods):
+    ;; a thrown string / Exception. ctor (which keeps the message string) answers
+    ;; getMessage with itself; equals is value equality.
+    ((or (string=? method "getMessage") (string=? method "getLocalizedMessage")) s)
+    ((string=? method "equals") (and (string? (arg 0)) (string=? s (arg 0))))
     (else (error #f (string-append "No method " method " for value")))))
 
 ;; --- clojure.core str-* primitives (the substrate clojure.string.clj calls) ---

host/chez/rt.ss

@@ -277,3 +277,8 @@
 ;; record-method-dispatch (records.ss) and reuses natives-str helpers (str-trim,
 ;; ascii-string-down, re-split, str-split-drop-trailing) + the regex-t accessors.
 (load "host/chez/host-static.ss")
+
+;; generic dot-form dispatch (jolt-kuic): field access + map/vector member access
+;; for the `.` / `.-field` desugar. Loads after host-static.ss so it wraps every
+;; record-method-dispatch arm (jhost/number/regex/jrec/string) and falls through.
+(load "host/chez/dot-forms.ss")

jolt-core/jolt/analyzer.clj

@@ -308,6 +308,38 @@
 (defn- analyze-ctor [ctx class args env]
   (host-new class (mapv #(analyze ctx % env) args)))
 
+;; The `.` special form: `(. target member arg*)` — member access / method call.
+;; A symbol member whose name starts with "-" is a field read; otherwise it is a
+;; method (call with the trailing args). Both lower to a :host-call carrying the
+;; member name verbatim (the leading "-" survives so the runtime dispatcher reads
+;; it as a field). The Janet back end punts :host-call to the interpreter, which
+;; re-runs the original `.` form via eval-dot — so Janet behavior is unchanged;
+;; the Chez back end dispatches it through record-method-dispatch (jolt-kuic).
+;; A non-symbol member (e.g. a keyword) stays punted — the interpreter handles it.
+(defn- analyze-dot [ctx items env]
+  (when (< (count items) 3)
+    (throw (str "Malformed (. target member ...) form")))
+  (let [member (nth items 2)]
+    (if (form-sym? member)
+      {:op :host-call
+       :method (form-sym-name member)
+       :target (analyze ctx (nth items 1) env)
+       :args (mapv #(analyze ctx % env) (drop 3 items))}
+      (uncompilable "special form . (non-symbol member)"))))
+
+;; A `.-field` head: `(.-field target)` is field access. Lowers to a :host-call
+;; with the "-field" method (the dash signals field access to the dispatcher).
+(defn- field-head? [nm]
+  (and (> (count nm) 2) (= ".-" (subs nm 0 2))))
+
+(defn- analyze-field [ctx hname items env]
+  (when (< (count items) 2)
+    (throw (str "Malformed (.-field target) form")))
+  {:op :host-call
+   :method (subs hname 1)        ; ".-field" -> "-field"
+   :target (analyze ctx (nth items 1) env)
+   :args []})
+
 (defn- analyze-symbol [ctx form env]
   (let [nm (form-sym-name form) ns (form-sym-ns form)]
     (cond
@@ -364,6 +396,12 @@
           (and (= hname "new") (not shadowed) (>= (count items) 2)
                (form-sym? (nth items 1)))
             (analyze-ctor ctx (form-sym-name (nth items 1)) (drop 2 items) env)
+          ;; (. target member arg*) — the `.` special form.
+          (and (= hname ".") (not shadowed))
+            (analyze-dot ctx items env)
+          ;; (.-field target) — field-access head.
+          (and hname (not shadowed) (field-head? hname))
+            (analyze-field ctx hname items env)
           (and hname (not shadowed) (form-special? hname))
             (uncompilable (str "special form " hname))
           (and (form-sym? head) (not shadowed) (form-macro? ctx head))

test/chez/_dotform.janet

@@ -0,0 +1,70 @@
+# jolt-kuic — the `.` special form + `.-field` field-access desugar on Chez. The
+# analyzer lowers (. target member arg*) and (.-field target) to a :host-call;
+# the Chez emit routes a non-shimmed :host-call through record-method-dispatch,
+# which dot-forms.ss extends with field access + map/vector member dispatch.
+# Expectations are the build/jolt (seed) oracle, captured per case.
+#
+#   janet test/chez/_dotform.janet
+(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/jolt-chez"))
+
+(def exprs
+  [# strings: method calls via the String surface
+   "(. \"HI\" toLowerCase)"
+   "(. \"abc\" length)"
+   "(. \"abc\" toUpperCase)"
+   # vectors / maps: collection interop (count/nth/get/containsKey)
+   "(. [1 2 3] count)"
+   "(. [10 20 30] nth 1)"
+   "(. {:a 1 :b 2} count)"
+   "(. {:a 1 :b 2} get :b)"
+   "(. {:a 1} containsKey :a)"
+   "(. {:count 99} count)"
+   # map member: stored fn called with self (+ args), else field value
+   "(. {:value 41 :describe (fn [self] (str \"v=\" (:value self)))} describe)"
+   "(. {:greet (fn [self n] (str \"Hello \" n))} greet \"Alice\")"
+   "(. {:value 41} value)"
+   # field access via .-field head
+   "(.-value {:value 41})"
+   "(.-x {:x 7 :y 9})"
+   # field access via (. obj -field)
+   "(. {:value 41} -value)"
+   # records: .-field reads a field, .method dispatches the protocol method
+   "(do (defrecord Rf [x]) (.-x (->Rf 7)))"
+   "(do (defrecord Rg [a b]) (.-b (->Rg 1 2)))"
+   "(do (defprotocol Greet (hi [_])) (defrecord Rh [nm] Greet (hi [_] (str \"hi \" nm))) (. (->Rh \"x\") hi))"
+   # universal object-methods on a non-record map win over a field lookup
+   "(try (throw (ex-info \"bad\" {})) (catch Throwable e (.getMessage e)))"
+   "(try (throw (ex-info \"bad\" {:k 1})) (catch Throwable e (.getMessage e)))"
+   "(try (throw \"boom\") (catch Throwable e (.getMessage e)))"
+   "(try (throw (Exception. \"boom\")) (catch Throwable e (.getMessage e)))"
+   "(try (throw (IllegalArgumentException. \"bad\")) (catch Exception e (.getMessage e)))"
+   "(.equals \"a\" \"a\")"
+   "(.equals \"a\" \"b\")"
+   "(. {:value 41 :describe (fn [self] (str \"v=\" (:value self)))} describe)"])
+
+(defn run-capture [bin expr]
+  (def proc (os/spawn [bin "-e" expr] :p {:out :pipe :err :pipe}))
+  (def out (ev/read (proc :out) 0x100000))
+  (def err (ev/read (proc :err) 0x100000))
+  (def code (os/proc-wait proc))
+  (def lines (filter (fn [l] (not (empty? l)))
+                     (string/split "\n" (string/trim (if out (string out) "")))))
+  [code (if (empty? lines) "" (last lines)) (string/trim (if err (string err) ""))])
+
+(var pass 0)
+(def fails @[])
+(each expr exprs
+  (def [ocode oracle _] (run-capture "build/jolt" expr))
+  (def [code got err] (run-capture jolt-bin expr))
+  (cond
+    (not= ocode 0) (array/push fails [expr (string "ORACLE FAILED exit " ocode)])
+    (not= code 0) (array/push fails [expr (string "exit " code "; err: " err)])
+    (= got oracle) (++ pass)
+    (array/push fails [expr (string "want `" oracle "`, got `" got "`")])))
+
+(printf "\n_dotform parity [%s]: %d/%d passed" jolt-bin pass (length exprs))
+(when (> (length fails) 0)
+  (printf "%d FAIL(s):" (length fails))
+  (each [e m] fails (printf "  FAIL %s\n    %s" e m)))
+(flush)
+(os/exit (if (empty? fails) 0 1))

test/chez/emit-test.janet

@@ -336,6 +336,21 @@
   (let [scm (protect (emit/emit (backend/analyze-form ctx (in (r/parse-next src) 0))))]
     (ok label (and (scm 0) (string/find needle (scm 1))) (string/format "%p" scm))))
 
+# 3l'') the `.` special form + `.-field` desugar (jolt-kuic). (. target member
+#   arg*) and (.-field target) lower to a :host-call routed through
+#   record-method-dispatch (a non-shimmed method); the dash on a field member
+#   survives in the method name so dot-forms.ss reads it as a field access. The
+#   Janet back end punts :host-call (interpreter re-runs the original `.` form);
+#   runtime behaviour is covered by test/chez/_dotform.janet.
+(each [label src needle]
+  [["emit (. obj method) -> record-method-dispatch" "(fn [o] (. o frob))" "record-method-dispatch"]
+   ["emit (. obj method) keeps method name" "(fn [o] (. o frob))" "\"frob\""]
+   ["emit (. obj method arg) passes args" "(fn [o a] (. o frob a))" "record-method-dispatch"]
+   ["emit (.-field obj) keeps dash" "(fn [o] (.-value o))" "\"-value\""]
+   ["emit (. obj -field) keeps dash" "(fn [o] (. o -value))" "\"-value\""]]
+  (let [scm (protect (emit/emit (backend/analyze-form ctx (in (r/parse-next src) 0))))]
+    (ok label (and (scm 0) (string/find needle (scm 1))) (string/format "%p" scm))))
+
 # 3m) regex (jolt-i0s3): the #"…" literal lowers to a jolt-regex value over the
 #   vendored irregex; re-pattern/re-matches/re-find/re-seq/regex? are def-var!'d
 #   into clojure.core (not subset native-ops — irregex's Unicode/property

test/chez/run-corpus-prelude.janet

@@ -233,8 +233,15 @@
 # exception constructors. Also emit now evaluates collection-literal elements
 # left-to-right (emit-ordered), which un-allowlisted the 6 eval-order cases.
 # java.time formatting / edn-read-over-readers / slurp-over-readers deferred) 2134.
+# jolt-kuic (the `.` special form + `.-field` desugar — the analyzer lowers
+# (. target member arg*) and (.-field target) to :host-call; the Chez RT
+# dispatches them through record-method-dispatch, extended by dot-forms.ss with
+# collection interop (count/nth/get/valAt/containsKey), field access, non-record
+# map member dispatch, and the seed's universal object-methods getMessage/getCause/
+# toString/hashCode/equals. Also added getMessage/getLocalizedMessage/equals to the
+# string method surface so a thrown string / Exception. ctor answers .getMessage) 2150.
 # Strided runs scale down.
-(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_PRELUDE_FLOOR") "2134")))
+(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_PRELUDE_FLOOR") "2150")))
 (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)))