Merge pull request #71 from jolt-lang/greeter-example-fixes

deps + compile fixes surfaced by the greeter example
This commit is contained in:
Dmitri Sotnikov 2026-06-11 01:50:06 -04:00 committed by GitHub
commit 1a2841b02f
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
12 changed files with 214 additions and 44 deletions

View file

@ -116,9 +116,12 @@
`(~form ~x))]
`(->> ~threaded ~@(rest forms)))))
;; Forward declaration is a no-op on Jolt — the compiler resolves forward refs via
;; pending cells (matching the prior Janet macro).
(defmacro declare [& syms] `(do))
;; Forward declaration interns unbound vars (Clojure semantics). The interpreter
;; resolves forward refs lazily either way, but the COMPILER classifies globals at
;; compile time: without the var, a declared name that collides with a Janet root
;; binding (parse, hash, …) would compile to the host fn instead of the var.
(defmacro declare [& syms]
`(do ~@(map (fn* [s] `(def ~s)) syms)))
;; destructure — Clojure's binding-vector expander, ported from the Janet seed
;; (was core-destructure). Turns a binding vector that may contain destructuring

View file

@ -83,6 +83,9 @@
;; Jolt has no ratio or bigdecimal types, so these are constants / reduce to int?.
(defn ratio? [x] false)
(defn decimal? [x] false)
;; No first-class Class objects either: class names are symbols the evaluator
;; handles in instance?/new positions, never values — so nothing is a class.
(defn class? [x] false)
(defn rational? [x] (int? x))
(defn nat-int? [x] (and (int? x) (>= x 0)))
(defn neg-int? [x] (and (int? x) (neg? x)))

View file

@ -140,11 +140,19 @@
(const nil)))
"do" (analyze-seq ctx (rest items) env)
"throw" (throw-node (analyze ctx (nth items 1) env))
"def" (let [name-sym (nth items 1)
nm (form-sym-name name-sym)
cur (compile-ns ctx)]
(host-intern! ctx cur nm)
(def-node cur nm (analyze ctx (nth items 2) env) (form-sym-meta name-sym)))
"def" (let [name-sym (nth items 1)]
;; ^{:map} metadata reads as (def (with-meta name m) v) — the
;; metadata is a runtime expression, so the interpreter evaluates
;; the whole def (it unwraps the name and merges the meta).
(when-not (form-sym? name-sym)
(uncompilable "def name with map metadata"))
;; (def name) with no init (declare) just interns — interpreter's job
(when (< (count items) 3)
(uncompilable "def with no init"))
(let [nm (form-sym-name name-sym)
cur (compile-ns ctx)]
(host-intern! ctx cur nm)
(def-node cur nm (analyze ctx (nth items 2) env) (form-sym-meta name-sym))))
"let*" (let [bvec (vec (form-vec-items (nth items 1)))
r (analyze-bindings ctx bvec env)]
(let-node (first r) (analyze-seq ctx (drop 2 items) (second r))))

View file

@ -30,11 +30,17 @@
# spec is a deps.edn dep value: {:git/url ... :git/sha/:git/tag ...}
(def resolve-bundle (jpm-fn "jpm/pm" 'resolve-bundle))
(def download-bundle (jpm-fn "jpm/pm" 'download-bundle))
(def b (resolve-bundle {:url (get spec :git/url)
:sha (get spec :git/sha)
:tag (get spec :git/tag)
:shallow false}))
(download-bundle (b :url) (b :type) (b :tag) (b :shallow)))
# Run git silenced (jpm's shell honors :silent): its checkout chatter
# ("HEAD is now at …") otherwise lands on STDOUT and corrupts the
# documented `JOLT_PATH=$(jolt-deps path)` capture. Progress goes to stderr.
(eprintf "jolt-deps: fetching %s @ %s"
(get spec :git/url) (or (get spec :git/sha) (get spec :git/tag) "HEAD"))
(with-dyns [:silent true]
(def b (resolve-bundle {:url (get spec :git/url)
:sha (get spec :git/sha)
:tag (get spec :git/tag)
:shallow false}))
(download-bundle (b :url) (b :type) (b :tag) (b :shallow))))
(defn- src-roots
"Source dirs of a project/dep at `dir`: its deps.edn :paths joined to dir
@ -210,14 +216,16 @@
(os/mkdir ".cpcache")
(def cache-file ".cpcache/jolt-deps.jdn")
(def user-path (string (config-dir) "/deps.edn"))
(def h (hash [(slurp deps-edn-path)
(when (os/stat user-path) (slurp user-path))
(string/format "%j" (map string (or aliases [])))]))
# The raw key material, not (hash …): janet's hash is seeded per process,
# so a hashed key never matches across invocations and the cache never hit.
(def key [(slurp deps-edn-path)
(or (when (os/stat user-path) (slurp user-path)) "")
(string/format "%j" (map string (or aliases [])))])
(def cached (when (os/stat cache-file) (try (parse (slurp cache-file)) ([_] nil))))
(if (and cached (= h (get cached :hash)))
(if (and cached (deep= key (get cached :key)))
(get cached :roots)
(let [roots (resolve-deps deps-edn-path tree aliases)]
(spit cache-file (string/format "%j" {:hash h :roots roots}))
(spit cache-file (string/format "%j" {:key key :roots roots}))
roots))))
# --- :tasks (the honest subset of babashka's) ----------------------------------

View file

@ -340,10 +340,22 @@
for ns-form-less stdlib files, changes it). No-op for already-loaded namespaces."
[ctx ns-name]
(let [ns (ctx-find-ns ctx ns-name)]
(when (and (= 0 (length (ns :mappings))) (not= ns-name "clojure.core"))
(when (and (= 0 (length (ns :mappings)))
(not (get (get (ctx :env) :loaded-namespaces @{}) ns-name))
(not= ns-name "clojure.core"))
(let [path (find-ns-file ctx ns-name)
embedded (get (get (ctx :env) :embedded-sources @{}) ns-name)
stdlib? (not (nil? embedded))]
# Clojure throws FileNotFoundException here; succeeding silently leaves
# an empty namespace behind and defers the failure to the first
# unresolved symbol, far from the actual cause (a typo, a missing
# JOLT_PATH root). Best-effort loaders (the SCI bootstrap, which loads
# clj-targeted sources whose requires can't all exist on this host)
# opt out via :lenient-require? on the env.
(when (and (nil? path) (nil? embedded)
(not (get (ctx :env) :lenient-require?)))
(error (string "Could not locate " ns-name
" on the context's source paths (JOLT_PATH / :paths)")))
(when (or path embedded)
(let [saved (ctx-current-ns ctx)]
# Stdlib files have no `ns` form, so switch into the target ns first
@ -943,6 +955,13 @@
[ctx sym]
(def ns-name (if (and (struct? sym) (= :symbol (sym :jolt/type))) (sym :name) (string sym)))
(def the-ns-obj (ctx-find-ns ctx ns-name))
# An ns entered in-session counts as loaded (Clojure's ns macro commutes the
# name into *loaded-libs*), so a later require/use of it must not try to load
# a file — see maybe-require-ns. Namespace objects are immutable structs, so
# the set lives on the env.
(def loaded (or (get (ctx :env) :loaded-namespaces)
(let [t @{}] (put (ctx :env) :loaded-namespaces t) t)))
(put loaded ns-name true)
(ctx-set-current-ns ctx ns-name)
the-ns-obj)
@ -1522,30 +1541,40 @@
ns-name (ctx-current-ns ctx)
ns (ctx-find-ns ctx ns-name)
# Create var first (unbound) so self-referencing defs resolve
v (ns-intern ns (name-sym :name))
# (def name docstring value): docstring is form 2, value form 3
has-doc (and (> (length form) 3) (string? (in form 2)))
val-form (in form (if has-doc 3 2))
val (eval-form ctx bindings val-form)]
(bind-root v val)
# Staged bootstrap (jolt-4j3): pre/at-kernel overlay defns load
# interpreted; stash the fn source so backend/recompile-defns! can
# compile them once the analyzer is alive — the defn analog of
# :macro-src. Only set while api/load-core-overlay! loads the early
# tiers (the flag scopes it away from user code).
(when (and (get (ctx :env) :stash-defn-src?)
(function? val)
(array? val-form) (> (length val-form) 0)
(or (sym-name? (first val-form) "fn")
(sym-name? (first val-form) "fn*")))
(put v :defn-src val-form))
(let [extra (if has-doc (merge name-meta {:doc (in form 2)}) name-meta)]
(when (not (empty? extra))
(put v :meta (merge (or (get v :meta) {}) extra))))
(when dynamic?
(put v :dynamic true))
# def returns the var (Clojure semantics); REPL prints #'ns/name
v)
v (ns-intern ns (name-sym :name))]
# (def name) with no init interns the var and leaves any existing
# root binding alone (Clojure semantics — this is what declare
# expands to, so compiled forward refs bind to the var instead of
# falling through to a like-named host builtin).
(if (= 2 (length form))
(do
(when (not (empty? name-meta))
(put v :meta (merge (or (get v :meta) {}) name-meta)))
(when dynamic? (put v :dynamic true))
v)
(let [# (def name docstring value): docstring form 2, value form 3
has-doc (and (> (length form) 3) (string? (in form 2)))
val-form (in form (if has-doc 3 2))
val (eval-form ctx bindings val-form)]
(bind-root v val)
# Staged bootstrap (jolt-4j3): pre/at-kernel overlay defns load
# interpreted; stash the fn source so backend/recompile-defns! can
# compile them once the analyzer is alive — the defn analog of
# :macro-src. Only set while api/load-core-overlay! loads the early
# tiers (the flag scopes it away from user code).
(when (and (get (ctx :env) :stash-defn-src?)
(function? val)
(array? val-form) (> (length val-form) 0)
(or (sym-name? (first val-form) "fn")
(sym-name? (first val-form) "fn*")))
(put v :defn-src val-form))
(let [extra (if has-doc (merge name-meta {:doc (in form 2)}) name-meta)]
(when (not (empty? extra))
(put v :meta (merge (or (get v :meta) {}) extra))))
(when dynamic?
(put v :dynamic true))
# def returns the var (Clojure semantics); REPL prints #'ns/name
v)))
"defmacro" (let [name-sym (in form 1)
rest-form (tuple/slice form 2)
# optional docstring

View file

@ -138,4 +138,31 @@
(eval-string c "(defn g [] 2)")
(assert (= 2 (ct-eval c "(calls-g)")) "compiled caller sees redefined global"))
# Map-literal metadata on a def'd name reads as (def (with-meta name m) v); the
# analyzer must route it to the interpreter (uncompilable), not die extracting
# the name. Regression: yogthos/config's (defonce ^{:doc "…"} env …) broke
# every load-string/uberscript path while loading fine through require.
(let [c (init-cached {:compile? true})]
(assert (= 42 (do (eval-string c `(def ^{:doc "d"} md-def 42)`)
(ct-eval c "md-def")))
"compile-mode def with ^{:map} metadata")
(assert (= "d" (ct-eval c "(:doc (meta (var md-def)))"))
"map metadata lands on the var")
(assert (= 7 (do (eval-string c `(defonce ^{:doc "o"} md-once 7)`)
(ct-eval c "md-once")))
"compile-mode defonce with ^{:map} metadata"))
# (declare name) must intern a var so a compiled forward reference binds to it —
# not to a like-named Janet host builtin. Regression: selmer.parser's
# (declare parse) + a (parse …) call compiled to janet's 1-arg `parse`.
(let [c (init-cached {:compile? true})]
(eval-string c "(declare parse)")
(eval-string c "(defn callit [s] (parse s 1 2))")
(eval-string c "(defn parse [s a b] [s a b])")
(assert (deep= ["x" 1 2] (ct-eval c `(callit "x")`))
"compiled forward ref through declare beats host fallback")
(eval-string c "(def no-init-var)")
(assert (= true (ct-eval c "(do (def no-init-var 5) (= 5 no-init-var))"))
"(def name) with no init interns; later def binds"))
(print "\nAll Phase 6 tests passed!")

View file

@ -6,6 +6,9 @@
(use ../../src/jolt/types)
(import ../../src/jolt/deps :as deps)
# Captured before any os/cd: subprocess tests below re-import src/jolt/deps.
(def repo-root (os/cwd))
(def base (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-deps-resolve-" (os/time)))
(defn rmrf [p]
(when (os/stat p)
@ -53,9 +56,75 @@
(deep= roots (deps/resolve-deps-cached "deps.edn" (string base "/proj/jpm_tree")))
true)
# The cache must hit across PROCESSES: janet's (hash ...) is seeded per process,
# so a key built with it never matches a cached one and every invocation
# re-resolved (and re-fetched git deps). Detection: plant a sentinel root in the
# cache file — a fresh process that hits the cache returns it; a process that
# misses re-resolves and overwrites it.
(os/cd (string base "/proj"))
(def cache-file ".cpcache/jolt-deps.jdn")
(def cached-now (parse (slurp cache-file)))
(spit cache-file
(string/format "%j" (merge cached-now
{:roots [;(get cached-now :roots) "/SENTINEL"]})))
(defn subprocess-roots []
(def code
(string `(os/cd "` repo-root `") `
`(import ./src/jolt/deps :as deps) `
`(os/cd "` base "/proj" `") `
`(print (string/join (deps/resolve-deps-cached "deps.edn" "` base "/proj/jpm_tree" `") ":"))`))
(def p (os/spawn ["janet" "-e" code] :px {:out :pipe}))
(def out (ev/read (p :out) :all))
(os/proc-wait p)
(string/trim (string out)))
(check "cache hits across processes"
(string/has-suffix? "/SENTINEL" (subprocess-roots))
true)
(os/cd "/")
(rmrf base)
# Git-dep resolution must keep stdout clean: `JOLT_PATH=$(jolt-deps path)` is
# the documented capture, and git's checkout chatter ("HEAD is now at …") was
# corrupting it. Uses a file:// git dep so no network is needed.
(def gbase (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-deps-gitout-" (os/time)))
(rmrf gbase)
(each d ["lib/src/glib" "proj2"] (mkdirs (string gbase "/" d)))
(spit (string gbase "/lib/src/glib/core.clj") "(ns glib.core)\n(defn n [] 7)\n")
(spit (string gbase "/lib/deps.edn") `{:paths ["src"]}`)
(defn sh-out [args &opt cwd]
(def p (os/spawn args :px {:out :pipe :err :pipe :cd (or cwd ".")}))
(def out (ev/read (p :out) :all))
(os/proc-wait p)
(string/trim (string out)))
(def git-ok
(truthy?
(protect
(do (sh-out ["git" "-c" "init.defaultBranch=master" "init"] (string gbase "/lib"))
(sh-out ["git" "add" "-A"] (string gbase "/lib"))
(sh-out ["git" "-c" "user.email=t@t" "-c" "user.name=t" "commit" "-m" "init" "-q"]
(string gbase "/lib"))))))
(if (not git-ok)
(print " skip git-dep stdout test (git unavailable)")
(do
(def sha (sh-out ["git" "rev-parse" "HEAD"] (string gbase "/lib")))
(spit (string gbase "/proj2/deps.edn")
(string `{:paths ["src"] :deps {my/glib {:git/url "file://` gbase `/lib" :git/sha "` sha `"}}}`))
(os/setenv "JOLT_GITLIBS" (string gbase "/gitlibs"))
(def code
(string `(os/cd "` repo-root `") `
`(import ./src/jolt/deps :as deps) `
`(os/cd "` gbase "/proj2" `") `
`(deps/resolve-deps "deps.edn" "` gbase "/proj2/jpm_tree" `") `
`(eprint "done")`))
(def p (os/spawn ["janet" "-e" code] :px {:out :pipe}))
(def out (ev/read (p :out) :all))
(os/proc-wait p)
(os/setenv "JOLT_GITLIBS" nil)
(check "git-dep resolution keeps stdout clean" (string (or out "")) ""))
)
(rmrf gbase)
(if (> fails 0)
(error (string "deps-resolve-test: " fails " failing check(s)"))
(print "\nAll deps-resolve tests passed!"))

View file

@ -53,6 +53,10 @@
(print "5: require form (standalone)...")
(let [ctx (fresh-ctx)]
# Populate other.lib first — require of an unlocatable ns now throws
# (Clojure's FileNotFoundException), see namespaces-spec.
(let [other-ns (ctx-find-ns ctx "other.lib")]
(ns-intern other-ns "f" (fn [x] x)))
(eval-form ctx @{} (parse-string "(require '[other.lib :as o])"))
(let [ns (ctx-find-ns ctx "user")
aliased (ns-alias-lookup ns "o")]

View file

@ -10,6 +10,10 @@
(reader-features-set! ["jolt" "clj" "default"])
(def ctx (init-cached))
# Best-effort loading: SCI's clj-targeted requires (borkdude.graal.locking,
# clojure.tools.reader.*) don't exist on this host; a strict require would fail
# whole ns forms and cascade. See maybe-require-ns.
(put (ctx :env) :lenient-require? true)
(printf "Loading SCI stubs...\n")
(defn load-stubs [ctx filepath]

View file

@ -73,6 +73,9 @@
["do nested" "1" "(do (do (do (do 1))))"]
["do returns last" "3" "(do 1 2 3)"]
["def + deref var" "true" "(var? (def one 1))"]
["def no init interns var" "true" "(var? (def no-init))"]
["def no init keeps existing root" "7" "(do (def kept 7) (def kept) kept)"]
["declare interns var" "true" "(do (declare fwd-declared) (var? (var fwd-declared)))"]
["def redefine" "100" "(do (def one 1) (def one 100) one)"]
["def in fn mutates" "[:default :meow]" "(do (def a :default) (def set-a (fn* [v] (def a v))) (let* [before a] (set-a :meow) [before a]))"]
["call literal fn" "1" "((fn* [] 1))"]

View file

@ -34,7 +34,14 @@
["require clojure.set" "#{1 2 3}" "(do (require '[clojure.set :as set]) (set/union #{1 2} #{3}))"]
["require clojure.walk" "{:a 2}" "(do (require '[clojure.walk :as w]) (w/postwalk (fn [x] (if (number? x) (inc x) x)) {:a 1}))"]
["walk keywordize-keys" "{:a 1}" "(do (require '[clojure.walk :as w]) (w/keywordize-keys {\"a\" 1}))"]
["walk stringify-keys" "true" "(do (require '[clojure.walk :as w]) (= {\"a\" 1} (w/stringify-keys {:a 1})))"])
["walk stringify-keys" "true" "(do (require '[clojure.walk :as w]) (= {\"a\" 1} (w/stringify-keys {:a 1})))"]
# Clojure throws FileNotFoundException; silently succeeding masks typos and
# missing roots until the first unresolved-symbol error far from the cause.
["require missing lib throws" :throws "(require '[no.such.lib])"]
["use missing lib throws" :throws "(use 'no.such.lib)"]
# …but an ns created in-session is in *loaded-libs* (the ns macro puts it
# there), so require/use of it must NOT hit the loader.
["require of in-session ns ok" "1" "(do (ns made.here) (def x 1) (require '[made.here]) made.here/x)"])
(defspec "namespaces / alias, ns-unalias, ns-publics"
["alias + use" "\"1,2\"" "(do (require (quote clojure.string)) (alias (quote st) (quote clojure.string)) (st/join \",\" [1 2]))"]

View file

@ -73,6 +73,11 @@
["simple-ident?" "true" "(simple-ident? :a)"]
["ratio?" "false" "(ratio? 3)"]
["decimal?" "false" "(decimal? 3)"]
# No first-class Class objects on this host (class names are symbols handled
# in instance?/new positions), so class? is always false — like Clojure's
# class? of a symbol. Selmer's `exception` macro calls it at expansion time.
["class? of value" "false" "(class? \"s\")"]
["class? of symbol" "false" "(class? 'java.lang.String)"]
["rational? int" "true" "(rational? 3)"]
["rational? float" "false" "(rational? 3.5)"]
["nat-int? zero" "true" "(nat-int? 0)"]