diff --git a/jolt-core/clojure/core/00-syntax.clj b/jolt-core/clojure/core/00-syntax.clj index 347d467..4a7af14 100644 --- a/jolt-core/clojure/core/00-syntax.clj +++ b/jolt-core/clojure/core/00-syntax.clj @@ -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 diff --git a/jolt-core/clojure/core/20-coll.clj b/jolt-core/clojure/core/20-coll.clj index 4916706..a497819 100644 --- a/jolt-core/clojure/core/20-coll.clj +++ b/jolt-core/clojure/core/20-coll.clj @@ -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))) diff --git a/jolt-core/jolt/analyzer.clj b/jolt-core/jolt/analyzer.clj index 66ac5e7..b036650 100644 --- a/jolt-core/jolt/analyzer.clj +++ b/jolt-core/jolt/analyzer.clj @@ -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)))) diff --git a/src/jolt/deps.janet b/src/jolt/deps.janet index aef72f3..23ffaba 100644 --- a/src/jolt/deps.janet +++ b/src/jolt/deps.janet @@ -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) ---------------------------------- diff --git a/src/jolt/evaluator.janet b/src/jolt/evaluator.janet index 8beacac..949230c 100644 --- a/src/jolt/evaluator.janet +++ b/src/jolt/evaluator.janet @@ -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 diff --git a/test/integration/compile-mode-test.janet b/test/integration/compile-mode-test.janet index 236b1ce..b794fad 100644 --- a/test/integration/compile-mode-test.janet +++ b/test/integration/compile-mode-test.janet @@ -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!") diff --git a/test/integration/deps-resolve-test.janet b/test/integration/deps-resolve-test.janet index dadfbd5..1b308b9 100644 --- a/test/integration/deps-resolve-test.janet +++ b/test/integration/deps-resolve-test.janet @@ -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!")) diff --git a/test/integration/namespace-test.janet b/test/integration/namespace-test.janet index b11fa3d..4d05f50 100644 --- a/test/integration/namespace-test.janet +++ b/test/integration/namespace-test.janet @@ -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")] diff --git a/test/integration/sci-bootstrap-test.janet b/test/integration/sci-bootstrap-test.janet index 7bc44a4..38285af 100644 --- a/test/integration/sci-bootstrap-test.janet +++ b/test/integration/sci-bootstrap-test.janet @@ -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] diff --git a/test/spec/forms-spec.janet b/test/spec/forms-spec.janet index ca49330..b08f135 100644 --- a/test/spec/forms-spec.janet +++ b/test/spec/forms-spec.janet @@ -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))"] diff --git a/test/spec/namespaces-spec.janet b/test/spec/namespaces-spec.janet index 9b26b55..2e332d4 100644 --- a/test/spec/namespaces-spec.janet +++ b/test/spec/namespaces-spec.janet @@ -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]))"] diff --git a/test/spec/predicates-spec.janet b/test/spec/predicates-spec.janet index bb9b96d..a75370c 100644 --- a/test/spec/predicates-spec.janet +++ b/test/spec/predicates-spec.janet @@ -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)"]