Clojure-compat fixes enabling external HTTP-client support (#159)

Generic language fixes so a host-shim library (jolt-lang/http-client) can carry
clj-http-lite without baking any HTTP/native code into core:

- reader: accept #^ (deprecated metadata reader macro) as ^
- (str pattern) returns the raw regex source, not #"..." — pattern composition
  via (re-pattern (str p ...)) now works
- into/conj onto a map merges map items (was (into {} [{:a 1}]) -> {nil nil})
- a Var is callable as its current value (e.g. (wrap #'f) threading a var client)
- core-class reads a :class field off a thrown table, so libraries can throw
  typed exceptions whose (class e) is a JVM class name
- compiled catch unwraps the interpreter's :jolt/exception envelope (__unwrap-ex),
  so a typed throw keeps its class/message across the interpret/compile boundary
- slurp accepts a byte-array; io/copy is generic over :jolt/input-stream /
  :jolt/output-stream stream markers
- instance? gains a registry (__register-instance-check!) for library shim types
- new clojure.test namespace (deftest/is/are/testing/use-fixtures/run-tests with
  class-aware thrown?/thrown-with-msg?)

Spec: test/spec/clojure-interop-fixes-spec.janet.

Co-authored-by: Yogthos <yogthos@gmail.com>
This commit is contained in:
Dmitri Sotnikov 2026-06-17 06:42:52 +00:00 committed by GitHub
parent 951a3000e6
commit 3c853429f9
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
11 changed files with 275 additions and 13 deletions

View file

@ -292,12 +292,15 @@
# leaves ctx-current-ns set to that fn's defining ns (it can't restore on # leaves ctx-current-ns set to that fn's defining ns (it can't restore on
# unwind), which then breaks alias resolution in the catching ns. Snapshot # unwind), which then breaks alias resolution in the catching ns. Snapshot
# the ns at try entry, reset it on catch (mirrors the interpreter's try). # the ns at try entry, reset it on catch (mirrors the interpreter's try).
(let [saved (gsym)] (let [saved (gsym) raw (gsym)]
['let [saved (core-fn-call ctx "__current-ns")] ['let [saved (core-fn-call ctx "__current-ns")]
['try (emit ctx (node :body)) ['try (emit ctx (node :body))
[[(symbol (node :catch-sym))] [[raw]
['do (core-fn-call ctx "__set-current-ns!" saved) ['do (core-fn-call ctx "__set-current-ns!" saved)
(emit ctx (node :catch-body))]]]]) # bind the catch symbol to the UNWRAPPED value (mirrors the
# interpreter), so an interpreted throw's envelope doesn't leak here.
['let [(symbol (node :catch-sym)) (core-fn-call ctx "__unwrap-ex" raw)]
(emit ctx (node :catch-body))]]]]])
(emit ctx (node :body)))) (emit ctx (node :body))))
(if (node :finally) (if (node :finally)
['defer (emit ctx (node :finally)) core] ['defer (emit ctx (node :finally)) core]

View file

@ -14,6 +14,11 @@
(defn as-file [x] (if (__file? x) x (__make-file x))) (defn as-file [x] (if (__file? x) x (__make-file x)))
(defn as-url
"Coerce `x` to a java.net.URL value (a :jolt/url). Strings are parsed."
[x]
(if (= :jolt/url (get x :jolt/type)) x (java.net.URL. (str x))))
(defn reader [x] (defn reader [x]
(cond (cond
;; already a reader (java.io shim or janet file handle) — pass through, ;; already a reader (java.io shim or janet file handle) — pass through,
@ -68,7 +73,23 @@
(when-not (janet.os/stat parent) (janet.os/mkdir parent)))))) (when-not (janet.os/stat parent) (janet.os/mkdir parent))))))
(defn copy (defn copy
"Copy from a path/handle `in` to a path/handle `out`." "Copy from `in` to `out`. A value carrying a truthy `:jolt/output-stream`
[in out] marker is treated as a java.io OutputStream (write via its .write); a
`:jolt/input-stream` source is pumped through its .read. This lets host-shim
libraries (e.g. jolt-lang/http-client's byte streams) participate without core
knowing their concrete types. Falls back to the original path/handle copy."
[in out & opts]
(cond
(get out :jolt/output-stream)
(if (get in :jolt/input-stream)
(let [buf (byte-array 8192)]
(loop []
(let [n (.read in buf 0 8192)]
(when (not= -1 n)
(.write out buf 0 n)
(recur)))))
;; in is a byte-array / string
(.write out in))
:else
(let [content (if (string? in) (slurp in) (janet.file/read in :all))] (let [content (if (string? in) (slurp in) (janet.file/read in :all))]
(if (string? out) (spit out content) (janet.file/write out content)))) (if (string? out) (spit out content) (janet.file/write out content)))))

171
src/jolt/clojure/test.clj Normal file
View file

@ -0,0 +1,171 @@
; Jolt Standard Library: clojure.test
;
; A practical subset of clojure.test for running real test suites under Jolt:
; deftest / is / testing / are / use-fixtures / run-tests, with class-aware
; (thrown? Class body) and (thrown-with-msg? Class re body) inside `is`. Class
; matching is by simple-name (last dotted segment), since Jolt has no JVM class
; objects — Exception/Throwable match any thrown value.
;
; Also exposes the counter/registry API the internal clojure-test-suite harness
; uses (reset-report!, run-registered, n-pass/n-fail/n-error, failures), so this
; is a drop-in superset.
(ns clojure.test
(:require [clojure.string :as str]))
;; --- state -----------------------------------------------------------------
(def counters (atom {:test 0 :pass 0 :fail 0 :error 0 :fails []}))
(def jolt-report counters) ;; alias used by the suite harness
(def ctx-stack (atom []))
(def registry (atom [])) ;; [{:name sym :fn thunk}]
(def once-fixtures (atom []))
(def each-fixtures (atom []))
(defn reset-report! []
(reset! counters {:test 0 :pass 0 :fail 0 :error 0 :fails []})
(reset! ctx-stack [])
(reset! registry [])
(reset! once-fixtures [])
(reset! each-fixtures []))
(defn- ctx-str [] (str/join " " @ctx-stack))
(defn inc-pass! [] (swap! counters update :pass inc))
(defn fail! [form]
(let [line (str (ctx-str) (when (seq @ctx-stack) " ") "FAIL: " form)]
(swap! counters (fn [r] (-> r (update :fail inc) (update :fails conj line))))
(println line)))
(defn err! [form]
(let [line (str (ctx-str) (when (seq @ctx-stack) " ") "ERROR: " form)]
(swap! counters (fn [r] (-> r (update :error inc) (update :fails conj line))))
(println line)))
(defn n-pass [] (:pass @counters))
(defn n-fail [] (:fail @counters))
(defn n-error [] (:error @counters))
(defn failures [] (:fails @counters))
;; clojure.test/report multimethod — present so suites that add reporting
;; methods (defmethod clojure.test/report :begin-test-var ...) load. The runner
;; below does its own console output and doesn't dispatch through it.
(defmulti report :type)
(defmethod report :default [_m] nil)
;; --- class matching for thrown? --------------------------------------------
(defn- last-seg [s]
(let [s (str s)
i (str/last-index-of s ".")]
(if i (subs s (inc i)) s)))
(defn class-match?
"True if thrown value `e` matches the wanted class simple-name `wanted`.
Exception/Throwable match anything."
[e wanted]
(let [w (last-seg wanted)]
(if (or (= w "Exception") (= w "Throwable"))
true
(let [c (class e)]
(and (string? c) (= (last-seg c) w))))))
;; --- assertion macros ------------------------------------------------------
(defn- thrown-form? [form sym]
(and (seq? form) (symbol? (first form)) (= sym (name (first form)))))
(defmacro is
([form] `(is ~form nil))
([form msg]
(cond
;; (is (thrown? Class body...))
(thrown-form? form "thrown?")
(let [klass (name (second form))
body (nthrest form 2)]
`(try
~@body
(clojure.test/fail! (str "expected " '~form " to throw" (when ~msg (str " — " ~msg))))
(catch Throwable e#
(if (clojure.test/class-match? e# ~klass)
(clojure.test/inc-pass!)
(clojure.test/fail! (str "expected throw of " ~klass " but got " (clojure.core/class e#)))))))
;; (is (thrown-with-msg? Class re body...))
(thrown-form? form "thrown-with-msg?")
(let [klass (name (second form))
re (nth form 2)
body (nthrest form 3)]
`(try
~@body
(clojure.test/fail! (str "expected " '~form " to throw"))
(catch Throwable e#
(let [m# (or (clojure.core/ex-message e#) (str e#))]
(if (and (clojure.test/class-match? e# ~klass) (re-find ~re m#))
(clojure.test/inc-pass!)
(clojure.test/fail! (str "expected throw of " ~klass " matching " ~re " but got " (clojure.core/class e#) ": " m#)))))))
:else
`(try
(if ~form
(clojure.test/inc-pass!)
(clojure.test/fail! (str (pr-str '~form) (when ~msg (str " — " ~msg)))))
(catch Throwable e#
(clojure.test/err! (str (pr-str '~form) " threw: " (clojure.core/ex-message e#))))))))
(defmacro testing [s & body]
`(do
(swap! clojure.test/ctx-stack conj ~s)
(try
(do ~@body)
(finally (swap! clojure.test/ctx-stack pop)))))
(defmacro deftest [name & body]
`(do
(defn ~name [] ~@body)
(swap! clojure.test/registry conj {:name '~name :fn ~name})
(var ~name)))
(defmacro are [argv expr & data]
(let [n (count argv)
rows (partition n data)]
`(do ~@(map (fn [row]
`(let [~@(interleave argv row)]
(clojure.test/is ~expr)))
rows))))
;; --- fixtures + run --------------------------------------------------------
(defn use-fixtures [kind & fns]
(cond
(= kind :once) (reset! once-fixtures (vec fns))
(= kind :each) (reset! each-fixtures (vec fns))))
(defn- wrap-fixtures [fixtures body-fn]
(if (empty? fixtures)
(body-fn)
((first fixtures) (fn [] (wrap-fixtures (rest fixtures) body-fn)))))
(defn- run-one [t]
(swap! counters update :test inc)
(wrap-fixtures @each-fixtures
(fn []
(try
((:fn t))
(catch Throwable e
(err! (str (:name t) " crashed: " (clojure.core/ex-message e))))))))
(defn run-registered []
(doseq [t @registry] (run-one t))
nil)
(defn run-tests [& _nses]
(wrap-fixtures @once-fixtures (fn [] (run-registered)))
(let [r @counters]
(println)
(println (str "Ran " (:test r) " tests. "
(:pass r) " assertions passed, "
(:fail r) " failures, " (:error r) " errors."))
r))
(defn run-test [& _] nil)
(defn test-var [& _] nil)

View file

@ -205,6 +205,8 @@
(defn jolt-call [f & args] (defn jolt-call [f & args]
(cond (cond
(or (function? f) (cfunction? f)) (apply f args) (or (function? f) (cfunction? f)) (apply f args)
# a var is callable as its current value (Clojure vars implement IFn)
(var? f) (apply jolt-call (var-get f) args)
(shape-rec? f) (core-get f (get args 0) (get args 1)) (shape-rec? f) (core-get f (get args 0) (get args 1))
(keyword? f) (core-get (get args 0) f (get args 1)) (keyword? f) (core-get (get args 0) f (get args 1))
(and (struct? f) (= :symbol (f :jolt/type))) (core-get (get args 0) f (get args 1)) (and (struct? f) (= :symbol (f :jolt/type))) (core-get (get args 0) f (get args 1))
@ -454,12 +456,18 @@
(and (struct? to) (nil? (get to :jolt/type))) (and (struct? to) (nil? (get to :jolt/type)))
(let [acc (array)] (let [acc (array)]
(each e (pairs to) (array/push acc e)) (each e (pairs to) (array/push acc e))
(each item items (array/push acc [(vnth item 0) (vnth item 1)])) # each item is either a [k v] pair OR a map whose entries are merged
# (Clojure: (into {} [{:a 1} {:b 2}]) => {:a 1 :b 2})
(each item items
(if (map-value? item)
(each e (map-entries-of item) (array/push acc e))
(array/push acc [(vnth item 0) (vnth item 1)])))
(bulk-map-from-pairs acc)) (bulk-map-from-pairs acc))
# Other map-likes (sorted maps, deftype records): fold core-assoc. # Other map-likes (sorted maps, deftype records): fold core-conj (handles
# both [k v] pairs and map items).
(or (struct? to) (and (table? to) (get to :jolt/deftype))) (or (struct? to) (and (table? to) (get to :jolt/deftype)))
(do (var result to) (do (var result to)
(each item items (set result (core-assoc result (vnth item 0) (vnth item 1)))) (each item items (set result (core-conj result item)))
result) result)
# Accumulate into a native array and bulk-build the pvec ONCE (pv-from-indexed), # Accumulate into a native array and bulk-build the pvec ONCE (pv-from-indexed),
# instead of an immutable pv-conj per element (each allocating a wrapper + # instead of an immutable pv-conj per element (each allocating a wrapper +

View file

@ -104,6 +104,8 @@
(let [s (src :s) p (src :pos)] (let [s (src :s) p (src :pos)]
(put src :pos (length s)) (put src :pos (length s))
(string/slice s p)) (string/slice s p))
# a byte-array / buffer body: bytes already in hand, just stringify
(buffer? src) (string src)
(string (slurp src)))) (string (slurp src))))
(defn core-spit [path content & opts] (defn core-spit [path content & opts]

View file

@ -182,6 +182,9 @@
(and (struct? v) (= :jolt/inst (v :jolt/type))) (inst->rfc3339 v) (and (struct? v) (= :jolt/inst (v :jolt/type))) (inst->rfc3339 v)
# a java.io.File renders as its path (Clojure's File.toString) # a java.io.File renders as its path (Clojure's File.toString)
(and (table? v) (= :jolt/file (get v :jolt/type))) (get v :path) (and (table? v) (= :jolt/file (get v :jolt/type))) (get v :path)
# (str pattern) -> raw regex source (no #"" delimiters), so libraries that
# compose patterns via (re-pattern (str p1 ...)) work (Pattern.toString).
(and (table? v) (= :jolt/regex (get v :jolt/type))) (get v :source)
(= :jolt/namespace (get v :jolt/type)) (ns-display-name v) (= :jolt/namespace (get v :jolt/type)) (ns-display-name v)
(and (table? v) (= :jolt/var (get v :jolt/type))) (var-display v) (and (table? v) (= :jolt/var (get v :jolt/type))) (var-display v)
(number? v) (fmt-number v) (number? v) (fmt-number v)

View file

@ -124,6 +124,9 @@
# supers now lives in the Clojure collection tier (no class hierarchy: #{}). # supers now lives in the Clojure collection tier (no class hierarchy: #{}).
(defn core-class [x] (defn core-class [x]
(cond (cond
# typed throwables carry their JVM class name (host_net's HTTP/SSL shims):
# (class e) -> "java.net.SocketTimeoutException" so (= ClassSym (class e)) holds
(and (table? x) (get x :class)) (get x :class)
(nil? x) nil (number? x) "java.lang.Number" (string? x) "java.lang.String" (nil? x) nil (number? x) "java.lang.Number" (string? x) "java.lang.String"
(boolean? x) "java.lang.Boolean" (keyword? x) "clojure.lang.Keyword" (boolean? x) "java.lang.Boolean" (keyword? x) "clojure.lang.Keyword"
(function? x) "clojure.lang.IFn" (buffer? x) "[B" (function? x) "clojure.lang.IFn" (buffer? x) "[B"

View file

@ -140,6 +140,9 @@
[ctx f args] [ctx f args]
(cond (cond
(or (function? f) (cfunction? f)) (apply f args) (or (function? f) (cfunction? f)) (apply f args)
# a var is callable as its current value (Clojure vars implement IFn) —
# e.g. (wrap-request #'core/request) threads the var as the base client
(var? f) (jolt-invoke ctx (var-get f) args)
(jolt-transient? f) (transient-lookup f (get args 0) (get args 1)) (jolt-transient? f) (transient-lookup f (get args 0) (get args 1))
# a record shape-rec is callable: IFn impl if it has one, else map-like # a record shape-rec is callable: IFn impl if it has one, else map-like
# field access. A plain (non-record) shape-rec is just field access. # field access. A plain (non-record) shape-rec is just field access.

View file

@ -682,6 +682,12 @@
false))) false)))
# instance?: the overlay macro passes the TYPE NAME quoted (class names don't # instance?: the overlay macro passes the TYPE NAME quoted (class names don't
# evaluate to values on jolt); the value arg arrives evaluated. # evaluate to values on jolt); the value arg arrives evaluated.
# Generic hook so an external host-shim library (e.g. jolt-lang/http-client)
# can teach instance? about its own shim types without editing core. Each hook
# is (fn [class-name val] -> truthy|nil); consulted when no built-in matches.
(var instance-check-hooks @[])
(ns-intern core "__register-instance-check!"
(fn [f] (array/push instance-check-hooks f) nil))
(ns-intern core "instance-check" (ns-intern core "instance-check"
(fn [type-sym val] (fn [type-sym val]
(if (record-tag val) (if (record-tag val)
@ -756,10 +762,21 @@
"clojure.lang.IPersistentVector" (or (tuple? val) (pvec? val)) "clojure.lang.IPersistentVector" (or (tuple? val) (pvec? val))
"clojure.lang.IPersistentSet" (set? val) "clojure.lang.IPersistentSet" (set? val)
"Object" true "Object" true
false)))) # no built-in match — consult library-registered instance? hooks
(do (var r false)
(each h instance-check-hooks
(when (h (type-sym :name) val) (set r true) (break)))
r)))))
# Reader / expansion as plain fns: read-string parses one form; macroexpand-1 # Reader / expansion as plain fns: read-string parses one form; macroexpand-1
# expands a (quoted, already-evaluated) call form once via its macro var. # expands a (quoted, already-evaluated) call form once via its macro var.
(ns-intern core "read-string" (fn [s] (parse-string s))) (ns-intern core "read-string" (fn [s] (parse-string s)))
# Strip the interpreter's {:jolt/type :jolt/exception :value v} throw envelope.
# Compiled catch uses this so a caught value matches what the interpreter binds
# (interpreted throw wraps; compiled throw raises raw) — keeps (class e) /
# ex-message / catch consistent across the compiled⇄interpreted boundary.
(ns-intern core "__unwrap-ex"
(fn [e] (if (and (or (table? e) (struct? e)) (= :jolt/exception (get e :jolt/type)))
(get e :value) e)))
# The *in* reader family's host seams. __stdin-read-line: one line from real # The *in* reader family's host seams. __stdin-read-line: one line from real
# stdin, newline stripped, nil at EOF. __parse-next: one form off a string -> # stdin, newline stripped, nil at EOF. __parse-next: one form off a string ->
# [form rest-of-string], nil when only whitespace remains. *in*, read-line, # [form rest-of-string], nil when only whitespace remains. *in*, read-line,

View file

@ -13,6 +13,7 @@
# Forward declaration for mutual recursion # Forward declaration for mutual recursion
(var read-form nil) (var read-form nil)
(var read-meta nil) # forward decl: read-dispatch (#^) calls it before its defn below
# Source-position tracking for the success checker (jolt-fqy). When enabled, the # Source-position tracking for the success checker (jolt-fqy). When enabled, the
# reader records each LIST form's absolute start offset (lists are the forms that # reader records each LIST form's absolute start offset (lists are the forms that
@ -571,6 +572,7 @@
(= c 95) (let [[_ new-pos] (read-form s (+ pos 2))] # #_ (= c 95) (let [[_ new-pos] (read-form s (+ pos 2))] # #_
[{:jolt/type :jolt/skip} new-pos]) [{:jolt/type :jolt/skip} new-pos])
(= c 39) (read-var-quote s pos) # #' (= c 39) (read-var-quote s pos) # #'
(= c 94) (read-meta s (+ pos 1)) # #^ — deprecated metadata reader macro (= ^)
(= c 34) (read-regex s pos) # #"regex (= c 34) (read-regex s pos) # #"regex
(= c 35) # ## symbolic value: ##Inf ##-Inf ##NaN (= c 35) # ## symbolic value: ##Inf ##-Inf ##NaN
(let [end (read-symbol-name s (+ pos 2) (+ pos 2)) (let [end (read-symbol-name s (+ pos 2) (+ pos 2))
@ -622,7 +624,7 @@
(string? meta-form) {:tag meta-form} (string? meta-form) {:tag meta-form}
nil)) nil))
(defn read-meta [s pos] (set read-meta (fn read-meta [s pos]
# pos is at ^ # pos is at ^
(let [[meta-form new-pos] (read-form s (+ pos 1)) (let [[meta-form new-pos] (read-form s (+ pos 1))
[form new-pos2] (read-form s new-pos) [form new-pos2] (read-form s new-pos)
@ -636,7 +638,7 @@
# Non-symbol targets (collections etc.) keep a runtime with-meta form. Use the # Non-symbol targets (collections etc.) keep a runtime with-meta form. Use the
# NORMALIZED metadata map (:kw -> {:kw true}, tag -> {:tag …}); a map-literal # NORMALIZED metadata map (:kw -> {:kw true}, tag -> {:tag …}); a map-literal
# meta-form (m is nil) is already a map, so pass it through. # meta-form (m is nil) is already a map, so pass it through.
[(array (sym "with-meta") form (if m m meta-form)) new-pos2]))) [(array (sym "with-meta") form (if m m meta-form)) new-pos2]))))
(defn read-until-newline [s pos] (defn read-until-newline [s pos]
(if (or (>= pos (length s)) (= (s pos) 10)) (if (or (>= pos (length s)) (= (s pos) 10))

View file

@ -0,0 +1,29 @@
# Specification: Clojure-compat fixes that landed with HTTP-client support
# (jolt-lang/http-client). All are general language behaviours, exercised here
# across interpret + compile modes by the harness.
(use ../support/harness)
(defspec "interop-fixes / deprecated #^ metadata reader"
["#^ type hint on a param" "\"x\""
"(do (defn f1 [#^String s] s) (f1 \"x\"))"]
["#^\"[B\" array hint" "[1 2]"
"(do (defn f2 [#^\"[B\" b] b) (f2 [1 2]))"]
["#^ is equivalent to ^" "true"
"(= (meta (with-meta [] {:tag (quote String)})) {:tag (quote String)})"])
(defspec "interop-fixes / (str pattern) yields raw source"
["str of a regex" "\"abc\"" "(str #\"abc\")"]
["compose patterns via str" "true"
"(boolean (re-matches (re-pattern (str #\"<\" \"(.*)\" \">\")) \"<hi>\"))"])
(defspec "interop-fixes / into onto a map"
["merges map items" "true" "(= {:a 1 :b 2} (into {} [{:a 1} {:b 2}]))"]
["accepts [k v] pairs" "true" "(= {:a 1} (into {} [[:a 1]]))"]
["map item onto empty {}" "true" "(= {:x 1} (into {} (list {:x 1})))"]
["conj a map onto {}" "true" "(= {:a 1} (conj {} {:a 1}))"])
(defspec "interop-fixes / a var is callable as its value"
["call a var directly" "42"
"(do (def vf (fn [x] (inc x))) ((var vf) 41))"]
["var bound as a client fn" "\"ok\""
"(do (def base (fn [_] \"ok\")) (def mw (fn [client] (fn [req] (client req)))) ((mw (var base)) {}))"])