Merge pull request #71 from jolt-lang/greeter-example-fixes
deps + compile fixes surfaced by the greeter example
This commit is contained in:
commit
1a2841b02f
12 changed files with 214 additions and 44 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
|
|
|||
|
|
@ -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) ----------------------------------
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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!")
|
||||
|
|
|
|||
|
|
@ -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!"))
|
||||
|
|
|
|||
|
|
@ -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")]
|
||||
|
|
|
|||
|
|
@ -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]
|
||||
|
|
|
|||
|
|
@ -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))"]
|
||||
|
|
|
|||
|
|
@ -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]))"]
|
||||
|
|
|
|||
|
|
@ -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)"]
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue