From 7c26a182e837154bf977e70e7dc3b21c6d8984e1 Mon Sep 17 00:00:00 2001 From: Yogthos Date: Thu, 11 Jun 2026 19:05:50 -0400 Subject: [PATCH] =?UTF-8?q?host:=20ring-core=20enablement=20=E2=80=94=20ja?= =?UTF-8?q?va.net/util=20shims,=20protocol=20dispatch=20gaps,=20IReduceIni?= =?UTF-8?q?t,=20spork/http=20bridge?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The interop surface ring.util.codec needs (registered through the javatime shim registries): URLEncoder/URLDecoder (www-form-urlencoded in pure janet), Charset/forName, Base64 encoder/decoder, Integer/valueOf with radix + parseInt, StringTokenizer, clojure.lang.MapEntry (a 2-tuple), a String ctor from bytes, .getBytes on the String surface, and a java.lang.Number method surface (byteValue and friends). Protocol fixes: extend-protocol on java.util.Map/Set/List now dispatches (maps — phm/struct/sorted/records — never produced host tags and fell to Object), lazy seqs gained their ISeq tags, and a nil extension arm works (group-by-head and extend-type both choked on the nil head). reduce dispatches to a reified clojure.lang.IReduceInit's own reduce method, which is how ring-codec tokenizes. jolt-deps learns :deps/root (tools.deps monorepo subdirectory checkouts — ring-core lives inside ring-clojure/ring). spork/http, when jpm-installed, reaches the jolt layer as janet.spork.http/* through the janet.* bridge (soft: nothing requires it unless used). The protocol fixes alone let 29 more clojure-test-suite assertions execute: 5319 -> 5348 run, 4706 -> 4715 pass. --- jolt-core/clojure/core/30-macros.clj | 8 +- src/jolt/core.janet | 8 +- src/jolt/deps.janet | 7 +- src/jolt/evaluator.janet | 50 +++++++++-- src/jolt/javatime.janet | 125 +++++++++++++++++++++++++++ test/spec/host-interop-spec.janet | 23 +++++ 6 files changed, 211 insertions(+), 10 deletions(-) diff --git a/jolt-core/clojure/core/30-macros.clj b/jolt-core/clojure/core/30-macros.clj index 2fd1be6..84de98c 100644 --- a/jolt-core/clojure/core/30-macros.clj +++ b/jolt-core/clojure/core/30-macros.clj @@ -252,8 +252,9 @@ ;; Group a flat seq that starts with a head symbol followed by its list specs ;; into [[head spec spec ...] ...] runs. Used by extend-protocol and defrecord. (defn- group-by-head [items] + ;; nil is a valid extension head (extend-protocol P ... nil (m [x] ...)). (reduce (fn [acc x] - (if (symbol? x) + (if (or (symbol? x) (nil? x)) (conj acc [x]) (conj (pop acc) (conj (peek acc) x)))) [] items)) @@ -347,9 +348,10 @@ (defmacro extend-type [tsym psym & impls] ;; register-method is a fn (clojure.core); pass type/protocol/method NAMES as - ;; strings (not the symbols) so the call compiles as a plain invoke. + ;; strings (not the symbols) so the call compiles as a plain invoke. A nil + ;; type extends on nil values (the host tag is the string "nil"). `(do ~@(map (fn [spec] - `(register-method ~(name tsym) ~(name psym) ~(name (first spec)) + `(register-method ~(if (nil? tsym) "nil" (name tsym)) ~(name psym) ~(name (first spec)) (fn* ~(nth spec 1) ~@(drop 2 spec)))) impls))) diff --git a/src/jolt/core.janet b/src/jolt/core.janet index 571bd98..a9d8e36 100644 --- a/src/jolt/core.janet +++ b/src/jolt/core.janet @@ -1108,7 +1108,13 @@ (if (= 0 (length c)) (f) (reduce-with-reduced f (in c 0) (array/slice c 1)))))) 3 (let [f (args 0) val (args 1) coll (args 2)] - (reduce-with-reduced f val coll)) + # reify clojure.lang.IReduceInit: the reified value carries its own + # reduce — call it (ring.util.codec's tokenizer reduces this way) + (if-let [m (and (table? coll) + (get coll :jolt/protocol-methods) + (get (get coll :jolt/protocol-methods) :reduce))] + (m coll f val) + (reduce-with-reduced f val coll))) (error "Wrong number of args passed to: reduce")))) (defn core-take [n & rest] diff --git a/src/jolt/deps.janet b/src/jolt/deps.janet index 23ffaba..80bb790 100644 --- a/src/jolt/deps.janet +++ b/src/jolt/deps.janet @@ -177,7 +177,12 @@ (put seen k spec) (def dir (cond - (and (dictionary? spec) (get spec :git/url)) (clone-git spec) + (and (dictionary? spec) (get spec :git/url)) + # :deps/root (tools.deps): the project lives in a subdirectory + # of the repo — monorepos like ring-clojure/ring. + (let [cloned (clone-git spec) + root (get spec :deps/root)] + (if root (string cloned "/" root) cloned)) (and (dictionary? spec) (get spec :local/root)) (let [lr (get spec :local/root)] (if (string/has-prefix? "/" lr) lr (string base-dir "/" lr))) diff --git a/src/jolt/evaluator.janet b/src/jolt/evaluator.janet index 4379ba4..b4c6af0 100644 --- a/src/jolt/evaluator.janet +++ b/src/jolt/evaluator.janet @@ -13,6 +13,18 @@ # the janet/* interop bridge falls back to it inside env-less fibers. (def- module-load-env (fiber/getenv (fiber/current))) +# spork/http (pure-janet, jpm-installed) reaches the jolt layer as +# janet.spork.http/* through the janet.* bridge below — the Ring adapter +# (examples/ring-app) builds its server on it. SOFT: jolt works without +# spork; only code touching janet.spork.http/* needs it installed. +(let [r (protect (require "spork/http"))] + (when (r 0) + (eachp [sym entry] (r 1) + (when (and (symbol? sym) (table? entry)) + # root-env: the bridge resolves against the RUNTIME fiber env (which + # protos to the root env), not this module's env + (put root-env (symbol "spork.http/" sym) entry))))) + (defn- sym-name? [sym-s name-str] (and (struct? sym-s) (= :symbol (sym-s :jolt/type)) (= name-str (sym-s :name)))) @@ -510,8 +522,19 @@ (if (and (struct? x) (= :jolt/char (get x :jolt/type))) (string/from-bytes (x :ch)) (string x))) +# java.lang.Number surface (ring-codec: (.byteValue (Integer/valueOf s 16))). +(def- number-methods + {"byteValue" (fn [n] (let [b (band (math/trunc n) 0xff)] (if (> b 127) (- b 256) b))) + "shortValue" (fn [n] (let [v (band (math/trunc n) 0xffff)] (if (> v 32767) (- v 65536) v))) + "intValue" (fn [n] (math/trunc n)) + "longValue" (fn [n] (math/trunc n)) + "floatValue" (fn [n] (* 1.0 n)) + "doubleValue" (fn [n] (* 1.0 n)) + "toString" (fn [n &opt radix] (if (= radix 16) (string/format "%x" (math/trunc n)) (string n)))}) + (def- string-methods - {"toString" (fn [s] s) + {"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)) @@ -846,7 +869,10 @@ "Keyword" true "Symbol" true "Object" true "IFn" true "Fn" true "PersistentVector" true "PersistentList" true "PersistentHashMap" true "PersistentHashSet" true "IPersistentMap" true "IPersistentVector" true - "IPersistentSet" true "IPersistentCollection" true "ISeq" true "Atom" true "nil" true}) + "IPersistentSet" true "IPersistentCollection" true "ISeq" true "Atom" true "nil" true + # java.util interfaces + seq types ring & friends extend on + "Map" true "Set" true "List" true "Collection" true "LazySeq" true + "APersistentMap" true}) (defn- canonical-host-tag "If type-name names a host type (optionally java.*/clojure.lang.* qualified), @@ -869,7 +895,17 @@ (keyword? obj) ["Keyword" "Object"] (and (struct? obj) (= :jolt/char (get obj :jolt/type))) ["Character" "Object"] (and (struct? obj) (= :symbol (get obj :jolt/type))) ["Symbol" "Object"] - (plist? obj) ["PersistentList" "IPersistentList" "IPersistentCollection" "ISeq" "Object"] + (plist? obj) ["PersistentList" "IPersistentList" "IPersistentCollection" "ISeq" "List" "Collection" "Object"] + (lazy-seq? obj) ["LazySeq" "ISeq" "IPersistentCollection" "Collection" "Object"] + # maps: phm / plain struct / sorted / records — java.util.Map covers them + # all in ring-style extend-protocol clauses + (or (phm? obj) + (and (struct? obj) (nil? (get obj :jolt/type))) + (and (table? obj) (or (get obj :jolt/deftype) + (= :jolt/sorted-map (get obj :jolt/type))))) + ["PersistentHashMap" "APersistentMap" "IPersistentMap" "Map" "IPersistentCollection" "Object"] + (or (set? obj) (and (table? obj) (= :jolt/sorted-set (get obj :jolt/type)))) + ["PersistentHashSet" "IPersistentSet" "Set" "IPersistentCollection" "Object"] (or (tuple? obj) (array? obj) (pvec? obj)) ["PersistentVector" "IPersistentVector" "IPersistentCollection" "ISeq" "Object"] (or (function? obj) (cfunction? obj)) ["IFn" "Fn" "Object"] (nil? obj) ["nil" "Object"] @@ -1996,6 +2032,8 @@ (if m (m (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) # registered shim objects (java.time etc.): tag-keyed method tables (if (and (or (table? target) (struct? target)) (get tagged-methods (get target :jolt/type))) @@ -2028,7 +2066,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 @@ -2038,6 +2076,8 @@ (if m (m (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 (or (table? target) (struct? target)) (get tagged-methods (get target :jolt/type)) (get (get tagged-methods (get target :jolt/type)) field-name)) @@ -2057,7 +2097,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 d386cfa..431374c 100644 --- a/src/jolt/javatime.janet +++ b/src/jolt/javatime.janet @@ -263,6 +263,131 @@ (register-class-ctor! nm string-builder)) (each nm ["StringWriter" "java.io.StringWriter"] (register-class-ctor! nm make-string-writer)) + # --- java.net / java.util surface for ring-codec (ring-core enablement) --- + # URLEncoder/URLDecoder: www-form-urlencoded (space <-> +, %XX bytes, + # [A-Za-z0-9.*_-] literal). Charset args are accepted and ignored beyond + # the name (everything is UTF-8 bytes here). + (defn- url-unreserved? [b] + (or (and (>= b 48) (<= b 57)) (and (>= b 65) (<= b 90)) + (and (>= b 97) (<= b 122)) (= b 46) (= b 42) (= b 95) (= b 45))) + (defn- url-encode-www [s & _] + (def out @"") + (each b (string/bytes (string s)) + (cond + (url-unreserved? b) (buffer/push-byte out b) + (= b 32) (buffer/push-string out "+") + (buffer/push-string out (string/format "%%%02X" b)))) + (string out)) + (defn- hexv [b] + (cond (and (>= b 48) (<= b 57)) (- b 48) + (and (>= b 65) (<= b 70)) (- b 55) + (and (>= b 97) (<= b 102)) (- b 87) + (error "URLDecoder: malformed escape"))) + (defn- url-decode-www [s & _] + (def bytes (string/bytes (string s))) + (def n (length bytes)) + (def out @"") + (var i 0) + (while (< i n) + (def b (in bytes i)) + (cond + (= b 43) (do (buffer/push-string out " ") (++ i)) + (= b 37) (if (< (+ i 2) n) + (do (buffer/push-byte out (+ (* 16 (hexv (in bytes (+ i 1)))) (hexv (in bytes (+ i 2))))) + (+= i 3)) + (error "URLDecoder: incomplete escape")) + (do (buffer/push-byte out b) (++ i)))) + (string out)) + (each nm ["URLEncoder" "java.net.URLEncoder"] + (register-class-statics! nm @{"encode" url-encode-www})) + (each nm ["URLDecoder" "java.net.URLDecoder"] + (register-class-statics! nm @{"decode" url-decode-www})) + (each nm ["Charset" "java.nio.charset.Charset"] + (register-class-statics! nm @{"forName" (fn [nm*] @{:jolt/type :jolt/charset :name nm*})})) + # Base64 (RFC 4648): encoder/decoder singletons with encode/decode methods. + (def- b64-alphabet "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/") + (defn- b64-encode [bs] + (def bytes (if (bytes? bs) bs (string bs))) + (def n (length bytes)) + (def out @"") + (var i 0) + (while (< i n) + (def b0 (in bytes i)) + (def b1 (if (< (+ i 1) n) (in bytes (+ i 1)))) + (def b2 (if (< (+ i 2) n) (in bytes (+ i 2)))) + (buffer/push-byte out (in b64-alphabet (brshift b0 2))) + (buffer/push-byte out (in b64-alphabet (bor (blshift (band b0 3) 4) (brshift (or b1 0) 4)))) + (buffer/push-string out (if (nil? b1) "=" (string/from-bytes (in b64-alphabet (bor (blshift (band b1 0xf) 2) (brshift (or b2 0) 6)))))) + (buffer/push-string out (if (nil? b2) "=" (string/from-bytes (in b64-alphabet (band b2 0x3f))))) + (+= i 3)) + (string out)) + (def- b64-rev (do (def t @{}) (eachp [i c] b64-alphabet (put t c i)) t)) + (defn- b64-decode [s] + (def cleaned (string/replace-all "=" "" (string s))) + (def out @"") + (var acc 0) (var bits 0) + (each c (string/bytes cleaned) + (def v (get b64-rev c)) + (when (nil? v) (error "Base64: illegal character")) + (set acc (bor (blshift acc 6) v)) + (+= bits 6) + (when (>= bits 8) + (-= bits 8) + (buffer/push-byte out (band (brshift acc bits) 0xff)))) + out) + (register-tagged-methods! :jolt/base64-encoder @{"encode" (fn [self bs] (b64-encode bs)) "encodeToString" (fn [self bs] (b64-encode bs))}) + (register-tagged-methods! :jolt/base64-decoder @{"decode" (fn [self s] (b64-decode s))}) + (each nm ["Base64" "java.util.Base64"] + (register-class-statics! nm + @{"getEncoder" (fn [] @{:jolt/type :jolt/base64-encoder}) + "getDecoder" (fn [] @{:jolt/type :jolt/base64-decoder})})) + # Integer statics: valueOf with optional radix. Returns a plain number — + # byteValue/intValue live on the number method surface in the evaluator. + (register-class-statics! "Integer" + @{"valueOf" (fn [x &opt radix] + (cond + (number? x) x + (nil? radix) (or (scan-number (string x)) (error (string "NumberFormatException: " x))) + (= radix 16) (or (scan-number (string "16r" x)) (error (string "NumberFormatException: " x))) + (= radix 8) (or (scan-number (string "8r" x)) (error (string "NumberFormatException: " x))) + (= radix 2) (or (scan-number (string "2r" x)) (error (string "NumberFormatException: " x))) + (error (string "Integer/valueOf: unsupported radix " radix)))) + "parseInt" (fn [x &opt radix] + (or (scan-number (string (case radix 16 "16r" 8 "8r" 2 "2r" "") x)) + (error (string "NumberFormatException: " x)))) + "MAX_VALUE" 2147483647 + "MIN_VALUE" -2147483648}) + # StringTokenizer: eager split on any delimiter char, empty tokens skipped. + (defn- tokenize [s delims] + (def dset @{}) + (each b (string/bytes delims) (put dset b true)) + (def toks @[]) + (def cur @"") + (each b (string/bytes (string s)) + (if (get dset b) + (when (> (length cur) 0) (array/push toks (string cur)) (buffer/clear cur)) + (buffer/push-byte cur b))) + (when (> (length cur) 0) (array/push toks (string cur))) + toks) + (register-tagged-methods! :jolt/string-tokenizer + @{"hasMoreTokens" (fn [self] (< (self :pos) (length (self :toks)))) + "countTokens" (fn [self] (- (length (self :toks)) (self :pos))) + "nextToken" (fn [self] + (if (< (self :pos) (length (self :toks))) + (let [t (in (self :toks) (self :pos))] + (put self :pos (+ 1 (self :pos))) t) + (error "NoSuchElementException")))}) + (each nm ["StringTokenizer" "java.util.StringTokenizer"] + (register-class-ctor! nm (fn [s &opt delims] + @{:jolt/type :jolt/string-tokenizer + :toks (tokenize s (or delims " \t\n\r\f")) + :pos 0}))) + # clojure.lang.MapEntry: a 2-tuple, jolt's map-entry representation. + (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. + (each nm ["String" "java.lang.String"] + (register-class-ctor! nm (fn [x &opt charset] (string x)))) # java.net.URL: enough for selmer's template cache — file: URLs only. # A protocol-less spec throws (selmer catches MalformedURLException and # prepends file:///), and getPath hands back a stat-able filesystem path. diff --git a/test/spec/host-interop-spec.janet b/test/spec/host-interop-spec.janet index 5397ef7..952bd64 100644 --- a/test/spec/host-interop-spec.janet +++ b/test/spec/host-interop-spec.janet @@ -140,3 +140,26 @@ "(string? (get (into {} (map (fn [[k v]] [k v]) (System/getenv))) \"HOME\"))"] ["System/getProperties" "true" "(string? (get (System/getProperties) \"os.name\"))"]) + +# ring-core enablement (host shims + protocol/reduce fixes): the java.net / +# java.util surface ring.util.codec needs, extend-protocol on Map and nil, +# and reduce over a reified clojure.lang.IReduceInit. +(defspec "host-interop / ring-codec surface" + ["URLEncoder www form" "\"a+b%3Dc\"" "(URLEncoder/encode \"a b=c\")"] + ["URLDecoder www form" "\"a b=c\"" "(URLDecoder/decode \"a+b%3Dc\" (Charset/forName \"UTF-8\"))"] + ["url round trip" "\"x &=%?\"" "(URLDecoder/decode (URLEncoder/encode \"x &=%?\"))"] + ["Base64 encode" "\"aGVsbG8=\"" "(String. (.encode (Base64/getEncoder) (.getBytes \"hello\")))"] + ["Base64 round trip" "\"hello\"" "(String. (.decode (Base64/getDecoder) (String. (.encode (Base64/getEncoder) (.getBytes \"hello\")))))"] + ["Integer radix + byteValue" "-1" "(.byteValue (Integer/valueOf \"ff\" 16))"] + ["Integer parseInt" "255" "(Integer/parseInt \"ff\" 16)"] + ["StringTokenizer" "[\"a=1\" \"b=2\"]" "(let [t (StringTokenizer. \"a=1&b=2\" \"&\")] [(.nextToken t) (.nextToken t)])"] + ["MapEntry key/val" "[:a 1]" "(let [e (MapEntry. :a 1)] [(key e) (val e)])"] + ["String ctor from bytes" "\"hi\"" "(String. (.getBytes \"hi\"))"] + ["extend-protocol Map" ":map" + "(do (defprotocol Pe (pe [x])) (extend-protocol Pe Map (pe [m] :map) Object (pe [o] :obj)) (pe {:a 1}))"] + ["extend-protocol nil" ":nil" + "(do (defprotocol Pn (pn [x])) (extend-protocol Pn nil (pn [n] :nil) Object (pn [o] :obj)) (pn nil))"] + ["extend-protocol Map covers sorted" ":map" + "(do (defprotocol Ps (ps [x])) (extend-protocol Ps Map (ps [m] :map) Object (ps [o] :obj)) (ps (sorted-map 1 2)))"] + ["reduce over reified IReduceInit" "42" + "(reduce + 0 (reify clojure.lang.IReduceInit (reduce [_ f init] (f (f init 40) 2))))"])