Merge pull request #67 from jolt-lang/java-time-shims

java.time + java.io shims: Selmer renders end to end
This commit is contained in:
Dmitri Sotnikov 2026-06-10 22:38:08 -04:00 committed by GitHub
commit f50fdad0ee
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
9 changed files with 548 additions and 29 deletions

View file

@ -52,8 +52,12 @@
;; instance?: class names don't evaluate to values on jolt, so the type arg is
;; passed quoted to the ctx-capturing checker; the value evaluates normally.
;; A LIST in type position is a class-valued expression (e.g. Selmer's
;; (Class/forName "[C")) — evaluate it instead.
(defmacro instance? [t x]
`(instance-check (quote ~t) ~x))
(if (seq? t)
`(instance-check ~t ~x)
`(instance-check (quote ~t) ~x)))
;; Single-threaded host: evaluate the monitor expr (for its effects, matching
;; Clojure's evaluation order) and the body — no lock to take.

View file

@ -12,6 +12,7 @@
(import ./backend :as backend)
(import ./stdlib_embed :as stdlib-embed)
(import ./host_iface :as host)
(import ./javatime) # java.time shims register into the evaluator at load
# A defmacro expander compiles to a native fn (built as (fn args body...) and run
# through the self-hosted pipeline) so macro expansion is COMPILED code, zero runtime

View file

@ -12,16 +12,36 @@
(defn as-file [x] (str x))
(defn reader [x] (janet.file/open (str x) :r))
(defn reader [x]
(cond
;; already a reader (java.io shim or janet file handle) — pass through,
;; like the JVM's io/reader on a Reader
(= :jolt/jio-string-reader (get x :jolt/type)) x
(= :jolt/url (get x :jolt/type)) (java.io.StringReader. (janet/slurp (.getPath x)))
(= :core/file (janet/type x)) x
(sequential? x) (java.io.StringReader. (apply str x)) ; char[] → in-memory reader
;; a path: an in-memory reader over the file's content — gives the
;; java.io.Reader surface (.read/.mark/.reset) plus line-seq's
;; :read-line-fn, which a raw janet file handle has neither of
:else (java.io.StringReader. (janet/slurp (str x)))))
(defn writer [x] (janet.file/open (str x) :w))
(defn input-stream [x] (reader x))
(defn output-stream [x] (writer x))
(defn resource
"Returns a slurp-able path for `path` if it exists, else nil. (Clojure returns
a URL; a path works the same with slurp here, since there's no classpath.)"
"Returns a slurp-able path for `path` if it exists, else nil. (Clojure
returns a classpath URL; here the loader's source roots play the classpath
role the bare path is tried first, then path under each root.)"
[path]
(let [p (str path)] (when (janet.os/stat p) p)))
(let [p (str path)]
(if (janet.os/stat p)
p
(loop [roots (seq (__source-roots))]
(when roots
(let [cand (str (first roots) "/" p)]
(if (janet.os/stat cand)
cand
(recur (next roots)))))))))
(defn delete-file
([f] (delete-file f false))

View file

@ -1888,7 +1888,13 @@
(defn core-short-array [a & rest] (make-num-array a rest 0))
(defn core-double-array [a & rest] (make-num-array a rest 0))
(defn core-float-array [a & rest] (make-num-array a rest 0))
(defn core-char-array [a & rest] (make-num-array a rest (make-char 0)))
(defn core-char-array [a & rest]
# JVM char-array also accepts a STRING/char-seq (char[] of its characters) —
# selmer's parse-str does (char-array template).
(cond
(string? a) (map make-char (string/bytes a))
(buffer? a) (map make-char (string/bytes (string a)))
(make-num-array a rest (make-char 0))))
(defn core-boolean-array [a & rest] (make-num-array a rest false))
# Byte arrays — Janet buffers (each element a 0..255 byte).

View file

@ -9,6 +9,10 @@
(use ./reader)
(use ./regex)
# The env this module was loaded under — proto-chains to the Janet root env;
# the janet/* interop bridge falls back to it inside env-less fibers.
(def- module-load-env (fiber/getenv (fiber/current)))
(defn- sym-name?
[sym-s name-str]
(and (struct? sym-s) (= :symbol (sym-s :jolt/type)) (= name-str (sym-s :name))))
@ -378,13 +382,21 @@
(when refer-syms
(let [source-ns (ctx-find-ns ctx ns-name)
target-ns (ctx-find-ns ctx (ctx-current-ns ctx))]
(each refer-sym refer-syms
(let [name (if (struct? refer-sym) (refer-sym :name) refer-sym)
v (ns-find source-ns name)]
(when v
# Share the SOURCE var (the Clojure model): macro-ness travels with
# it and source-ns redefinitions propagate to the referer.
(put (target-ns :mappings) name v))))))
(if (or (= refer-syms :all)
(and (struct? refer-syms) (= :symbol (refer-syms :jolt/type))
(= "all" (refer-syms :name))))
# :refer :all — share EVERY var (this used to each over the :all
# keyword itself and silently refer nothing; selmer's
# [selmer.util :refer :all] left *tag-open* & co unresolved)
(eachp [nm v] (source-ns :mappings)
(put (target-ns :mappings) nm v))
(each refer-sym refer-syms
(let [name (if (struct? refer-sym) (refer-sym :name) refer-sym)
v (ns-find source-ns name)]
(when v
# Share the SOURCE var (the Clojure model): macro-ness travels with
# it and source-ns redefinitions propagate to the referer.
(put (target-ns :mappings) name v)))))))
nil))
(defn- bind-put
@ -430,7 +442,18 @@
# realtime clock (sub-ms float epoch seconds) — os/time is whole seconds,
# which quantized every elapsed-time measurement to 1000ms.
{"currentTimeMillis" (fn [] (math/floor (* 1000 (os/clock :realtime))))
"nanoTime" (fn [] (math/floor (* 1e9 (os/clock :monotonic))))})
"nanoTime" (fn [] (math/floor (* 1e9 (os/clock :monotonic))))
"getProperty" (fn [k &opt dflt]
(case k
"os.name" (case (os/which)
:windows "Windows" :macos "Mac OS X" "Linux")
"line.separator" "\n"
"file.separator" "/"
"user.dir" (os/cwd)
"user.home" (os/getenv "HOME")
"java.io.tmpdir" (or (os/getenv "TMPDIR") "/tmp")
dflt))
"getenv" (fn [&opt k] (if k (os/getenv k) (os/environ)))})
# Long statics: sentinels portable code compares against. jolt numbers are
# doubles, so these are the f64 approximations.
@ -438,6 +461,18 @@
{"MAX_VALUE" 9223372036854775807
"MIN_VALUE" -9223372036854775808})
# Pluggable host-class shims (java.time etc. register here at module load):
# class-statics: "ClassName" -> {"member" value-or-fn} (Foo/bar resolution)
# tagged-methods: :jolt/tag -> {"method" (fn [self args...])} ((.m obj) dispatch)
(def class-statics @{})
(def tagged-methods @{})
(defn register-class-statics! [class-name tbl] (put class-statics class-name tbl))
(defn register-tagged-methods! [tag tbl] (put tagged-methods tag tbl))
# Constructor shims: (ClassName. args) resolves ClassName as a value, so the
# ctor fns are interned as clojure.core vars at init (install-stateful-fns!).
(def class-ctors @{})
(defn register-class-ctor! [nm f] (put class-ctors nm f))
# java.lang.String method surface for clj-compat interop: (.toLowerCase s),
# (.indexOf s x), ... — the methods portable cljc libraries actually call.
# Case mapping is ASCII (the whole engine is byte-based); indexOf returns -1
@ -451,6 +486,21 @@
"toLowerCase" (fn [s] (string/ascii-lower s))
"toUpperCase" (fn [s] (string/ascii-upper s))
"trim" (fn [s] (string/trim 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)
"toURL" (fn [s] s)
"getPath" (fn [s] s)
"getName" (fn [s] (if-let [i (string/find "/" (string/reverse s))]
(string/slice s (- (length s) i)) s))
"exists" (fn [s] (not (nil? (os/stat s))))
"lastModified" (fn [s] (if-let [st (os/stat s)] (math/floor (* 1000 (st :modified))) 0))
# JVM String.split takes a REGEX string; trailing empties dropped like the JVM
"split" (fn [s re &opt limit]
(def parts (re-split (re-pattern re) s))
(while (and (> (length parts) 0) (= "" (last parts)))
(array/pop parts))
parts)
"length" (fn [s] (length s))
"isEmpty" (fn [s] (= 0 (length s)))
"charAt" (fn [s i] {:jolt/type :jolt/char :ch (s i)})
@ -487,6 +537,9 @@
(if (= ns "Long")
(let [v (get long-statics name)]
(if (nil? v) (error (string "Unsupported Long member: Long/" name)) v))
(if (get class-statics ns)
(let [v (get (get class-statics ns) name)]
(if (nil? v) (error (string "Unsupported member: " ns "/" name)) v))
(if (not (nil? ns))
(let [current-ns (ctx-find-ns ctx (ctx-current-ns ctx))
aliased-ns (or (ns-alias-lookup current-ns ns) (ns-import-lookup current-ns ns))
@ -502,11 +555,19 @@
# the interop boundary visible at the call site.
(if (or (= ns "janet") (string/has-prefix? "janet." ns))
(let [jname (if (= ns "janet") name (string (string/slice ns 6) "/" name))
entry (in (fiber/getenv (fiber/current)) (symbol jname))]
# worker fibers may carry no env (fiber/new without :e inherit)
# — fall back to the env captured at module load
entry (in (or (fiber/getenv (fiber/current)) module-load-env)
(symbol jname))]
(if (not (nil? entry))
(if (table? entry) (entry :value) entry)
(error (string "Unable to resolve Janet symbol: " jname))))
(error (string "Unable to resolve symbol: " ns "/" name)))))
# syntax-quote ns-qualifies bare class names inside macros
# (selmer.util/StringBuilder); class names never belong to an ns —
# fall back to the constructor / statics shims before giving up.
(if-let [ctor (in class-ctors name)]
ctor
(error (string "Unable to resolve symbol: " ns "/" name))))))
# Use :jolt/not-found sentinel to distinguish nil binding from absent binding
(let [local (get bindings name :jolt/not-found-1)
local (if (= local :jolt/not-found-1) (binding-get bindings name) local)]
@ -536,7 +597,7 @@
# No implicit Janet fallback (Stage 3): an unresolved
# Clojure symbol is an error. Host access is the explicit
# janet/ prefix above.
(error (string "Unable to resolve symbol: " name)))))))))))))))))
(error (string "Unable to resolve symbol: " name))))))))))))))))))
(defn- parse-arg-names
"Parse a parameter vector, handling & rest args.
Returns {:fixed [names...] :rest name-or-nil :all [names...]}"
@ -887,15 +948,30 @@
qualified name in the current ns. A fn; quoted class symbols arrive evaluated."
[ctx & class-specs]
(def ns (ctx-find-ns ctx (ctx-current-ns ctx)))
(defn sym-name [x] (if (and (struct? x) (= :symbol (x :jolt/type))) (x :name) (string x)))
(defn import-one [class-name &opt pkg]
(def last-dot (do (var idx -1) (var pos 0)
(while (< pos (length class-name))
(when (= (class-name pos) 46) (set idx pos)) (++ pos))
idx))
(def short-name (if (>= last-dot 0) (string/slice class-name (+ last-dot 1)) class-name))
(def pkg-name (cond pkg pkg (>= last-dot 0) (string/slice class-name 0 last-dot) nil))
(ns-import ns short-name class-name)
# a deftype "class" lives as a ctor var in its defining jolt ns — share it
# (the JVM import makes (TextNode. ...) resolvable; this is our analog)
(when pkg-name
(when-let [src-ns (get ((ctx :env) :namespaces) pkg-name)
v (ns-find src-ns short-name)]
(put (ns :mappings) short-name v))))
(each class-spec class-specs
(let [class-name (if (and (struct? class-spec) (= :symbol (class-spec :jolt/type)))
(class-spec :name) (string class-spec))
last-dot (do (var idx -1) (var pos 0)
(while (< pos (length class-name))
(when (= (class-name pos) 46) (set idx pos)) (++ pos))
idx)
short-name (if (>= last-dot 0) (string/slice class-name (+ last-dot 1)) class-name)]
(ns-import ns short-name class-name)))
(if (or (array? class-spec) (tuple? class-spec)
(and (table? class-spec) (= :jolt/pvec (class-spec :jolt/type))))
# vector spec: [pkg Class1 Class2 ...]
(let [items (if (table? class-spec) (pv->array class-spec) class-spec)
pkg (sym-name (in items 0))]
(for i 1 (length items)
(import-one (string pkg "." (sym-name (in items i))) pkg)))
(import-one (sym-name class-spec))))
nil)
(defn refer-clojure-impl
@ -1240,6 +1316,28 @@
"java.util.regex.Pattern" (and (table? val) (= :jolt/regex (val :jolt/type)))
"Character" (and (struct? val) (= :jolt/char (get val :jolt/type)))
"java.lang.Character" (and (struct? val) (= :jolt/char (get val :jolt/type)))
# java.time shims (javatime.janet); #inst IS java.util.Date in Clojure
"java.util.Date" (and (struct? val) (= :jolt/inst (get val :jolt/type)))
"Date" (and (struct? val) (= :jolt/inst (get val :jolt/type)))
"Instant" (and (table? val) (= :jolt/instant (get val :jolt/type)))
"java.time.Instant" (and (table? val) (= :jolt/instant (get val :jolt/type)))
"LocalDateTime" (and (table? val) (= :jolt/local-dt (get val :jolt/type)))
"java.time.LocalDateTime" (and (table? val) (= :jolt/local-dt (get val :jolt/type)))
"ZonedDateTime" (and (table? val) (= :jolt/zoned-dt (get val :jolt/type)))
"java.time.ZonedDateTime" (and (table? val) (= :jolt/zoned-dt (get val :jolt/type)))
"LocalTime" false
"LocalDate" false
"java.sql.Time" false
"java.sql.Timestamp" false
"java.sql.Date" false
"DateTimeFormatter" (and (table? val) (= :jolt/dt-formatter (get val :jolt/type)))
"URL" (and (table? val) (= :jolt/url (get val :jolt/type)))
"java.net.URL" (and (table? val) (= :jolt/url (get val :jolt/type)))
# JVM char[] class — (Class/forName "[C"); jolt char arrays are Janet
# arrays of char structs
"[C" (and (array? val)
(or (= 0 (length val))
(and (struct? (val 0)) (= :jolt/char ((val 0) :jolt/type)))))
"clojure.lang.Atom" (and (table? val) (= :jolt/atom (val :jolt/type)))
"clojure.lang.Volatile" (and (table? val) (= :jolt/volatile (val :jolt/type)))
"clojure.lang.Delay" (and (table? val) (= :jolt/delay (val :jolt/type)))
@ -1255,6 +1353,12 @@
# 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,
# read, with-in-str, and line-seq are Clojure over these (core/50-io.clj).
# The loader's registered source roots (the closest thing to a classpath) —
# io/resource searches these for relative resource paths.
# registered constructor shims (StringReader., StringBuilder., ...)
(eachp [nm f] class-ctors (ns-intern core nm f))
(ns-intern core "__source-roots"
(fn [] (tuple ;(get (ctx :env) :source-paths))))
(ns-intern core "__stdin-read-line"
(fn []
(let [l (file/read stdin :line)]
@ -1815,9 +1919,26 @@
(if m
(m (string target) ;args)
(error (string "Unsupported String method ." field-name))))
# registered shim objects (java.time etc.): tag-keyed method tables
(if (and (or (table? target) (struct? target))
(get tagged-methods (get target :jolt/type)))
(let [m (get (get tagged-methods (get target :jolt/type)) field-name)]
(if m
(m target ;args)
(error (string "Unsupported method ." field-name " on " (string (get target :jolt/type))))))
(if (target :jolt/deftype)
(let [method-key (keyword field-name)]
(apply (get target method-key) target ;args))
# deftype/reify methods live in the protocol registry (or the
# instance's reified-fns table), not on the instance
(let [method-key (keyword field-name)
own (get target method-key)
reified (get (get target :jolt/protocol-methods) method-key)
m (cond
(or (function? own) (cfunction? own)) own
(or (function? reified) (cfunction? reified)) reified
(find-method-any-protocol ctx (target :jolt/deftype) field-name))]
(if m
(apply m target args)
(error (string "No method ." field-name " on " (target :jolt/deftype)))))
# Janet-native interop: try field lookup + call
(if (or (table? target) (struct? target))
(let [method (get target (keyword field-name))]
@ -1830,7 +1951,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
@ -1840,16 +1961,26 @@
(if m
(m (string target))
(error (string "Unsupported String method ." field-name))))
(if (and (or (table? target) (struct? target))
(get tagged-methods (get target :jolt/type))
(get (get tagged-methods (get target :jolt/type)) field-name))
((get (get tagged-methods (get target :jolt/type)) field-name) target)
(let [v (get target (keyword field-name))]
(if (and (struct? member-raw) (= :symbol (member-raw :jolt/type))
(not (string/has-prefix? "-" member-name)))
(cond
(or (function? v) (cfunction? v)) (v target)
# zero-arg deftype/reify method via the protocol registry
(and (table? target) (target :jolt/deftype))
(let [reified (get (get target :jolt/protocol-methods) (keyword field-name))
m (if (or (function? reified) (cfunction? reified)) reified
(find-method-any-protocol ctx (target :jolt/deftype) field-name))]
(if m (m target) v))
# value stored as an unevaluated fn* form: compile then call
(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)]

237
src/jolt/javatime.janet Normal file
View file

@ -0,0 +1,237 @@
# java.time shims (jolt-ea7): the surface Selmer's date filters use, backed
# by epoch milliseconds (the same representation as :jolt/inst). Local time
# means the HOST's local time (os/date with local=true); zones beyond the
# system default are not modeled. Registered through the evaluator's
# class-statics / tagged-methods registries, so this module is data plus an
# install call — adding another java.* shim follows the same shape.
(use ./evaluator)
(defn- chr [s] (get s 0))
# --- values -------------------------------------------------------------------
(defn- instant [ms] @{:jolt/type :jolt/instant :ms ms})
(defn- zoned [ms zone] @{:jolt/type :jolt/zoned-dt :ms ms :zone zone})
(defn- local-dt [ms] @{:jolt/type :jolt/local-dt :ms ms})
(defn- formatter [pattern &opt locale] @{:jolt/type :jolt/dt-formatter :pattern pattern :locale locale})
(def- zone-default @{:jolt/type :jolt/zone-id :id "system"})
# ms of any date-ish shim value (or a :jolt/inst)
(defn- ms-of [d]
(cond
(number? d) d
(and (or (table? d) (struct? d))
(or (= :jolt/inst (get d :jolt/type))
(= :jolt/instant (get d :jolt/type))
(= :jolt/zoned-dt (get d :jolt/type))
(= :jolt/local-dt (get d :jolt/type))))
(get d :ms)
(error (string "not a date value: " (type d)))))
# --- formatting ----------------------------------------------------------------
(def- month-names ["January" "February" "March" "April" "May" "June" "July"
"August" "September" "October" "November" "December"])
(def- day-names ["Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"])
(defn- pad2 [n] (if (< n 10) (string "0" n) (string n)))
# Format epoch-ms with a (subset of the) JVM DateTimeFormatter pattern:
# yyyy yy MMMM MMM MM M dd d EEEE EEE HH H hh h mm m ss s a, quoted literals
# with '...'. Unknown letters pass through.
(defn- format-ms [pattern ms]
(def d (os/date (math/floor (/ ms 1000)) true))
(def out @"")
(var i 0)
(def n (length pattern))
(defn run-len [c]
(var j i)
(while (and (< j n) (= (pattern j) c)) (++ j))
(- j i))
(while (< i n)
(def c (pattern i))
(def k (run-len c))
(cond
(= c (chr "'"))
# quoted literal up to the closing quote ('' = literal quote)
(if (and (< (+ i 1) n) (= (pattern (+ i 1)) (chr "'")))
(do (buffer/push out "'") (+= i 2))
(let [close (string/find "'" pattern (+ i 1))]
(buffer/push out (string/slice pattern (+ i 1) close))
(set i (+ close 1))))
(= c (chr "y"))
(do (buffer/push out (if (>= k 4) (string (d :year))
(pad2 (mod (d :year) 100))))
(+= i k))
(= c (chr "M"))
(do (buffer/push out (case k
1 (string (+ 1 (d :month)))
2 (pad2 (+ 1 (d :month)))
3 (string/slice (in month-names (d :month)) 0 3)
(in month-names (d :month))))
(+= i k))
(= c (chr "d"))
(do (buffer/push out (if (= k 1) (string (+ 1 (d :month-day))) (pad2 (+ 1 (d :month-day)))))
(+= i k))
(= c (chr "E"))
(do (buffer/push out (if (>= k 4) (in day-names (d :week-day))
(string/slice (in day-names (d :week-day)) 0 3)))
(+= i k))
(= c (chr "H"))
(do (buffer/push out (if (= k 1) (string (d :hours)) (pad2 (d :hours)))) (+= i k))
(= c (chr "h"))
(let [h12 (let [h (mod (d :hours) 12)] (if (= h 0) 12 h))]
(buffer/push out (if (= k 1) (string h12) (pad2 h12))) (+= i k))
(= c (chr "m"))
(do (buffer/push out (if (= k 1) (string (d :minutes)) (pad2 (d :minutes)))) (+= i k))
(= c (chr "s"))
(do (buffer/push out (if (= k 1) (string (d :seconds)) (pad2 (d :seconds)))) (+= i k))
(= c (chr "a"))
(do (buffer/push out (if (< (d :hours) 12) "AM" "PM")) (+= i k))
(do (buffer/push out (string/from-bytes c)) (++ i))))
(string out))
# Localized FormatStyle approximations (no locale database on this host).
(def- style-patterns
{[:date :short] "M/d/yy" [:date :medium] "MMM d, yyyy"
[:date :long] "MMMM d, yyyy" [:date :full] "EEEE, MMMM d, yyyy"
[:time :short] "h:mm a" [:time :medium] "h:mm:ss a"
[:time :long] "h:mm:ss a" [:time :full] "h:mm:ss a"
[:datetime :short] "M/d/yy, h:mm a"
[:datetime :medium] "MMM d, yyyy, h:mm:ss a"
[:datetime :long] "MMMM d, yyyy, h:mm:ss a"
[:datetime :full] "EEEE, MMMM d, yyyy, h:mm:ss a"})
(defn- style-fmt [kind style]
(formatter (get style-patterns [kind (get style :style)] "yyyy-MM-dd HH:mm:ss")))
# --- registration --------------------------------------------------------------
(defn install! []
(def fs (fn [style] @{:jolt/type :jolt/format-style :style style}))
(register-class-statics! "FormatStyle"
@{"SHORT" (fs :short) "MEDIUM" (fs :medium) "LONG" (fs :long) "FULL" (fs :full)})
(register-class-statics! "DateTimeFormatter"
@{"ofPattern" (fn [p &opt locale] (formatter p locale))
"ISO_LOCAL_DATE" (formatter "yyyy-MM-dd")
"ISO_LOCAL_DATE_TIME" (formatter "yyyy-MM-dd'T'HH:mm:ss")
"ofLocalizedDate" (fn [style] (style-fmt :date style))
"ofLocalizedTime" (fn [style] (style-fmt :time style))
"ofLocalizedDateTime" (fn [style] (style-fmt :datetime style))})
(register-class-statics! "Instant"
@{"ofEpochMilli" (fn [ms] (instant ms))
"now" (fn [] (instant (math/floor (* 1000 (os/clock :realtime)))))})
(register-class-statics! "ZoneId"
@{"systemDefault" (fn [] zone-default)})
(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"}})
(register-tagged-methods! :jolt/instant
@{"atZone" (fn [self zone] (zoned (self :ms) zone))
"toEpochMilli" (fn [self] (self :ms))})
(register-tagged-methods! :jolt/zoned-dt
@{"toLocalDateTime" (fn [self] (local-dt (self :ms)))
"toInstant" (fn [self] (instant (self :ms)))})
(register-tagged-methods! :jolt/local-dt
@{"atZone" (fn [self zone] (zoned (self :ms) zone))})
# a :jolt/inst (#inst — Clojure's java.util.Date) supports the Date methods
# Selmer's fix-date path calls
(register-tagged-methods! :jolt/inst
@{"toInstant" (fn [self] (instant (self :ms)))
"getTime" (fn [self] (self :ms))})
(register-tagged-methods! :jolt/dt-formatter
@{"withLocale" (fn [self locale] (formatter (self :pattern) locale))
"format" (fn [self d] (format-ms (self :pattern) (ms-of d)))}))
# --- java.io / java.lang shims (Selmer's template reader) ---------------------
(defn- string-reader [src]
# :close makes with-open's __close happy (it calls (get x :close) when
# present); :read-line-fn matches the 50-io reader convention so line-seq
# works over readers io/reader hands back
(def self @{:jolt/type :jolt/jio-string-reader :s (string src) :pos 0
:close (fn [] nil)})
(put self :read-line-fn
(fn []
(def {:s s :pos pos} self)
(when (< pos (length s))
(def i (string/find "\n" s pos))
(if (nil? i)
(do (put self :pos (length s)) (string/slice s pos))
(do (put self :pos (+ i 1)) (string/slice s pos i))))))
self)
(defn- string-builder [&opt init]
# a numeric arg is a CAPACITY (java.lang.StringBuilder(int)), not content
@{:jolt/type :jolt/string-builder
:buf (cond (nil? init) @"" (number? init) (buffer/new init) (buffer init))})
(defn- render-piece [x]
(cond
(nil? x) "null"
(and (struct? x) (= :jolt/char (get x :jolt/type))) (string/from-bytes (x :ch))
(string x)))
(defn install-io! []
(register-tagged-methods! :jolt/jio-string-reader
@{"read" (fn [self]
(if (>= (self :pos) (length (self :s)))
-1
(let [b ((self :s) (self :pos))]
(put self :pos (+ 1 (self :pos)))
b)))
"mark" (fn [self &opt limit] (put self :marked (self :pos)) nil)
"reset" (fn [self] (put self :pos (or (self :marked) 0)) nil)
"skip" (fn [self n] (put self :pos (min (length (self :s)) (+ (self :pos) n))) n)
"close" (fn [self] nil)})
(register-tagged-methods! :jolt/string-builder
@{"append" (fn [self x] (buffer/push (self :buf) (render-piece x)) self)
"toString" (fn [self] (string (self :buf)))
"length" (fn [self] (length (self :buf)))
"setLength" (fn [self n]
(def buf (self :buf))
(if (< n (length buf))
(buffer/popn buf (- (length buf) n))
(while (< (length buf) n) (buffer/push buf "\0")))
nil)
"charAt" (fn [self i] {:jolt/type :jolt/char :ch ((self :buf) i)})})
(each nm ["File" "java.io.File"]
(register-class-statics! nm @{"separator" "/" "separatorChar" {:jolt/type :jolt/char :ch 47}}))
(register-class-statics! "Class"
@{"forName" (fn [nm] @{:jolt/type :jolt/class :name nm})})
(each nm ["StringReader" "java.io.StringReader"]
(register-class-ctor! nm string-reader))
(each nm ["StringBuilder" "java.lang.StringBuilder"]
(register-class-ctor! nm string-builder))
# 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.
(defn url-path [spec]
(var p (if (string/has-prefix? "file:" spec) (string/slice spec 5) spec))
(while (and (> (length p) 1) (string/has-prefix? "//" p))
(set p (string/slice p 1)))
p)
(register-tagged-methods! :jolt/url
@{"getPath" (fn [self] (url-path (self :spec)))
"getFile" (fn [self] (url-path (self :spec)))
"toString" (fn [self] (self :spec))
"toExternalForm" (fn [self] (self :spec))})
(each nm ["URL" "java.net.URL"]
(register-class-ctor! nm
(fn [spec & _]
(def s (string spec))
(def colon (string/find ":" s))
(if (or (nil? colon) (= colon 0)
(string/find "/" (string/slice s 0 colon)))
(error (string "MalformedURLException: no protocol: " s))
@{:jolt/type :jolt/url :spec s}))))
(each nm ["Locale" "java.util.Locale"]
(register-class-ctor! nm (fn [id &opt _country] @{:jolt/type :jolt/locale :id (string id)}))))
(install!)
(install-io!)

View file

@ -560,6 +560,17 @@
(when proto-impls
(get proto-impls method-name))))))
(defn find-method-any-protocol
"Find a method implementation for a type, searching every protocol it
implements (dot calls name the method but not the protocol)."
[ctx type-tag method-name]
(let [type-impls (get (get (ctx :env) :type-registry) type-tag)]
(when type-impls
(var r nil)
(eachp [_ proto-impls] type-impls
(when (nil? r) (set r (get proto-impls method-name))))
r)))
(defn type-satisfies?
"Check if a type satisfies a protocol."
[ctx type-tag protocol-name]

View file

@ -0,0 +1,61 @@
# Selmer acceptance (jolt-ea7): load the real Selmer template engine from
# ~/src/selmer and render through its full pipeline — the java.time shims
# (DateTimeFormatter/Instant/ZoneId/LocalDateTime), the java.io shims
# (StringReader/StringBuilder + char-array readers), vector :import sharing
# deftype ctors, and :refer :all. SKIPS cleanly if the checkout is absent
# (CI has no ~/src/selmer); the shim surface itself is covered by
# test/spec/host-interop-spec.janet either way.
(import ../../src/jolt/api :as api)
(use ../../src/jolt/reader)
(def selmer-src (string (os/getenv "HOME") "/src/selmer/src"))
(def selmer-res (string (os/getenv "HOME") "/src/selmer/resources"))
(if (nil? (os/stat (string selmer-src "/selmer/parser.clj")))
(print "selmer-test: ~/src/selmer not present, skipping")
(do
(reader-features-set! ["jolt" "clj" "default"])
(def ctx (api/init {:paths [selmer-src selmer-res]}))
(print "loading selmer.parser...")
(api/eval-string ctx "(require (quote [selmer.parser :as sp]))")
(print " ok")
(defn render [tpl ctx-map-src]
(api/eval-string ctx (string "(sp/render " (describe tpl) " " ctx-map-src ")")))
(print "variable + filter...")
(assert (= "Hello WORLD!" (render "Hello {{name|upper}}!" "{:name \"world\"}")))
(print " ok")
(print "date filter (java.time path)...")
(def d (render "{{d|date:yyyy-MM-dd}}" "{:d #inst \"2020-03-05T10:00:00Z\"}"))
(assert (peg/match '(* :d :d :d :d "-" :d :d "-" :d :d -1) d)
(string "date filter renders a yyyy-MM-dd date, got: " d))
(print " ok")
(print "if / for tags...")
(assert (= "YES" (render "{% if ok %}YES{% else %}NO{% endif %}" "{:ok true}")))
(assert (= "NO" (render "{% if ok %}YES{% else %}NO{% endif %}" "{:ok false}")))
(assert (= "1,2,3," (render "{% for x in xs %}{{x}},{% endfor %}" "{:xs [1 2 3]}")))
(print " ok")
(print "nested lookup + escaping...")
(assert (= "7" (render "{{m.a.b}}" "{:m {:a {:b 7}}}")))
(assert (= "&lt;b&gt;&amp;" (render "{{x}}" "{:x \"<b>&\"}")))
(print " ok")
(print "file templates (render-file + cache)...")
(def tpl-dir (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-selmer-test"))
(os/mkdir tpl-dir)
(spit (string tpl-dir "/t.html") "File says {{x|upper}}")
(api/eval-string ctx (string "(selmer.util/set-custom-resource-path! " (describe (string tpl-dir "/")) ")"))
(assert (= "File says HI"
(api/eval-string ctx "(sp/render-file \"t.html\" {:x \"hi\"})")))
# second render goes through the template cache (last-modified check)
(assert (= "File says AGAIN"
(api/eval-string ctx "(sp/render-file \"t.html\" {:x \"again\"})")))
(print " ok")
(print "selmer-test: all passed")))

View file

@ -61,3 +61,51 @@
[".equalsIgnoreCase" "true" "(.equalsIgnoreCase \"AbC\" \"aBc\")"]
["Long/MAX_VALUE" "true" "(pos? Long/MAX_VALUE)"]
["unsupported method throws" :throws "(.frobnicate \"abc\")"])
# java.time shims (jolt-ea7): epoch-ms backed values + a DateTimeFormatter
# pattern subset — the surface Selmer's date filters drive. Formatting uses
# the HOST's local timezone, so rows assert structure, not wall-clock values.
(defspec "interop / java.time shims"
["ofPattern formats #inst" "true"
"(string? (.format (DateTimeFormatter/ofPattern \"yyyy-MM-dd\") #inst \"2020-03-05T13:45:30Z\"))"]
["pattern shape" "true"
"(boolean (re-matches #\"\\d{4}-\\d{2}-\\d{2}\" (.format (DateTimeFormatter/ofPattern \"yyyy-MM-dd\") #inst \"2020-03-05T13:45:30Z\")))"]
["month name + ampm" "true"
"(boolean (re-matches #\"[A-Z][a-z]{2} \\d{1,2}, 2020 \\d{1,2}:\\d{2} [AP]M\" (.format (DateTimeFormatter/ofPattern \"MMM d, yyyy h:mm a\") #inst \"2020-03-05T13:45:30Z\")))"]
["quoted literal" "true"
"(boolean (re-matches #\"\\d{4}-\\d{2}-\\d{2}T\\d{2}:\\d{2}:\\d{2}\" (.format DateTimeFormatter/ISO_LOCAL_DATE_TIME #inst \"2020-03-05T13:45:30Z\")))"]
["localized style" "true"
"(string? (.format (DateTimeFormatter/ofLocalizedDate FormatStyle/MEDIUM) #inst \"2020-03-05T13:45:30Z\"))"]
["withLocale chain" "true"
"(string? (.format (.withLocale (DateTimeFormatter/ofPattern \"yyyy\") (java.util.Locale. \"en\")) #inst \"2020-01-01T00:00:00Z\"))"]
["fix-date chain" "true"
"(instance? LocalDateTime (-> #inst \"2020-03-05T13:45:30Z\" (.toInstant) (.atZone (ZoneId/systemDefault)) (.toLocalDateTime)))"]
["inst is java.util.Date" "true" "(instance? java.util.Date #inst \"2020-01-01T00:00:00Z\")"]
["Instant instance" "true" "(instance? java.time.Instant (Instant/ofEpochMilli 0))"]
["getTime epoch ms" "0" "(.getTime #inst \"1970-01-01T00:00:00Z\")"]
["toEpochMilli round trip" "1234" "(.toEpochMilli (Instant/ofEpochMilli 1234))"]
["Instant/now is current" "true" "(> (.toEpochMilli (Instant/now)) 1500000000000)"]
["sql types are not" "false" "(instance? java.sql.Timestamp #inst \"2020-01-01T00:00:00Z\")"])
# java.io / java.lang shims that carry Selmer's char-by-char template reader.
(defspec "interop / StringReader & StringBuilder"
["StringReader read" "[97 98 -1]"
"(let [r (java.io.StringReader. \"ab\")] [(.read r) (.read r) (.read r)])"]
["mark/reset" "[97 97]"
"(let [r (StringReader. \"ab\")] (.mark r 1) [(.read r) (do (.reset r) (.read r))])"]
["StringBuilder append" "\"ab1\""
"(.toString (-> (StringBuilder.) (.append \"a\") (.append \\b) (.append 1)))"]
["capacity arg is not content" "\"x\""
"(.toString (.append (StringBuilder. 16) \"x\"))"]
["setLength truncates" "\"ab\""
"(let [sb (StringBuilder.)] (.append sb \"abcd\") (.setLength sb 2) (.toString sb))"]
["char-array of string" "true"
"(instance? (Class/forName \"[C\") (char-array \"ab\"))"]
["reader over char[]" "97"
"(do (require (quote clojure.java.io)) (.read (clojure.java.io/reader (char-array \"abc\"))))"]
["line-seq over file reader" "[\"a\" \"b\"]"
"(do (require (quote clojure.java.io)) (janet/spit \"/tmp/jolt-lineseq-spec.txt\" \"a\\nb\\n\") (vec (line-seq (clojure.java.io/reader \"/tmp/jolt-lineseq-spec.txt\"))))"]
["with-open closes shim" "97"
"(with-open [r (StringReader. \"a\")] (.read r))"]
["vector :import shares deftype ctor" "\"hi!\""
"(do (ns spec.nodea) (defprotocol SpecP (spec-pm [this])) (deftype SpecTN [t] SpecP (spec-pm [this] (str t \"!\"))) (ns spec.nodeb (:import [spec.nodea SpecTN])) (.spec-pm (SpecTN. \"hi\")))"])