From 8ce00d29fddc614a2b1f3d0bf8fa945fd2aeabe0 Mon Sep 17 00:00:00 2001 From: Yogthos Date: Sun, 21 Jun 2026 23:40:59 -0400 Subject: [PATCH] embed a namespace value spliced into a form (~*ns*) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit A macro like (defmacro cur-ns [] `(str ~*ns*)) splices the live *ns* value into its expansion, leaving an opaque jns object as a list element. The analyzer had no way to carry a runtime value and threw uncompilable — the last remaining corpus crash. Recognize a jns via the host contract (form-ns-value?) and emit a :the-ns leaf that reconstructs it by name (intern-ns!) at the call site, the same IR-leaf pattern as regex/inst/uuid. Closes unquote-*ns*-in- template; corpus crash count -> 0. A namespace fast path rather than a general constant pool: it's the only embedded-value case in the corpus and the common real-world one (libs splice ~*ns*). A general pool can come later if other value types appear. --- host/chez/host-contract.ss | 7 +++++++ host/chez/run-corpus.ss | 4 ++-- host/chez/seed/image.ss | 4 ++-- jolt-core/jolt/analyzer.clj | 4 ++++ jolt-core/jolt/backend_scheme.clj | 2 ++ 5 files changed, 17 insertions(+), 4 deletions(-) diff --git a/host/chez/host-contract.ss b/host/chez/host-contract.ss index a26cb73..b8941b5 100644 --- a/host/chez/host-contract.ss +++ b/host/chez/host-contract.ss @@ -62,6 +62,11 @@ (define (hc-regex? x) (hc-tagged-of x hc-kw-regex)) (define (hc-inst? x) (hc-tagged-of x hc-kw-inst)) (define (hc-uuid? x) (hc-tagged-of x hc-kw-uuid)) +;; A live namespace value spliced into a form (e.g. `(str ~*ns*) in a macro): +;; the analyzer can't carry an opaque runtime value, so recognize a jns and +;; reconstruct it by name at the call site (jolt-8sha). +(define (hc-ns-value? x) (jns? x)) +(define (hc-ns-value-name x) (jns-name x)) ;; --- form accessors --------------------------------------------------------- (define (hc-char-code x) (char->integer x)) ; native Chez char -> codepoint @@ -292,6 +297,8 @@ (def-var! "jolt.host" "form-regex?" hc-regex?) (def-var! "jolt.host" "form-inst?" hc-inst?) (def-var! "jolt.host" "form-uuid?" hc-uuid?) + (def-var! "jolt.host" "form-ns-value?" hc-ns-value?) + (def-var! "jolt.host" "form-ns-value-name" hc-ns-value-name) (def-var! "jolt.host" "form-elements" hc-elements) (def-var! "jolt.host" "form-vec-items" hc-vec-items) (def-var! "jolt.host" "form-set-items" hc-set-items) diff --git a/host/chez/run-corpus.ss b/host/chez/run-corpus.ss index eb0f0fc..80ee59f 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 2722) +;; JOLT_CHEZ_ZJ_FLOOR=N override the regression floor (default 2723) ;; JOLT_CORPUS_LIMIT=N every-Nth stride (fast iteration; floor drops to 0) ;; JOLT_DUMP_CRASH_LABELS=1 list crash + allowlisted labels (import (chezscheme)) @@ -192,7 +192,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) 2722))) + (if s (string->number s) 2723))) (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 47afb32..fbef656 100644 --- a/host/chez/seed/image.ss +++ b/host/chez/seed/image.ss @@ -101,7 +101,7 @@ (guard (e (#t #f)) (def-var! "jolt.analyzer" "analyze-list" (letrec ((analyze-list (lambda (ctx form env) (let fnrec1654 ((ctx ctx) (form form) (env env)) (let* ((items (jolt-invoke (var-deref "clojure.core" "vec") (jolt-invoke (var-deref "jolt.host" "form-elements") form)))) (if (jolt-zero? (jolt-count items)) (jolt-invoke (var-deref "jolt.ir" "quote-node") form) (let* ((head (jolt-first items)) (hname (if (jolt-truthy? (let* ((and__13__auto (jolt-invoke (var-deref "jolt.host" "form-sym?") head))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "clojure.core" "nil?") (jolt-invoke (var-deref "jolt.host" "form-sym-ns") head)) and__13__auto))) (jolt-invoke (var-deref "jolt.host" "form-sym-name") head) jolt-nil)) (shadowed (let* ((and__13__auto hname)) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.analyzer" "local?") env hname) and__13__auto)))) (if (jolt-truthy? (let* ((and__13__auto hname)) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-not shadowed))) (if (jolt-truthy? and__13__auto) (jolt-contains? (var-deref "jolt.analyzer" "handled") hname) and__13__auto)) and__13__auto))) (jolt-invoke (var-deref "jolt.analyzer" "analyze-special") ctx hname items env) (if (jolt-truthy? (let* ((and__13__auto hname)) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-not shadowed))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.analyzer" "method-head?") hname) and__13__auto)) and__13__auto))) (jolt-invoke (var-deref "jolt.analyzer" "analyze-host-call") ctx hname items env) (if (jolt-truthy? (let* ((and__13__auto hname)) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-not shadowed))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.analyzer" "ctor-head?") hname) and__13__auto)) and__13__auto))) (jolt-invoke (var-deref "jolt.analyzer" "analyze-ctor") ctx (jolt-invoke (var-deref "clojure.core" "subs") hname 0 (jolt-dec (jolt-count hname))) (jolt-rest items) env) (if (jolt-truthy? (let* ((and__13__auto (jolt= hname "new"))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-not shadowed))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (>= (jolt-count items) 2))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.host" "form-sym?") (jolt-nth items 1)) and__13__auto)) and__13__auto)) and__13__auto))) (jolt-invoke (var-deref "jolt.analyzer" "analyze-ctor") ctx (jolt-invoke (var-deref "jolt.host" "form-sym-name") (jolt-nth items 1)) (jolt-drop 2 items) env) (if (jolt-truthy? (let* ((and__13__auto (jolt= hname "."))) (if (jolt-truthy? and__13__auto) (jolt-not shadowed) and__13__auto))) (jolt-invoke (var-deref "jolt.analyzer" "analyze-dot") ctx items env) (if (jolt-truthy? (let* ((and__13__auto hname)) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-not shadowed))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.analyzer" "field-head?") hname) and__13__auto)) and__13__auto))) (jolt-invoke (var-deref "jolt.analyzer" "analyze-field") ctx hname items env) (if (jolt-truthy? (let* ((and__13__auto hname)) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-not shadowed))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.host" "form-special?") hname) and__13__auto)) and__13__auto))) (jolt-invoke (var-deref "jolt.analyzer" "uncompilable") (jolt-invoke (var-deref "clojure.core" "str") "special form " hname)) (if (jolt-truthy? (let* ((and__13__auto (jolt-invoke (var-deref "jolt.host" "form-sym?") head))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-not shadowed))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.host" "form-macro?") ctx head) and__13__auto)) and__13__auto))) (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx (jolt-invoke (var-deref "jolt.host" "form-expand-1") ctx form) env) (if (jolt-truthy? (keyword #f "else")) (let* ((n (jolt-invoke (var-deref "jolt.ir" "invoke") (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx head env) (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (p__54_) (let fnrec1655 ((p__54_ p__54_)) (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx p__54_ env))) (jolt-rest items)))) (p (jolt-invoke (var-deref "jolt.host" "form-position") form))) (if (jolt-truthy? p) (jolt-assoc n (keyword #f "pos") p) n)) jolt-nil)))))))))))))))) analyze-list))) (guard (e (#t #f)) - (def-var! "jolt.analyzer" "analyze" (letrec ((analyze (case-lambda ((ctx form) (let fnrec1656 ((ctx ctx) (form form)) (jolt-invoke analyze ctx form (jolt-invoke (var-deref "jolt.analyzer" "empty-env") )))) ((ctx form env) (let fnrec1657 ((ctx ctx) (form form) (env env)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-literal?") form)) (jolt-invoke (var-deref "jolt.ir" "const") form) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-sym?") form)) (jolt-invoke (var-deref "jolt.analyzer" "analyze-symbol") ctx form env) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-vec?") form)) (jolt-invoke (var-deref "jolt.ir" "vector-node") (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (p__55_) (let fnrec1674 ((p__55_ p__55_)) (jolt-invoke analyze ctx p__55_ env))) (jolt-invoke (var-deref "jolt.host" "form-vec-items") form))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-map?") form)) (jolt-invoke (var-deref "jolt.ir" "map-node") (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (p) (let fnrec1671 ((p p)) (let* ((_o$1672 (jolt-invoke analyze ctx (jolt-first p) env)) (_o$1673 (jolt-invoke analyze ctx (jolt-invoke (var-deref "clojure.core" "second") p) env))) (jolt-vector _o$1672 _o$1673)))) (jolt-invoke (var-deref "jolt.host" "form-map-pairs") form))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-set?") form)) (jolt-invoke (var-deref "jolt.ir" "set-node") (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (p__56_) (let fnrec1670 ((p__56_ p__56_)) (jolt-invoke analyze ctx p__56_ env))) (jolt-invoke (var-deref "jolt.host" "form-set-items") form))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-list?") form)) (jolt-invoke (var-deref "jolt.analyzer" "analyze-list") ctx form env) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-regex?") form)) (let* ((_o$1666 (keyword #f "op")) (_o$1667 (keyword #f "regex")) (_o$1668 (keyword #f "source")) (_o$1669 (jolt-invoke (var-deref "jolt.host" "form-regex-source") form))) (jolt-hash-map _o$1666 _o$1667 _o$1668 _o$1669)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-inst?") form)) (let* ((_o$1662 (keyword #f "op")) (_o$1663 (keyword #f "inst")) (_o$1664 (keyword #f "source")) (_o$1665 (jolt-invoke (var-deref "jolt.host" "form-inst-source") form))) (jolt-hash-map _o$1662 _o$1663 _o$1664 _o$1665)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-uuid?") form)) (let* ((_o$1658 (keyword #f "op")) (_o$1659 (keyword #f "uuid")) (_o$1660 (keyword #f "source")) (_o$1661 (jolt-invoke (var-deref "jolt.host" "form-uuid-source") form))) (jolt-hash-map _o$1658 _o$1659 _o$1660 _o$1661)) (if (jolt-truthy? (keyword #f "else")) (jolt-invoke (var-deref "jolt.analyzer" "uncompilable") "unsupported form") jolt-nil))))))))))))))) analyze))) + (def-var! "jolt.analyzer" "analyze" (letrec ((analyze (case-lambda ((ctx form) (let fnrec1656 ((ctx ctx) (form form)) (jolt-invoke analyze ctx form (jolt-invoke (var-deref "jolt.analyzer" "empty-env") )))) ((ctx form env) (let fnrec1657 ((ctx ctx) (form form) (env env)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-literal?") form)) (jolt-invoke (var-deref "jolt.ir" "const") form) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-sym?") form)) (jolt-invoke (var-deref "jolt.analyzer" "analyze-symbol") ctx form env) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-vec?") form)) (jolt-invoke (var-deref "jolt.ir" "vector-node") (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (p__55_) (let fnrec1678 ((p__55_ p__55_)) (jolt-invoke analyze ctx p__55_ env))) (jolt-invoke (var-deref "jolt.host" "form-vec-items") form))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-map?") form)) (jolt-invoke (var-deref "jolt.ir" "map-node") (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (p) (let fnrec1675 ((p p)) (let* ((_o$1676 (jolt-invoke analyze ctx (jolt-first p) env)) (_o$1677 (jolt-invoke analyze ctx (jolt-invoke (var-deref "clojure.core" "second") p) env))) (jolt-vector _o$1676 _o$1677)))) (jolt-invoke (var-deref "jolt.host" "form-map-pairs") form))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-set?") form)) (jolt-invoke (var-deref "jolt.ir" "set-node") (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (p__56_) (let fnrec1674 ((p__56_ p__56_)) (jolt-invoke analyze ctx p__56_ env))) (jolt-invoke (var-deref "jolt.host" "form-set-items") form))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-list?") form)) (jolt-invoke (var-deref "jolt.analyzer" "analyze-list") ctx form env) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-regex?") form)) (let* ((_o$1670 (keyword #f "op")) (_o$1671 (keyword #f "regex")) (_o$1672 (keyword #f "source")) (_o$1673 (jolt-invoke (var-deref "jolt.host" "form-regex-source") form))) (jolt-hash-map _o$1670 _o$1671 _o$1672 _o$1673)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-inst?") form)) (let* ((_o$1666 (keyword #f "op")) (_o$1667 (keyword #f "inst")) (_o$1668 (keyword #f "source")) (_o$1669 (jolt-invoke (var-deref "jolt.host" "form-inst-source") form))) (jolt-hash-map _o$1666 _o$1667 _o$1668 _o$1669)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-uuid?") form)) (let* ((_o$1662 (keyword #f "op")) (_o$1663 (keyword #f "uuid")) (_o$1664 (keyword #f "source")) (_o$1665 (jolt-invoke (var-deref "jolt.host" "form-uuid-source") form))) (jolt-hash-map _o$1662 _o$1663 _o$1664 _o$1665)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-ns-value?") form)) (let* ((_o$1658 (keyword #f "op")) (_o$1659 (keyword #f "the-ns")) (_o$1660 (keyword #f "name")) (_o$1661 (jolt-invoke (var-deref "jolt.host" "form-ns-value-name") form))) (jolt-hash-map _o$1658 _o$1659 _o$1660 _o$1661)) (if (jolt-truthy? (keyword #f "else")) (jolt-invoke (var-deref "jolt.analyzer" "uncompilable") "unsupported form") jolt-nil)))))))))))))))) analyze))) (guard (e (#t #f)) (def-var-with-meta! "jolt.backend-scheme" "native-ops" (let* ((_o$1053 "+") (_o$1054 "+") (_o$1055 "-") (_o$1056 "-") (_o$1057 "*") (_o$1058 "*") (_o$1059 "/") (_o$1060 "/") (_o$1061 "<") (_o$1062 "<") (_o$1063 ">") (_o$1064 ">") (_o$1065 "<=") (_o$1066 "<=") (_o$1067 ">=") (_o$1068 ">=") (_o$1069 "=") (_o$1070 "jolt=") (_o$1071 "inc") (_o$1072 "jolt-inc") (_o$1073 "dec") (_o$1074 "jolt-dec") (_o$1075 "not") (_o$1076 "jolt-not") (_o$1077 "min") (_o$1078 "min") (_o$1079 "max") (_o$1080 "max") (_o$1081 "mod") (_o$1082 "modulo") (_o$1083 "rem") (_o$1084 "remainder") (_o$1085 "quot") (_o$1086 "quotient") (_o$1087 "vector") (_o$1088 "jolt-vector") (_o$1089 "hash-map") (_o$1090 "jolt-hash-map") (_o$1091 "hash-set") (_o$1092 "jolt-hash-set") (_o$1093 "conj") (_o$1094 "jolt-conj") (_o$1095 "get") (_o$1096 "jolt-get") (_o$1097 "nth") (_o$1098 "jolt-nth") (_o$1099 "count") (_o$1100 "jolt-count") (_o$1101 "assoc") (_o$1102 "jolt-assoc") (_o$1103 "dissoc") (_o$1104 "jolt-dissoc") (_o$1105 "contains?") (_o$1106 "jolt-contains?") (_o$1107 "empty?") (_o$1108 "jolt-empty?") (_o$1109 "peek") (_o$1110 "jolt-peek") (_o$1111 "pop") (_o$1112 "jolt-pop") (_o$1113 "first") (_o$1114 "jolt-first") (_o$1115 "rest") (_o$1116 "jolt-rest") (_o$1117 "next") (_o$1118 "jolt-next") (_o$1119 "seq") (_o$1120 "jolt-seq") (_o$1121 "cons") (_o$1122 "jolt-cons") (_o$1123 "list") (_o$1124 "jolt-list") (_o$1125 "reverse") (_o$1126 "jolt-reverse") (_o$1127 "last") (_o$1128 "jolt-last") (_o$1129 "map") (_o$1130 "jolt-map") (_o$1131 "filter") (_o$1132 "jolt-filter") (_o$1133 "remove") (_o$1134 "jolt-remove") (_o$1135 "reduce") (_o$1136 "jolt-reduce") (_o$1137 "into") (_o$1138 "jolt-into") (_o$1139 "concat") (_o$1140 "jolt-concat") (_o$1141 "apply") (_o$1142 "jolt-apply") (_o$1143 "range") (_o$1144 "jolt-range") (_o$1145 "take") (_o$1146 "jolt-take") (_o$1147 "drop") (_o$1148 "jolt-drop") (_o$1149 "keys") (_o$1150 "jolt-keys") (_o$1151 "vals") (_o$1152 "jolt-vals") (_o$1153 "even?") (_o$1154 "jolt-even?") (_o$1155 "odd?") (_o$1156 "jolt-odd?") (_o$1157 "pos?") (_o$1158 "jolt-pos?") (_o$1159 "neg?") (_o$1160 "jolt-neg?") (_o$1161 "zero?") (_o$1162 "jolt-zero?") (_o$1163 "identity") (_o$1164 "jolt-identity") (_o$1165 "ex-info") (_o$1166 "jolt-ex-info")) (jolt-hash-map _o$1053 _o$1054 _o$1055 _o$1056 _o$1057 _o$1058 _o$1059 _o$1060 _o$1061 _o$1062 _o$1063 _o$1064 _o$1065 _o$1066 _o$1067 _o$1068 _o$1069 _o$1070 _o$1071 _o$1072 _o$1073 _o$1074 _o$1075 _o$1076 _o$1077 _o$1078 _o$1079 _o$1080 _o$1081 _o$1082 _o$1083 _o$1084 _o$1085 _o$1086 _o$1087 _o$1088 _o$1089 _o$1090 _o$1091 _o$1092 _o$1093 _o$1094 _o$1095 _o$1096 _o$1097 _o$1098 _o$1099 _o$1100 _o$1101 _o$1102 _o$1103 _o$1104 _o$1105 _o$1106 _o$1107 _o$1108 _o$1109 _o$1110 _o$1111 _o$1112 _o$1113 _o$1114 _o$1115 _o$1116 _o$1117 _o$1118 _o$1119 _o$1120 _o$1121 _o$1122 _o$1123 _o$1124 _o$1125 _o$1126 _o$1127 _o$1128 _o$1129 _o$1130 _o$1131 _o$1132 _o$1133 _o$1134 _o$1135 _o$1136 _o$1137 _o$1138 _o$1139 _o$1140 _o$1141 _o$1142 _o$1143 _o$1144 _o$1145 _o$1146 _o$1147 _o$1148 _o$1149 _o$1150 _o$1151 _o$1152 _o$1153 _o$1154 _o$1155 _o$1156 _o$1157 _o$1158 _o$1159 _o$1160 _o$1161 _o$1162 _o$1163 _o$1164 _o$1165 _o$1166)) (jolt-hash-map (keyword #f "private") #t))) (guard (e (#t #f)) @@ -173,4 +173,4 @@ (guard (e (#t #f)) (def-var! "jolt.backend-scheme" "returns-scheme-bool?" (letrec ((returns-scheme-bool? (lambda (node) (let fnrec1357 ((node node)) (if (jolt-truthy? (let* ((and__13__auto (jolt= (keyword #f "const") (jolt-get node (keyword #f "op"))))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "clojure.core" "boolean?") (jolt-get node (keyword #f "val"))) and__13__auto))) #t (if (jolt= (keyword #f "invoke") (jolt-get node (keyword #f "op"))) (let* ((nop (jolt-invoke (var-deref "jolt.backend-scheme" "native-op") (jolt-get node (keyword #f "fn")) (jolt-count (jolt-get node (keyword #f "args")))))) (if (jolt-truthy? (let* ((and__13__auto nop)) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.backend-scheme" "bool-returning-ops") nop) and__13__auto))) #t #f)) (if (jolt-truthy? (keyword #f "else")) #f jolt-nil))))))) returns-scheme-bool?))) (guard (e (#t #f)) - (def-var! "jolt.backend-scheme" "emit" (letrec ((emit (lambda (node) (let fnrec1358 ((node node)) (let* ((G__35 (jolt-get node (keyword #f "op")))) (if (jolt= G__35 (keyword #f "const")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit-const") (jolt-get node (keyword #f "val"))) (if (jolt= G__35 (keyword #f "local")) (jolt-invoke (var-deref "jolt.backend-scheme" "munge-name") (jolt-get node (keyword #f "name"))) (if (jolt= G__35 (keyword #f "var")) (let* ((core-proc (let* ((and__13__auto (jolt= "clojure.core" (jolt-get node (keyword #f "ns"))))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.backend-scheme" "core-value-procs") (jolt-get node (keyword #f "name"))) and__13__auto)))) (if (jolt-truthy? core-proc) core-proc (if (jolt-truthy? (let* ((and__13__auto (jolt-invoke (var-deref "jolt.backend-scheme" "stdlib-var?") node))) (if (jolt-truthy? and__13__auto) (jolt-not (jolt-invoke (var-deref "clojure.core" "deref") (var-deref "jolt.backend-scheme" "prelude-mode?"))) and__13__auto))) (jolt-throw (jolt-ex-info (jolt-invoke (var-deref "clojure.core" "str") "emit: unsupported stdlib ref `" (jolt-get node (keyword #f "ns")) "/" (jolt-get node (keyword #f "name")) "` (no core on Chez yet)") (jolt-hash-map))) (if (jolt-truthy? (keyword #f "else")) (jolt-invoke (var-deref "clojure.core" "str") "(var-deref " (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "ns"))) " " (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "name"))) ")") jolt-nil)))) (if (jolt= G__35 (keyword #f "the-var")) (jolt-invoke (var-deref "clojure.core" "str") "(jolt-var " (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "ns"))) " " (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "name"))) ")") (if (jolt= G__35 (keyword #f "host")) (jolt-throw (jolt-ex-info (jolt-invoke (var-deref "clojure.core" "str") "emit: unsupported host ref `" (jolt-get node (keyword #f "name")) "`") (jolt-hash-map))) (if (jolt= G__35 (keyword #f "host-static")) (jolt-invoke (var-deref "clojure.core" "str") "(host-static-ref " (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "class"))) " " (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "member"))) ")") (if (jolt= G__35 (keyword #f "host-new")) (jolt-invoke (var-deref "clojure.core" "str") "(host-new " (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "class"))) (let* ((args (jolt-map emit (jolt-get node (keyword #f "args"))))) (if (jolt-empty? args) "" (jolt-invoke (var-deref "clojure.core" "str") " " (jolt-invoke (var-deref "clojure.string" "join") " " args)))) ")") (if (jolt= G__35 (keyword #f "if")) (let* ((test (jolt-get node (keyword #f "test"))) (t (if (jolt-truthy? (jolt-invoke (var-deref "jolt.backend-scheme" "returns-scheme-bool?") test)) (jolt-invoke emit test) (jolt-invoke (var-deref "clojure.core" "str") "(jolt-truthy? " (jolt-invoke emit test) ")")))) (jolt-invoke (var-deref "clojure.core" "str") "(if " t " " (jolt-invoke emit (jolt-get node (keyword #f "then"))) " " (jolt-invoke emit (jolt-get node (keyword #f "else"))) ")")) (if (jolt= G__35 (keyword #f "do")) (jolt-invoke (var-deref "clojure.core" "str") "(begin " (jolt-invoke (var-deref "clojure.string" "join") " " (jolt-map emit (jolt-get node (keyword #f "statements")))) (if (jolt-empty? (jolt-get node (keyword #f "statements"))) "" " ") (jolt-invoke emit (jolt-get node (keyword #f "ret"))) ")") (if (jolt= G__35 (keyword #f "invoke")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit-invoke") node) (if (jolt= G__35 (keyword #f "vector")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit-ordered") "jolt-vector" (jolt-map emit (jolt-get node (keyword #f "items")))) (if (jolt= G__35 (keyword #f "set")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit-ordered") "jolt-hash-set" (jolt-map emit (jolt-get node (keyword #f "items")))) (if (jolt= G__35 (keyword #f "map")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit-ordered") "jolt-hash-map" (jolt-invoke (var-deref "clojure.core" "mapcat") (lambda (p) (let fnrec1359 ((p p)) (let* ((_o$1360 (jolt-invoke emit (jolt-nth p 0))) (_o$1361 (jolt-invoke emit (jolt-nth p 1)))) (jolt-vector _o$1360 _o$1361)))) (jolt-get node (keyword #f "pairs")))) (if (jolt= G__35 (keyword #f "quote")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit-quoted") (jolt-get node (keyword #f "form"))) (if (jolt= G__35 (keyword #f "throw")) (jolt-invoke (var-deref "clojure.core" "str") "(jolt-throw " (jolt-invoke emit (jolt-get node (keyword #f "expr"))) ")") (if (jolt= G__35 (keyword #f "try")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit-try") node) (if (jolt= G__35 (keyword #f "regex")) (jolt-invoke (var-deref "clojure.core" "str") "(jolt-regex " (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "source"))) ")") (if (jolt= G__35 (keyword #f "inst")) (jolt-invoke (var-deref "clojure.core" "str") "(jolt-inst-from-string " (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "source"))) ")") (if (jolt= G__35 (keyword #f "uuid")) (jolt-invoke (var-deref "clojure.core" "str") "(jolt-uuid-from-string " (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "source"))) ")") (if (jolt= G__35 (keyword #f "host-call")) (let* ((m (jolt-get node (keyword #f "method"))) (target (jolt-invoke emit (jolt-get node (keyword #f "target")))) (args (jolt-map emit (jolt-get node (keyword #f "args"))))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.backend-scheme" "supported-host-methods") m)) (jolt-invoke (var-deref "clojure.core" "str") "(jolt-host-call " (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") m) " " target (if (jolt-empty? args) "" (jolt-invoke (var-deref "clojure.core" "str") " " (jolt-invoke (var-deref "clojure.string" "join") " " args))) ")") (jolt-invoke (var-deref "clojure.core" "str") "(record-method-dispatch " target " " (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") m) " (jolt-vector" (if (jolt-empty? args) "" (jolt-invoke (var-deref "clojure.core" "str") " " (jolt-invoke (var-deref "clojure.string" "join") " " args))) "))"))) (if (jolt= G__35 (keyword #f "let")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit-let") node) (if (jolt= G__35 (keyword #f "loop")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit-loop") node) (if (jolt= G__35 (keyword #f "recur")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit-recur") node) (if (jolt= G__35 (keyword #f "fn")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit-fn") node) (if (jolt= G__35 (keyword #f "def")) (if (jolt-truthy? (jolt-get node (keyword #f "no-init"))) (jolt-invoke (var-deref "clojure.core" "str") "(declare-var! " (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "ns"))) " " (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "name"))) ")") (if (jolt-truthy? (jolt-invoke (var-deref "jolt.backend-scheme" "jmeta-nonempty?") (jolt-get node (keyword #f "meta")))) (jolt-invoke (var-deref "clojure.core" "str") "(def-var-with-meta! " (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "ns"))) " " (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "name"))) " " (jolt-invoke emit (jolt-get node (keyword #f "init"))) " " (jolt-invoke (var-deref "jolt.backend-scheme" "emit-quoted") (jolt-get node (keyword #f "meta"))) ")") (if (jolt-truthy? (keyword #f "else")) (jolt-invoke (var-deref "clojure.core" "str") "(def-var! " (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "ns"))) " " (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "name"))) " " (jolt-invoke emit (jolt-get node (keyword #f "init"))) ")") jolt-nil))) (jolt-throw (jolt-ex-info (jolt-invoke (var-deref "clojure.core" "str") "emit: op not yet ported / unhandled: " (jolt-invoke (var-deref "clojure.core" "pr-str") (jolt-get node (keyword #f "op")))) (jolt-hash-map))))))))))))))))))))))))))))))))) emit))) \ No newline at end of file + (def-var! "jolt.backend-scheme" "emit" (letrec ((emit (lambda (node) (let fnrec1358 ((node node)) (let* ((G__35 (jolt-get node (keyword #f "op")))) (if (jolt= G__35 (keyword #f "const")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit-const") (jolt-get node (keyword #f "val"))) (if (jolt= G__35 (keyword #f "local")) (jolt-invoke (var-deref "jolt.backend-scheme" "munge-name") (jolt-get node (keyword #f "name"))) (if (jolt= G__35 (keyword #f "var")) (let* ((core-proc (let* ((and__13__auto (jolt= "clojure.core" (jolt-get node (keyword #f "ns"))))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.backend-scheme" "core-value-procs") (jolt-get node (keyword #f "name"))) and__13__auto)))) (if (jolt-truthy? core-proc) core-proc (if (jolt-truthy? (let* ((and__13__auto (jolt-invoke (var-deref "jolt.backend-scheme" "stdlib-var?") node))) (if (jolt-truthy? and__13__auto) (jolt-not (jolt-invoke (var-deref "clojure.core" "deref") (var-deref "jolt.backend-scheme" "prelude-mode?"))) and__13__auto))) (jolt-throw (jolt-ex-info (jolt-invoke (var-deref "clojure.core" "str") "emit: unsupported stdlib ref `" (jolt-get node (keyword #f "ns")) "/" (jolt-get node (keyword #f "name")) "` (no core on Chez yet)") (jolt-hash-map))) (if (jolt-truthy? (keyword #f "else")) (jolt-invoke (var-deref "clojure.core" "str") "(var-deref " (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "ns"))) " " (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "name"))) ")") jolt-nil)))) (if (jolt= G__35 (keyword #f "the-var")) (jolt-invoke (var-deref "clojure.core" "str") "(jolt-var " (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "ns"))) " " (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "name"))) ")") (if (jolt= G__35 (keyword #f "host")) (jolt-throw (jolt-ex-info (jolt-invoke (var-deref "clojure.core" "str") "emit: unsupported host ref `" (jolt-get node (keyword #f "name")) "`") (jolt-hash-map))) (if (jolt= G__35 (keyword #f "host-static")) (jolt-invoke (var-deref "clojure.core" "str") "(host-static-ref " (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "class"))) " " (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "member"))) ")") (if (jolt= G__35 (keyword #f "host-new")) (jolt-invoke (var-deref "clojure.core" "str") "(host-new " (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "class"))) (let* ((args (jolt-map emit (jolt-get node (keyword #f "args"))))) (if (jolt-empty? args) "" (jolt-invoke (var-deref "clojure.core" "str") " " (jolt-invoke (var-deref "clojure.string" "join") " " args)))) ")") (if (jolt= G__35 (keyword #f "if")) (let* ((test (jolt-get node (keyword #f "test"))) (t (if (jolt-truthy? (jolt-invoke (var-deref "jolt.backend-scheme" "returns-scheme-bool?") test)) (jolt-invoke emit test) (jolt-invoke (var-deref "clojure.core" "str") "(jolt-truthy? " (jolt-invoke emit test) ")")))) (jolt-invoke (var-deref "clojure.core" "str") "(if " t " " (jolt-invoke emit (jolt-get node (keyword #f "then"))) " " (jolt-invoke emit (jolt-get node (keyword #f "else"))) ")")) (if (jolt= G__35 (keyword #f "do")) (jolt-invoke (var-deref "clojure.core" "str") "(begin " (jolt-invoke (var-deref "clojure.string" "join") " " (jolt-map emit (jolt-get node (keyword #f "statements")))) (if (jolt-empty? (jolt-get node (keyword #f "statements"))) "" " ") (jolt-invoke emit (jolt-get node (keyword #f "ret"))) ")") (if (jolt= G__35 (keyword #f "invoke")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit-invoke") node) (if (jolt= G__35 (keyword #f "vector")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit-ordered") "jolt-vector" (jolt-map emit (jolt-get node (keyword #f "items")))) (if (jolt= G__35 (keyword #f "set")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit-ordered") "jolt-hash-set" (jolt-map emit (jolt-get node (keyword #f "items")))) (if (jolt= G__35 (keyword #f "map")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit-ordered") "jolt-hash-map" (jolt-invoke (var-deref "clojure.core" "mapcat") (lambda (p) (let fnrec1359 ((p p)) (let* ((_o$1360 (jolt-invoke emit (jolt-nth p 0))) (_o$1361 (jolt-invoke emit (jolt-nth p 1)))) (jolt-vector _o$1360 _o$1361)))) (jolt-get node (keyword #f "pairs")))) (if (jolt= G__35 (keyword #f "quote")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit-quoted") (jolt-get node (keyword #f "form"))) (if (jolt= G__35 (keyword #f "throw")) (jolt-invoke (var-deref "clojure.core" "str") "(jolt-throw " (jolt-invoke emit (jolt-get node (keyword #f "expr"))) ")") (if (jolt= G__35 (keyword #f "try")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit-try") node) (if (jolt= G__35 (keyword #f "regex")) (jolt-invoke (var-deref "clojure.core" "str") "(jolt-regex " (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "source"))) ")") (if (jolt= G__35 (keyword #f "inst")) (jolt-invoke (var-deref "clojure.core" "str") "(jolt-inst-from-string " (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "source"))) ")") (if (jolt= G__35 (keyword #f "uuid")) (jolt-invoke (var-deref "clojure.core" "str") "(jolt-uuid-from-string " (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "source"))) ")") (if (jolt= G__35 (keyword #f "the-ns")) (jolt-invoke (var-deref "clojure.core" "str") "(intern-ns! " (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "name"))) ")") (if (jolt= G__35 (keyword #f "host-call")) (let* ((m (jolt-get node (keyword #f "method"))) (target (jolt-invoke emit (jolt-get node (keyword #f "target")))) (args (jolt-map emit (jolt-get node (keyword #f "args"))))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.backend-scheme" "supported-host-methods") m)) (jolt-invoke (var-deref "clojure.core" "str") "(jolt-host-call " (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") m) " " target (if (jolt-empty? args) "" (jolt-invoke (var-deref "clojure.core" "str") " " (jolt-invoke (var-deref "clojure.string" "join") " " args))) ")") (jolt-invoke (var-deref "clojure.core" "str") "(record-method-dispatch " target " " (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") m) " (jolt-vector" (if (jolt-empty? args) "" (jolt-invoke (var-deref "clojure.core" "str") " " (jolt-invoke (var-deref "clojure.string" "join") " " args))) "))"))) (if (jolt= G__35 (keyword #f "let")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit-let") node) (if (jolt= G__35 (keyword #f "loop")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit-loop") node) (if (jolt= G__35 (keyword #f "recur")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit-recur") node) (if (jolt= G__35 (keyword #f "fn")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit-fn") node) (if (jolt= G__35 (keyword #f "def")) (if (jolt-truthy? (jolt-get node (keyword #f "no-init"))) (jolt-invoke (var-deref "clojure.core" "str") "(declare-var! " (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "ns"))) " " (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "name"))) ")") (if (jolt-truthy? (jolt-invoke (var-deref "jolt.backend-scheme" "jmeta-nonempty?") (jolt-get node (keyword #f "meta")))) (jolt-invoke (var-deref "clojure.core" "str") "(def-var-with-meta! " (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "ns"))) " " (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "name"))) " " (jolt-invoke emit (jolt-get node (keyword #f "init"))) " " (jolt-invoke (var-deref "jolt.backend-scheme" "emit-quoted") (jolt-get node (keyword #f "meta"))) ")") (if (jolt-truthy? (keyword #f "else")) (jolt-invoke (var-deref "clojure.core" "str") "(def-var! " (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "ns"))) " " (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "name"))) " " (jolt-invoke emit (jolt-get node (keyword #f "init"))) ")") jolt-nil))) (jolt-throw (jolt-ex-info (jolt-invoke (var-deref "clojure.core" "str") "emit: op not yet ported / unhandled: " (jolt-invoke (var-deref "clojure.core" "pr-str") (jolt-get node (keyword #f "op")))) (jolt-hash-map)))))))))))))))))))))))))))))))))) emit))) \ No newline at end of file diff --git a/jolt-core/jolt/analyzer.clj b/jolt-core/jolt/analyzer.clj index 1f582b4..e043255 100644 --- a/jolt-core/jolt/analyzer.clj +++ b/jolt-core/jolt/analyzer.clj @@ -23,6 +23,7 @@ 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 + form-ns-value? form-ns-value-name form-macro? form-expand-1 resolve-global form-sym-meta host-intern! form-syntax-quote-lower record-type? record-ctor-key form-position late-bind?]])) @@ -450,4 +451,7 @@ ;; end emits a runtime inst/uuid value (host/chez/inst-time.ss). (form-inst? form) {:op :inst :source (form-inst-source form)} (form-uuid? form) {:op :uuid :source (form-uuid-source form)} + ;; a live namespace value spliced into a form (~*ns* in a macro) -> a + ;; :the-ns leaf the back end reconstructs by name at the call site. + (form-ns-value? form) {:op :the-ns :name (form-ns-value-name form)} :else (uncompilable "unsupported form")))) diff --git a/jolt-core/jolt/backend_scheme.clj b/jolt-core/jolt/backend_scheme.clj index b9684b5..58cde12 100644 --- a/jolt-core/jolt/backend_scheme.clj +++ b/jolt-core/jolt/backend_scheme.clj @@ -404,6 +404,8 @@ ;; #inst / #uuid literals -> runtime inst / uuid values. :inst (str "(jolt-inst-from-string " (chez-str-lit (:source node)) ")") :uuid (str "(jolt-uuid-from-string " (chez-str-lit (:source node)) ")") + ;; a namespace value spliced into a form (~*ns*) -> reconstruct by name. + :the-ns (str "(intern-ns! " (chez-str-lit (:name node)) ")") ;; (.method target arg*) -> jolt-host-call for an rt-shimmed method, else ;; record-method-dispatch (a reify/record protocol method, jolt-jgoc). :host-call (let [m (:method node)