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

host: ring-core enablement — java.net/util shims, protocol dispatch gaps, IReduceInit, spork/http bridge

Browse source 
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.
This commit is contained in:
Yogthos 2026-06-11 19:05:50 -04:00
parent 58f9a5e596
commit 7c26a182e8
6 changed files with 211 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

8
jolt-core/clojure/core/30-macros.clj
View file

@ -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)))

8
src/jolt/core.janet
View file

@ -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]

7
src/jolt/deps.janet
View file

@ -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)))

50
src/jolt/evaluator.janet
View file

@ -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)]

125
src/jolt/javatime.janet
View file

@ -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.

23
test/spec/host-interop-spec.janet
View file

@ -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))))"])