simon/jolt
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

(. obj :kw) is a keyword lookup (JVM parity)

Browse source 
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.
This commit is contained in:
Yogthos 2026-06-21 17:13:40 -04:00
parent 45596d7239
commit 31a453d492
4 changed files with 16 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

2
host/chez/host-contract.ss
View file

@ -51,6 +51,7 @@
(or (pset? x) (or (pset? x)
(and (pmap? x) (eq? (jolt-get x hc-kw-jolt-type) hc-kw-jolt-set)))) (and (pmap? x) (eq? (jolt-get x hc-kw-jolt-type) hc-kw-jolt-set))))
(define (hc-char? x) (char? x)) (define (hc-char? x) (char? x))
(define (hc-keyword? x) (keyword? x))
(define (hc-literal? x) (define (hc-literal? x)
(or (jolt-nil? x) (boolean? x) (number? x) (string? x) (keyword-t? x) (char? 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?" hc-char?)
(def-var! "jolt.host" "form-char-code" hc-char-code) (def-var! "jolt.host" "form-char-code" hc-char-code)
(def-var! "jolt.host" "form-literal?" hc-literal?) (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-regex?" hc-regex?)
(def-var! "jolt.host" "form-inst?" hc-inst?) (def-var! "jolt.host" "form-inst?" hc-inst?)
(def-var! "jolt.host" "form-uuid?" hc-uuid?) (def-var! "jolt.host" "form-uuid?" hc-uuid?)

4
host/chez/run-corpus.ss
View file

@ -11,7 +11,7 @@
;; reset between cases so there is no leakage — same isolation a fresh process gives. ;; reset between cases so there is no leakage — same isolation a fresh process gives.
;; ;;
;; chez --script host/chez/run-corpus.ss ;; 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_CORPUS_LIMIT=N every-Nth stride (fast iteration; floor drops to 0)
;; JOLT_DUMP_CRASH_LABELS=1 list crash + allowlisted labels ;; JOLT_DUMP_CRASH_LABELS=1 list crash + allowlisted labels
(import (chezscheme)) (import (chezscheme))
@ -203,7 +203,7 @@
;; Regression floor: fail on any NEW divergence or if pass drops below the floor. ;; Regression floor: fail on any NEW divergence or if pass drops below the floor.
(define base-floor (let ((s (getenv "JOLT_CHEZ_ZJ_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)) (define floor (if limit 0 base-floor))
(when (or (> (length diverged) 0) (< pass floor)) (when (or (> (length diverged) 0) (< pass floor))
(printf "REGRESSION: pass ~a < floor ~a or ~a new divergence(s)\n" (printf "REGRESSION: pass ~a < floor ~a or ~a new divergence(s)\n"

2
host/chez/seed/image.ss
View file

@ -91,7 +91,7 @@
(guard (e (#t #f)) (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))) (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)) (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)) (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?))) (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)) (guard (e (#t #f))

18
jolt-core/jolt/analyzer.clj
View file

@ -19,7 +19,7 @@
quote-node throw-node host-static host-new]] quote-node throw-node host-static host-new]]
[jolt.host :refer [form-sym? form-sym-name form-sym-ns form-list? [jolt.host :refer [form-sym? form-sym-name form-sym-ns form-list?
form-vec? form-map? form-set? form-char? 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-map-pairs form-set-items form-special? compile-ns
form-regex? form-regex-source form-regex? form-regex-source
form-inst? form-inst-source form-uuid? form-uuid-source form-inst? form-inst-source form-uuid? form-uuid-source
@ -335,12 +335,16 @@
(when (< (count items) 3) (when (< (count items) 3)
(throw (str "Malformed (. target member ...) form"))) (throw (str "Malformed (. target member ...) form")))
(let [member (nth items 2)] (let [member (nth items 2)]
(if (form-sym? member) (cond
{:op :host-call (form-sym? member)
:method (form-sym-name member) {:op :host-call
:target (analyze ctx (nth items 1) env) :method (form-sym-name member)
:args (mapv #(analyze ctx % env) (drop 3 items))} :target (analyze ctx (nth items 1) env)
(uncompilable "special form . (non-symbol member)")))) :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 ;; 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). ;; with the "-field" method (the dash signals field access to the dispatcher).