From 6ab76efd1942627b20619ba3d01f517786b1db12 Mon Sep 17 00:00:00 2001 From: Yogthos Date: Fri, 12 Jun 2026 01:08:09 -0400 Subject: [PATCH] =?UTF-8?q?host:=20enable=20reitit=20=E2=80=94=20runtime?= =?UTF-8?q?=20JOLT=5FFEATURES,=20class-shim=20hooks,=20get-on-strings,=20j?= =?UTF-8?q?ava=20shims?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Everything reitit-core needs to load unmodified from git under :clj features: - The baked binary now re-reads JOLT_FEATURES at startup (like JOLT_PATH). reader-features-set! runs at module load = BUILD time for a binary, so a process opting into :clj (to read a lib's :clj branches) was ignored, and unmatched #?(...) forms silently spliced to nothing — defn of a fn with an empty arglist, hence the cryptic index errors. - (get s i) indexes a string and returns the char, as in Clojure (nth did; get returned nil). reitit's path parser is (get path i)-based — without this every route read as static. - Class-shim registration exposed to Clojure: __register-class-statics! / __register-class-methods! / __register-class-ctor!, so a library can mirror a Java class jolt doesn't ship (the reitit.Trie mirror lives in jolt-lang/ router on top of these). - Java surface reitit's :clj branches call: .getMessage (on exceptions and strings) and a small universal object-method set, .intern, java.util.HashMap (a mutable map wrapper). Plus defprotocol already took keyword options. Gate green; clojure-test-suite 4715 -> 4718 (the get-on-strings fix). --- docs/libraries.md | 4 +++ src/jolt/core.janet | 11 +++++--- src/jolt/evaluator.janet | 42 ++++++++++++++++++++++++++++--- src/jolt/javatime.janet | 22 ++++++++++++++++ src/jolt/main.janet | 7 ++++++ test/spec/host-interop-spec.janet | 13 ++++++++++ test/spec/strings-spec.janet | 9 +++++++ 7 files changed, 101 insertions(+), 7 deletions(-) diff --git a/docs/libraries.md b/docs/libraries.md index 57446da..976697e 100644 --- a/docs/libraries.md +++ b/docs/libraries.md @@ -12,6 +12,10 @@ Libraries confirmed to load and pass their conformance checks on Jolt on the [ring-app example](https://github.com/jolt-lang/examples/tree/main/ring-app)'s spork/http adapter * [ring-codec](https://github.com/ring-clojure/ring-codec) +* [reitit-core](https://github.com/metosin/reitit) — data-driven routing; the + reitit.Trie Java class is mirrored in Clojure by + [jolt-lang/router](https://github.com/jolt-lang/router). Load with + `JOLT_FEATURES` including `clj`. * [honeysql](https://github.com/seancorfield/honeysql) — full formatter + helpers (select/insert/update/delete/joins/:inline), loaded unmodified from git * [clojure.jdbc](https://github.com/yogthos/clojure.jdbc) — as [jolt-lang/db](https://github.com/jolt-lang/db)'s diff --git a/src/jolt/core.janet b/src/jolt/core.janet index 50cf35b..392369b 100644 --- a/src/jolt/core.janet +++ b/src/jolt/core.janet @@ -563,9 +563,14 @@ (if (or (struct? m) (table? m)) (let [v (m k)] (if (nil? v) default v)) - (if (and (or (tuple? m) (array? m)) (number? k) (>= k 0) (< k (length m))) - (in m k) - default))))))))) + (if (and (or (tuple? m) (array? m)) (number? k) (>= k 0) (< k (length m))) + (in m k) + # Clojure's get indexes strings too (returns the char) — reitit's path + # parser relies on (get path i). nth already did; get did not, so + # (get "a:b" 1) was nil. + (if (and (or (string? m) (buffer? m)) (number? k) (>= k 0) (< k (length m))) + (make-char (in m k)) + default)))))))))) # Runtime invoke dispatch for COMPILED code (interpreter uses evaluator's # jolt-invoke). Handles real functions plus Clojure IFn collections. diff --git a/src/jolt/evaluator.janet b/src/jolt/evaluator.janet index ccfeb55..8d7817c 100644 --- a/src/jolt/evaluator.janet +++ b/src/jolt/evaluator.janet @@ -596,12 +596,25 @@ "doubleValue" (fn [n] (* 1.0 n)) "toString" (fn [n &opt radix] (if (= radix 16) (string/format "%x" (math/trunc n)) (string n)))}) +# Universal java.lang.Object / exception / persistent-collection methods that +# reitit's :clj branches call on non-string targets: (.getMessage e), +# (.assoc m k v), (.get m k). Consulted in the method-dispatch fallthrough. +(def- object-methods + {"getMessage" (fn [e] (cond (and (table? e) (= :jolt/ex-info (get e :jolt/type))) (get e :message) + (string? e) e + (string e))) + "getCause" (fn [e] (and (table? e) (get e :cause))) + "toString" (fn [x] (string x)) + "equals" (fn [a b] (deep= a b)) + "hashCode" (fn [x] (hash x))}) + (def- string-methods {"getBytes" (fn [s &opt charset] (buffer s)) "toString" (fn [s] s) "toLowerCase" (fn [s] (string/ascii-lower s)) "toUpperCase" (fn [s] (string/ascii-upper s)) "trim" (fn [s] (string/trim s)) + "intern" (fn [s] s) # file-path surface: io/file returns plain path strings, so the java.io.File # / java.net.URL methods selmer's template cache calls land here "toURI" (fn [s] s) @@ -1294,6 +1307,16 @@ (register-method-impl ctx type-name proto-name method-name f))) (ns-intern core "make-reified" (fn [proto-name methods-map] (make-reified-impl ctx proto-name methods-map))) + # Host-class shim registration, exposed to Clojure so a library can mirror a + # Java class jolt doesn't ship (e.g. reitit.Trie). __register-class-statics! + # makes (Class/method ...) resolve; __register-class-methods! makes (.method + # tagged-value ...) dispatch; __register-class-ctor! makes (Class. ...) build. + (ns-intern core "__register-class-statics!" + (fn [nm tbl] (register-class-statics! nm tbl) nil)) + (ns-intern core "__register-class-methods!" + (fn [tag tbl] (register-tagged-methods! tag tbl) nil)) + (ns-intern core "__register-class-ctor!" + (fn [nm f] (register-class-ctor! nm f) (ns-intern core nm (class-value-for nm)) nil)) (ns-intern core "require" (fn [& specs] (require-impl ctx ;specs))) (ns-intern core "in-ns" (fn [sym] (in-ns-impl ctx sym))) (ns-intern core "use" (fn [& specs] (use-impl ctx ;specs))) @@ -2114,9 +2137,14 @@ (let [m (get string-methods field-name)] (if m (m (string target) ;args) - (error (string "Unsupported String method ." field-name)))) + (if-let [om (get object-methods field-name)] + (om (string target) ;args) + (error (string "Unsupported String method ." field-name))))) (if (and (number? target) (get number-methods field-name)) ((get number-methods field-name) target ;args) + (if (and (get object-methods field-name) + (not (and (table? target) (get tagged-methods (get target :jolt/type))))) + ((get object-methods field-name) target ;args) # registered shim objects (java.time etc.): tag-keyed method tables (if (and (or (table? target) (struct? target)) (get tagged-methods (get target :jolt/type))) @@ -2149,7 +2177,7 @@ (method-fn target ;args) (error (string "Cannot call non-function " field-name " on " (type target))))) (error (string "Cannot call non-function " field-name " on " (type target)))))) - (error (string "Cannot call method " field-name " on " (type target))))))))) + (error (string "Cannot call method " field-name " on " (type target)))))))))) # (. obj member) with no extra args: a symbol member naming a # function is a zero-arg method call (receiver passed as self); # a keyword or `-field` member is plain field access. Strings get @@ -2158,9 +2186,15 @@ (let [m (get string-methods field-name)] (if m (m (string target)) - (error (string "Unsupported String method ." field-name)))) + (if-let [om (get object-methods field-name)] + (om (string target)) + (error (string "Unsupported String method ." field-name))))) (if (and (number? target) (get number-methods field-name)) ((get number-methods field-name) target) + (if (and (get object-methods field-name) + (not (and (table? target) (get tagged-methods (get target :jolt/type)) + (get (get tagged-methods (get target :jolt/type)) field-name)))) + ((get object-methods field-name) target) (if (and (or (table? target) (struct? target)) (get tagged-methods (get target :jolt/type)) (get (get tagged-methods (get target :jolt/type)) field-name)) @@ -2180,7 +2214,7 @@ (array? v) (let [f (eval-form ctx bindings v)] (if (or (function? f) (cfunction? f)) (f target) f)) v) - v))))))) + v)))))))) # default: function application — check for macros (if (and (struct? first-form) (= :symbol (first-form :jolt/type))) (let [sym-name (first-form :name)] diff --git a/src/jolt/javatime.janet b/src/jolt/javatime.janet index 431374c..2848036 100644 --- a/src/jolt/javatime.janet +++ b/src/jolt/javatime.janet @@ -6,6 +6,7 @@ # install call — adding another java.* shim follows the same shape. (use ./evaluator) +(import ./phm) (defn- chr [s] (get s 0)) @@ -383,6 +384,27 @@ :toks (tokenize s (or delims " \t\n\r\f")) :pos 0}))) # clojure.lang.MapEntry: a 2-tuple, jolt's map-entry representation. + # java.util.HashMap: a mutable wrapper over a janet table, keyed by canonical + # key (so jolt collection keys compare by value). reitit uses it as a fast + # read cache: (HashMap. m) copies a map's entries, (.get hm k) reads. + # raw value-keys: reitit's HashMap keys are strings/keywords/tuples, all of + # which janet tables key by value — no canonicalization needed here. + (defn- hm-entries [m] + (cond (phm/phm? m) (phm/phm-entries m) + (struct? m) (pairs m) + (table? m) (pairs m) + @[])) + (register-tagged-methods! :jolt/hashmap + @{"get" (fn [self k] (get (self :tbl) k)) + "put" (fn [self k v] (put (self :tbl) k v) v) + "containsKey" (fn [self k] (not (nil? (get (self :tbl) k)))) + "size" (fn [self] (length (self :tbl)))}) + (each nm ["HashMap" "java.util.HashMap"] + (register-class-ctor! nm + (fn [&opt init] + (def tbl @{}) + (when init (each pair (hm-entries init) (put tbl (in pair 0) (in pair 1)))) + @{:jolt/type :jolt/hashmap :tbl tbl}))) (each nm ["MapEntry" "clojure.lang.MapEntry"] (register-class-ctor! nm (fn [k v] [k v]))) # (String. bytes) / (String. bytes charset): UTF-8 bytes to string. diff --git a/src/jolt/main.janet b/src/jolt/main.janet index 43cb54d..ee71aaa 100644 --- a/src/jolt/main.janet +++ b/src/jolt/main.janet @@ -379,6 +379,13 @@ (when-let [jp (os/getenv "JOLT_PATH")] (each p (string/split ":" jp) (when (> (length p) 0) (array/push (get (ctx :env) :source-paths) p)))) + # JOLT_FEATURES, likewise, must be applied at runtime: reader-features-set! + # runs at module load, which for a baked binary is BUILD time — so a process + # that sets JOLT_FEATURES (e.g. to read a clj-targeted lib's :clj branches) + # would otherwise be ignored, and unmatched #?(...) forms silently splice to + # nothing. Re-read it here so the env wins in the running process. + (when-let [jf (os/getenv "JOLT_FEATURES")] + (reader-features-set! (filter |(> (length $) 0) (string/split "," jf)))) (cond (empty? argv) (run-repl) (help-flags (argv 0)) (print-help) diff --git a/test/spec/host-interop-spec.janet b/test/spec/host-interop-spec.janet index 3181484..8f4bb1b 100644 --- a/test/spec/host-interop-spec.janet +++ b/test/spec/host-interop-spec.janet @@ -199,3 +199,16 @@ "(do (janet.os/setenv \"JOLT_BAKE_ENV_ALLOWLIST\" \"HOME\") (let [e (System/getenv)] (janet.os/setenv \"JOLT_BAKE_ENV_ALLOWLIST\" nil) (and (contains? (set (keys e)) \"HOME\") (= 1 (count (keys e))))))"] ["no allowlist: unfiltered live reads" "true" "(string? (System/getenv \"HOME\"))"]) + +# Host-class shim registration exposed to Clojure (reitit.Trie mirror, etc.): +# statics resolve as (Class/method ...), ctors as (Class. ...), and registered +# tag methods dispatch. Also: .getMessage on an exception/string, HashMap. +(defspec "host-interop / exception + HashMap shims" + ["getMessage on a thrown string" "\"boom\"" + "(try (throw \"boom\") (catch Throwable e (.getMessage e)))"] + ["getMessage on ex-info" "\"bad\"" + "(try (throw (ex-info \"bad\" {})) (catch Throwable e (.getMessage e)))"] + ["HashMap get" "2" + "(let [m (HashMap. {:a 1 :b 2})] (.get m :b))"] + ["HashMap put + size" "2" + "(let [m (HashMap. {})] (.put m :x 1) (.put m :y 2) (.size m))"]) diff --git a/test/spec/strings-spec.janet b/test/spec/strings-spec.janet index 18f247d..b0ae2ad 100644 --- a/test/spec/strings-spec.janet +++ b/test/spec/strings-spec.janet @@ -53,3 +53,12 @@ ["hyphens to underscores" "\"a_b_c\"" "(namespace-munge \"a-b-c\")"] ["from a symbol" "\"foo_bar\"" "(namespace-munge (quote foo-bar))"] ["no hyphens unchanged" "\"ok\"" "(namespace-munge \"ok\")"]) + +# (get s i) indexes a string and returns the char, like Clojure (nth already +# did; get did not — reitit's path parser relies on it). +(defspec "strings / get indexes a string" + ["get returns the char" "true" "(= (get \"a:b\" 1) \\:)"] + ["get first char" "\\a" "(get \"abc\" 0)"] + ["get out of range nil" "nil" "(get \"abc\" 9)"] + ["get negative nil" "nil" "(get \"abc\" -1)"] + ["get default honored" ":none" "(get \"abc\" 9 :none)"])