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/clojure/template.clj b/src/jolt/clojure/template.clj new file mode 100644 index 0000000..b3d4510 --- /dev/null +++ b/src/jolt/clojure/template.clj @@ -0,0 +1,33 @@ +;; Verbatim from clojure.template (Stuart Sierra) — pure Clojure over +;; clojure.walk, which jolt ships. Added so honeysql's :clj branch (which +;; requires clojure.template) loads under JOLT_FEATURES including clj. +(ns clojure.template + "Macros that expand to repeated copies of a template expression." + (:require [clojure.walk :as walk])) + +(defn apply-template + "For use in macros. argv is an argument list, as in defn. expr is + a quoted expression using the symbols in argv. values is a sequence + of values to be used for the arguments. + + apply-template will recursively replace argument symbols in expr + with their corresponding values, returning a modified expr. + + Example: (apply-template '[x] '(+ x x) '[2]) + ;=> (+ 2 2)" + [argv expr values] + (assert (vector? argv)) + (assert (every? symbol? argv)) + (walk/postwalk-replace (zipmap argv values) expr)) + +(defmacro do-template + "Repeatedly copies expr (in a do block) for each group of arguments + in values. values are automatically partitioned by the number of + arguments in argv, an argument vector as in defn. + + Example: (macroexpand '(do-template [x y] (+ y x) 2 4 3 5)) + ;=> (do (+ 4 2) (+ 5 3))" + [argv expr & values] + (let [c (count argv)] + `(do ~@(map (fn [a] (apply-template argv expr a)) + (partition c values))))) 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..3e70f85 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,30 @@ (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. + # Reader-conditional feature toggle, exposed to Clojure so a namespace can + # load a clj-targeted library (e.g. reitit, under :clj) WITHOUT forcing the + # whole process to :clj — set features, require the lib, restore. Returns the + # previous feature set (a list of name strings) for restoration. + (ns-intern core "__reader-features" + (fn [] (tuple ;(map (fn [k] (string k)) (keys reader-features))))) + (ns-intern core "__reader-features-set!" + (fn [names] + # names arrives as a jolt vector (pvec) or list — coerce to a janet array + (def arr (cond (pvec? names) (pv->array names) + (or (tuple? names) (array? names)) names + @[names])) + (reader-features-set! (map (fn [n] (if (keyword? n) n (string n))) arr)) + nil)) + (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 +2151,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 +2191,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 +2200,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 +2228,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..20f652f 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)) @@ -128,10 +129,12 @@ (register-class-statics! "LocalDateTime" @{"ofInstant" (fn [inst zone] (local-dt (ms-of inst))) "now" (fn [] (local-dt (math/floor (* 1000 (os/clock :realtime)))))}) - (register-class-statics! "Locale" - @{"getDefault" (fn [] @{:jolt/type :jolt/locale :id "default"}) - "ENGLISH" @{:jolt/type :jolt/locale :id "en"} - "US" @{:jolt/type :jolt/locale :id "en-US"}}) + (let [locale-statics @{"getDefault" (fn [] @{:jolt/type :jolt/locale :id "default"}) + "ENGLISH" @{:jolt/type :jolt/locale :id "en"} + "US" @{:jolt/type :jolt/locale :id "en-US"} + "ROOT" @{:jolt/type :jolt/locale :id "root"}}] + (each nm ["Locale" "java.util.Locale"] + (register-class-statics! nm locale-statics))) (register-tagged-methods! :jolt/instant @{"atZone" (fn [self zone] (zoned (self :ms) zone)) "toEpochMilli" (fn [self] (self :ms))}) @@ -383,6 +386,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..a0386c8 100644 --- a/test/spec/host-interop-spec.janet +++ b/test/spec/host-interop-spec.janet @@ -199,3 +199,27 @@ "(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))"]) + +# Reader-feature toggle exposed to Clojure (scoped clj-lib loading): a +# namespace can load a clj-targeted library under :clj without forcing the +# whole process — set features, require, restore. +(defspec "host-interop / reader-feature toggle" + ["features default to jolt+default" "true" + "(contains? (set (__reader-features)) \"jolt\")"] + ["set + read back" "true" + "(do (def prev (__reader-features)) (__reader-features-set! [\"clj\" \"jolt\" \"default\"]) (def r (contains? (set (__reader-features)) \"clj\")) (__reader-features-set! prev) r)"] + ["restore returns to default" "false" + "(do (def prev (__reader-features)) (__reader-features-set! [\"clj\"]) (__reader-features-set! prev) (contains? (set (__reader-features)) \"clj\"))"]) 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)"])