From 31a453d492891094d54223c882aa54574317dc5a Mon Sep 17 00:00:00 2001 From: Yogthos Date: Sun, 21 Jun 2026 17:13:40 -0400 Subject: [PATCH] (. obj :kw) is a keyword lookup (JVM parity) The . special form rejected a non-symbol member; a keyword member now lowers to an invoke of the keyword on the target ((. {:value 41} :value) => 41, as on the JVM). Added a form-keyword? contract seam. Corpus 2692->2693. Re-minted. --- host/chez/host-contract.ss | 2 ++ host/chez/run-corpus.ss | 4 ++-- host/chez/seed/image.ss | 2 +- jolt-core/jolt/analyzer.clj | 18 +++++++++++------- 4 files changed, 16 insertions(+), 10 deletions(-) diff --git a/host/chez/host-contract.ss b/host/chez/host-contract.ss index 4181fa3..44fd9dc 100644 --- a/host/chez/host-contract.ss +++ b/host/chez/host-contract.ss @@ -51,6 +51,7 @@ (or (pset? x) (and (pmap? x) (eq? (jolt-get x hc-kw-jolt-type) hc-kw-jolt-set)))) (define (hc-char? x) (char? x)) +(define (hc-keyword? x) (keyword? x)) (define (hc-literal? x) (or (jolt-nil? x) (boolean? x) (number? x) (string? x) (keyword-t? x) (char? x))) @@ -286,6 +287,7 @@ (def-var! "jolt.host" "form-char?" hc-char?) (def-var! "jolt.host" "form-char-code" hc-char-code) (def-var! "jolt.host" "form-literal?" hc-literal?) + (def-var! "jolt.host" "form-keyword?" hc-keyword?) (def-var! "jolt.host" "form-regex?" hc-regex?) (def-var! "jolt.host" "form-inst?" hc-inst?) (def-var! "jolt.host" "form-uuid?" hc-uuid?) diff --git a/host/chez/run-corpus.ss b/host/chez/run-corpus.ss index 50220da..b2ea706 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 2692) +;; JOLT_CHEZ_ZJ_FLOOR=N override the regression floor (default 2693) ;; JOLT_CORPUS_LIMIT=N every-Nth stride (fast iteration; floor drops to 0) ;; JOLT_DUMP_CRASH_LABELS=1 list crash + allowlisted labels (import (chezscheme)) @@ -203,7 +203,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) 2692))) + (if s (string->number s) 2693))) (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/image.ss b/host/chez/seed/image.ss index 6c1bc3a..47afb32 100644 --- a/host/chez/seed/image.ss +++ b/host/chez/seed/image.ss @@ -91,7 +91,7 @@ (guard (e (#t #f)) (def-var! "jolt.analyzer" "analyze-ctor" (letrec ((analyze-ctor (lambda (ctx class args env) (let fnrec1631 ((ctx ctx) (class class) (args args) (env env)) (jolt-invoke (var-deref "jolt.ir" "host-new") class (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (p__52_) (let fnrec1632 ((p__52_ p__52_)) (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx p__52_ env))) args)))))) analyze-ctor))) (guard (e (#t #f)) - (def-var! "jolt.analyzer" "analyze-dot" (letrec ((analyze-dot (lambda (ctx items env) (let fnrec1633 ((ctx ctx) (items items) (env env)) (begin (if (< (jolt-count items) 3) (jolt-throw (jolt-invoke (var-deref "clojure.core" "str") "Malformed (. target member ...) form")) jolt-nil) (let* ((member (jolt-nth items 2))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-sym?") member)) (let* ((_o$1635 (keyword #f "op")) (_o$1636 (keyword #f "host-call")) (_o$1637 (keyword #f "method")) (_o$1638 (jolt-invoke (var-deref "jolt.host" "form-sym-name") member)) (_o$1639 (keyword #f "target")) (_o$1640 (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx (jolt-nth items 1) env)) (_o$1641 (keyword #f "args")) (_o$1642 (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (p__53_) (let fnrec1634 ((p__53_ p__53_)) (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx p__53_ env))) (jolt-drop 3 items)))) (jolt-hash-map _o$1635 _o$1636 _o$1637 _o$1638 _o$1639 _o$1640 _o$1641 _o$1642)) (jolt-invoke (var-deref "jolt.analyzer" "uncompilable") "special form . (non-symbol member)")))))))) analyze-dot))) + (def-var! "jolt.analyzer" "analyze-dot" (letrec ((analyze-dot (lambda (ctx items env) (let fnrec1633 ((ctx ctx) (items items) (env env)) (begin (if (< (jolt-count items) 3) (jolt-throw (jolt-invoke (var-deref "clojure.core" "str") "Malformed (. target member ...) form")) jolt-nil) (let* ((member (jolt-nth items 2))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-sym?") member)) (let* ((_o$1635 (keyword #f "op")) (_o$1636 (keyword #f "host-call")) (_o$1637 (keyword #f "method")) (_o$1638 (jolt-invoke (var-deref "jolt.host" "form-sym-name") member)) (_o$1639 (keyword #f "target")) (_o$1640 (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx (jolt-nth items 1) env)) (_o$1641 (keyword #f "args")) (_o$1642 (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (p__53_) (let fnrec1634 ((p__53_ p__53_)) (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx p__53_ env))) (jolt-drop 3 items)))) (jolt-hash-map _o$1635 _o$1636 _o$1637 _o$1638 _o$1639 _o$1640 _o$1641 _o$1642)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-keyword?") member)) (jolt-invoke (var-deref "jolt.ir" "invoke") (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx member env) (jolt-vector (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx (jolt-nth items 1) env))) (if (jolt-truthy? (keyword #f "else")) (jolt-invoke (var-deref "jolt.analyzer" "uncompilable") "special form . (non-symbol member)") jolt-nil))))))))) analyze-dot))) (guard (e (#t #f)) (def-var! "jolt.analyzer" "field-head?" (letrec ((field-head? (lambda (nm) (let fnrec1643 ((nm nm)) (let* ((and__13__auto (> (jolt-count nm) 2))) (if (jolt-truthy? and__13__auto) (jolt= ".-" (jolt-invoke (var-deref "clojure.core" "subs") nm 0 2)) and__13__auto)))))) field-head?))) (guard (e (#t #f)) diff --git a/jolt-core/jolt/analyzer.clj b/jolt-core/jolt/analyzer.clj index 47e7300..1f582b4 100644 --- a/jolt-core/jolt/analyzer.clj +++ b/jolt-core/jolt/analyzer.clj @@ -19,7 +19,7 @@ quote-node throw-node host-static host-new]] [jolt.host :refer [form-sym? form-sym-name form-sym-ns form-list? form-vec? form-map? form-set? form-char? - form-literal? form-elements form-vec-items + form-literal? form-keyword? form-elements form-vec-items form-map-pairs form-set-items form-special? compile-ns form-regex? form-regex-source form-inst? form-inst-source form-uuid? form-uuid-source @@ -335,12 +335,16 @@ (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)")))) + (cond + (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))} + ;; (. obj :kw) is a keyword lookup — invoke the keyword on the target. + (form-keyword? member) + (invoke (analyze ctx member env) [(analyze ctx (nth items 1) env)]) + :else (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).