core: close the compile-path gaps that broke uberscripting Selmer + config
Loading these libs via require worked (load-ns-source interprets, macros
expand lazily) but the same code inlined by uberscript routes through
eval-toplevel and compiled, surfacing four gaps:
- a ^{:map} metadata def name reads as (def (with-meta name m) v); the
analyzer died extracting the name (config.core's defonce env). It now
throws uncompilable so the interpreter, which handles it, takes over.
- declare was a no-op, so a compiled forward reference to a declared
name that collides with a janet root binding bound to the host fn
(selmer.parser's (declare parse) compiled to janet's 1-arg parse).
declare now expands to no-init defs, the interpreter interns them,
and the analyzer routes no-init def to the interpreter.
- class? was missing (selmer.util's exception macro calls it at
expansion time). Always false, like ratio? — no Class objects here.
- require of an unlocatable namespace silently left an empty ns behind,
deferring the failure to an unresolved symbol far from the cause. It
now throws like Clojure's FileNotFoundException. Namespaces entered
in-session count as loaded (Clojure puts them in *loaded-libs*), and
the SCI bootstrap opts out via :lenient-require? since its
clj-targeted requires can't all exist on this host.
This commit is contained in:
parent
c2511fee7e
commit
703a59d40b
10 changed files with 127 additions and 34 deletions
|
|
@ -116,9 +116,12 @@
|
||||||
`(~form ~x))]
|
`(~form ~x))]
|
||||||
`(->> ~threaded ~@(rest forms)))))
|
`(->> ~threaded ~@(rest forms)))))
|
||||||
|
|
||||||
;; Forward declaration is a no-op on Jolt — the compiler resolves forward refs via
|
;; Forward declaration interns unbound vars (Clojure semantics). The interpreter
|
||||||
;; pending cells (matching the prior Janet macro).
|
;; resolves forward refs lazily either way, but the COMPILER classifies globals at
|
||||||
(defmacro declare [& syms] `(do))
|
;; 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
|
;; destructure — Clojure's binding-vector expander, ported from the Janet seed
|
||||||
;; (was core-destructure). Turns a binding vector that may contain destructuring
|
;; (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?.
|
;; Jolt has no ratio or bigdecimal types, so these are constants / reduce to int?.
|
||||||
(defn ratio? [x] false)
|
(defn ratio? [x] false)
|
||||||
(defn decimal? [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 rational? [x] (int? x))
|
||||||
(defn nat-int? [x] (and (int? x) (>= x 0)))
|
(defn nat-int? [x] (and (int? x) (>= x 0)))
|
||||||
(defn neg-int? [x] (and (int? x) (neg? x)))
|
(defn neg-int? [x] (and (int? x) (neg? x)))
|
||||||
|
|
|
||||||
|
|
@ -140,11 +140,19 @@
|
||||||
(const nil)))
|
(const nil)))
|
||||||
"do" (analyze-seq ctx (rest items) env)
|
"do" (analyze-seq ctx (rest items) env)
|
||||||
"throw" (throw-node (analyze ctx (nth items 1) env))
|
"throw" (throw-node (analyze ctx (nth items 1) env))
|
||||||
"def" (let [name-sym (nth items 1)
|
"def" (let [name-sym (nth items 1)]
|
||||||
nm (form-sym-name name-sym)
|
;; ^{:map} metadata reads as (def (with-meta name m) v) — the
|
||||||
cur (compile-ns ctx)]
|
;; metadata is a runtime expression, so the interpreter evaluates
|
||||||
(host-intern! ctx cur nm)
|
;; the whole def (it unwraps the name and merges the meta).
|
||||||
(def-node cur nm (analyze ctx (nth items 2) env) (form-sym-meta name-sym)))
|
(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)))
|
"let*" (let [bvec (vec (form-vec-items (nth items 1)))
|
||||||
r (analyze-bindings ctx bvec env)]
|
r (analyze-bindings ctx bvec env)]
|
||||||
(let-node (first r) (analyze-seq ctx (drop 2 items) (second r))))
|
(let-node (first r) (analyze-seq ctx (drop 2 items) (second r))))
|
||||||
|
|
|
||||||
|
|
@ -340,10 +340,22 @@
|
||||||
for ns-form-less stdlib files, changes it). No-op for already-loaded namespaces."
|
for ns-form-less stdlib files, changes it). No-op for already-loaded namespaces."
|
||||||
[ctx ns-name]
|
[ctx ns-name]
|
||||||
(let [ns (ctx-find-ns 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)
|
(let [path (find-ns-file ctx ns-name)
|
||||||
embedded (get (get (ctx :env) :embedded-sources @{}) ns-name)
|
embedded (get (get (ctx :env) :embedded-sources @{}) ns-name)
|
||||||
stdlib? (not (nil? embedded))]
|
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)
|
(when (or path embedded)
|
||||||
(let [saved (ctx-current-ns ctx)]
|
(let [saved (ctx-current-ns ctx)]
|
||||||
# Stdlib files have no `ns` form, so switch into the target ns first
|
# Stdlib files have no `ns` form, so switch into the target ns first
|
||||||
|
|
@ -943,6 +955,13 @@
|
||||||
[ctx sym]
|
[ctx sym]
|
||||||
(def ns-name (if (and (struct? sym) (= :symbol (sym :jolt/type))) (sym :name) (string 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))
|
(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)
|
(ctx-set-current-ns ctx ns-name)
|
||||||
the-ns-obj)
|
the-ns-obj)
|
||||||
|
|
||||||
|
|
@ -1522,30 +1541,40 @@
|
||||||
ns-name (ctx-current-ns ctx)
|
ns-name (ctx-current-ns ctx)
|
||||||
ns (ctx-find-ns ctx ns-name)
|
ns (ctx-find-ns ctx ns-name)
|
||||||
# Create var first (unbound) so self-referencing defs resolve
|
# Create var first (unbound) so self-referencing defs resolve
|
||||||
v (ns-intern ns (name-sym :name))
|
v (ns-intern ns (name-sym :name))]
|
||||||
# (def name docstring value): docstring is form 2, value form 3
|
# (def name) with no init interns the var and leaves any existing
|
||||||
has-doc (and (> (length form) 3) (string? (in form 2)))
|
# root binding alone (Clojure semantics — this is what declare
|
||||||
val-form (in form (if has-doc 3 2))
|
# expands to, so compiled forward refs bind to the var instead of
|
||||||
val (eval-form ctx bindings val-form)]
|
# falling through to a like-named host builtin).
|
||||||
(bind-root v val)
|
(if (= 2 (length form))
|
||||||
# Staged bootstrap (jolt-4j3): pre/at-kernel overlay defns load
|
(do
|
||||||
# interpreted; stash the fn source so backend/recompile-defns! can
|
(when (not (empty? name-meta))
|
||||||
# compile them once the analyzer is alive — the defn analog of
|
(put v :meta (merge (or (get v :meta) {}) name-meta)))
|
||||||
# :macro-src. Only set while api/load-core-overlay! loads the early
|
(when dynamic? (put v :dynamic true))
|
||||||
# tiers (the flag scopes it away from user code).
|
v)
|
||||||
(when (and (get (ctx :env) :stash-defn-src?)
|
(let [# (def name docstring value): docstring form 2, value form 3
|
||||||
(function? val)
|
has-doc (and (> (length form) 3) (string? (in form 2)))
|
||||||
(array? val-form) (> (length val-form) 0)
|
val-form (in form (if has-doc 3 2))
|
||||||
(or (sym-name? (first val-form) "fn")
|
val (eval-form ctx bindings val-form)]
|
||||||
(sym-name? (first val-form) "fn*")))
|
(bind-root v val)
|
||||||
(put v :defn-src val-form))
|
# Staged bootstrap (jolt-4j3): pre/at-kernel overlay defns load
|
||||||
(let [extra (if has-doc (merge name-meta {:doc (in form 2)}) name-meta)]
|
# interpreted; stash the fn source so backend/recompile-defns! can
|
||||||
(when (not (empty? extra))
|
# compile them once the analyzer is alive — the defn analog of
|
||||||
(put v :meta (merge (or (get v :meta) {}) extra))))
|
# :macro-src. Only set while api/load-core-overlay! loads the early
|
||||||
(when dynamic?
|
# tiers (the flag scopes it away from user code).
|
||||||
(put v :dynamic true))
|
(when (and (get (ctx :env) :stash-defn-src?)
|
||||||
# def returns the var (Clojure semantics); REPL prints #'ns/name
|
(function? val)
|
||||||
v)
|
(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)
|
"defmacro" (let [name-sym (in form 1)
|
||||||
rest-form (tuple/slice form 2)
|
rest-form (tuple/slice form 2)
|
||||||
# optional docstring
|
# optional docstring
|
||||||
|
|
|
||||||
|
|
@ -138,4 +138,31 @@
|
||||||
(eval-string c "(defn g [] 2)")
|
(eval-string c "(defn g [] 2)")
|
||||||
(assert (= 2 (ct-eval c "(calls-g)")) "compiled caller sees redefined global"))
|
(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!")
|
(print "\nAll Phase 6 tests passed!")
|
||||||
|
|
|
||||||
|
|
@ -53,6 +53,10 @@
|
||||||
|
|
||||||
(print "5: require form (standalone)...")
|
(print "5: require form (standalone)...")
|
||||||
(let [ctx (fresh-ctx)]
|
(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])"))
|
(eval-form ctx @{} (parse-string "(require '[other.lib :as o])"))
|
||||||
(let [ns (ctx-find-ns ctx "user")
|
(let [ns (ctx-find-ns ctx "user")
|
||||||
aliased (ns-alias-lookup ns "o")]
|
aliased (ns-alias-lookup ns "o")]
|
||||||
|
|
|
||||||
|
|
@ -10,6 +10,10 @@
|
||||||
(reader-features-set! ["jolt" "clj" "default"])
|
(reader-features-set! ["jolt" "clj" "default"])
|
||||||
|
|
||||||
(def ctx (init-cached))
|
(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")
|
(printf "Loading SCI stubs...\n")
|
||||||
(defn load-stubs [ctx filepath]
|
(defn load-stubs [ctx filepath]
|
||||||
|
|
|
||||||
|
|
@ -73,6 +73,9 @@
|
||||||
["do nested" "1" "(do (do (do (do 1))))"]
|
["do nested" "1" "(do (do (do (do 1))))"]
|
||||||
["do returns last" "3" "(do 1 2 3)"]
|
["do returns last" "3" "(do 1 2 3)"]
|
||||||
["def + deref var" "true" "(var? (def one 1))"]
|
["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 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]))"]
|
["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))"]
|
["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.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}))"]
|
["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 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"
|
(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]))"]
|
["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)"]
|
["simple-ident?" "true" "(simple-ident? :a)"]
|
||||||
["ratio?" "false" "(ratio? 3)"]
|
["ratio?" "false" "(ratio? 3)"]
|
||||||
["decimal?" "false" "(decimal? 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? int" "true" "(rational? 3)"]
|
||||||
["rational? float" "false" "(rational? 3.5)"]
|
["rational? float" "false" "(rational? 3.5)"]
|
||||||
["nat-int? zero" "true" "(nat-int? 0)"]
|
["nat-int? zero" "true" "(nat-int? 0)"]
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue