core: Stage 2 Task 2 tier 4a — compile require + in-ns (#14)

require/in-ns take quoted (already-evaluated) args, so they become ordinary
ctx-capturing clojure.core fns (install-stateful-fns!):
- require-impl (varargs over specs -> eval-require) / in-ns-impl, extracted
  from the eval-list special arms.
- removed their eval-list match arms (they fall through to the function-call
  default, resolving the interned closures) and dropped them from
  host_iface special-names + loader stateful-head? + compiler
  uncompilable-heads.

require+alias+refer and in-ns now compile + interpret as plain invokes.

Tests: namespace-test uses bare make-ctx, so it now installs the stateful
fns via a fresh-ctx helper (api/init does this automatically). fallback-zero
moves require off must-punt and adds require/in-ns/defprotocol/extend-type/
reify/(var map) to must-compile (37 now); deftype takes require's must-punt
slot.

Gate green: conformance 267x3, fallback-zero 37/5, bootstrap-fixpoint
stage1==2==3, self-host, staged-bootstrap, clojure-test-suite >=4034/67,
features 78/78, deps-loader, all unit + spec (namespaces 24/24).

Co-authored-by: Yogthos <yogthos@gmail.com>
This commit is contained in:
Dmitri Sotnikov 2026-06-10 03:37:55 +08:00 committed by GitHub
parent 124cbf370a
commit e8c19c351f
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
6 changed files with 55 additions and 26 deletions

View file

@ -159,7 +159,7 @@
"defmethod" "prefer-method" "remove-method" "remove-all-methods" "defmethod" "prefer-method" "remove-method" "remove-all-methods"
"get-method" "methods" "get-method" "methods"
"satisfies?" "instance?" "set!" "var" "var-get" "satisfies?" "instance?" "set!" "var" "var-get"
"var-set" "var?" "in-ns" "ns" "require" "create-ns" "remove-ns" "var-set" "var?" "ns" "create-ns" "remove-ns"
"find-ns" "all-ns" "the-ns" "find-var" "intern" "resolve" "find-ns" "all-ns" "the-ns" "find-var" "intern" "resolve"
"ns-resolve" "ns-aliases" "ns-imports" "ns-interns" "ns-resolve" "ns-aliases" "ns-imports" "ns-interns"
"alter-var-root" "alter-meta!" "reset-meta!" "locking" "new" "alter-var-root" "alter-meta!" "reset-meta!" "locking" "new"

View file

@ -751,6 +751,27 @@
(each p pairs (put (obj :jolt/protocol-methods) (in p 0) (in p 1))) (each p pairs (put (obj :jolt/protocol-methods) (in p 0) (in p 1)))
obj) obj)
(defn require-impl
"(require '[ns :as a :refer [...]] ...) — load + alias/refer each spec. A fn, so
the args (quoted specs) arrive evaluated. Varargs (Clojure-compatible); each spec
is a vector. eval-require does the namespace load + alias/refer into current-ns."
[ctx & specs]
(each spec specs
(let [s (if (pvec? spec) (pv->array spec) spec)]
(if (and (indexed? s) (> (length s) 0))
(eval-require ctx s)
(error "require expects a vector spec"))))
nil)
(defn in-ns-impl
"(in-ns 'foo) — switch the current namespace (creating it if needed). A fn; the
quoted symbol arrives evaluated."
[ctx sym]
(def ns-name (if (and (struct? sym) (= :symbol (sym :jolt/type))) (sym :name) (string sym)))
(ctx-find-ns ctx ns-name)
(ctx-set-current-ns ctx ns-name)
nil)
(defn install-stateful-fns! (defn install-stateful-fns!
"Intern ctx-capturing closures for the stateful primitives into clojure.core, so "Intern ctx-capturing closures for the stateful primitives into clojure.core, so
both the interpreter and the compiler reach them as ordinary fns. Called by both the interpreter and the compiler reach them as ordinary fns. Called by
@ -766,6 +787,8 @@
(register-method-impl ctx type-name proto-name method-name f))) (register-method-impl ctx type-name proto-name method-name f)))
(ns-intern core "make-reified" (ns-intern core "make-reified"
(fn [proto-name methods-map] (make-reified-impl ctx proto-name methods-map))) (fn [proto-name methods-map] (make-reified-impl ctx proto-name methods-map)))
(ns-intern core "require" (fn [& specs] (require-impl ctx ;specs)))
(ns-intern core "in-ns" (fn [sym] (in-ns-impl ctx sym)))
core) core)
# Dispatch a special form by its string name. # Dispatch a special form by its string name.
@ -972,11 +995,8 @@
(set i (+ i 1))) (set i (+ i 1)))
(do (set result clause) (++ i))))))) (do (set result clause) (++ i)))))))
result) result)
"require" (let [spec0 (eval-form ctx bindings (in form 1)) # require / in-ns are now ordinary clojure.core fns (install-stateful-fns!) —
spec (if (pvec? spec0) (pv->array spec0) spec0)] # no special-form arm; they compile + interpret as plain invokes.
(if (and (indexed? spec) (> (length spec) 0))
(eval-require ctx spec)
(error "require expects a vector spec")))
"all-ns" (all-ns ctx) "all-ns" (all-ns ctx)
"the-ns" (the-ns ctx) "the-ns" (the-ns ctx)
"create-ns" (create-ns ctx (sym-name-str (in form 1))) "create-ns" (create-ns ctx (sym-name-str (in form 1)))
@ -985,11 +1005,6 @@
"ns-aliases" (let [ns (ctx-find-ns ctx (ctx-current-ns ctx))] (ns :aliases)) "ns-aliases" (let [ns (ctx-find-ns ctx (ctx-current-ns ctx))] (ns :aliases))
"ns-imports" (let [ns (ctx-find-ns ctx (ctx-current-ns ctx))] (ns :imports)) "ns-imports" (let [ns (ctx-find-ns ctx (ctx-current-ns ctx))] (ns :imports))
"ns-resolve" (ns-resolve (ctx-find-ns ctx (ctx-current-ns ctx)) (in form 1)) "ns-resolve" (ns-resolve (ctx-find-ns ctx (ctx-current-ns ctx)) (in form 1))
"in-ns" (let [sym (eval-form ctx bindings (in form 1))
ns-name (if (and (struct? sym) (= :symbol (sym :jolt/type))) (sym :name) (string sym))]
(ctx-find-ns ctx ns-name)
(ctx-set-current-ns ctx ns-name)
nil)
"resolve" (let [sym (eval-form ctx bindings (in form 1))] "resolve" (let [sym (eval-form ctx bindings (in form 1))]
(if (and (struct? sym) (= :symbol (sym :jolt/type))) (if (and (struct? sym) (= :symbol (sym :jolt/type)))
(let [r (protect (resolve-var ctx bindings sym))] (let [r (protect (resolve-var ctx bindings sym))]

View file

@ -82,7 +82,8 @@
# ns-management forms dispatched by the interpreter (not core vars) # ns-management forms dispatched by the interpreter (not core vars)
"create-ns" "remove-ns" "find-ns" "all-ns" "the-ns" "resolve" "create-ns" "remove-ns" "find-ns" "all-ns" "the-ns" "resolve"
"ns-resolve" "ns-aliases" "ns-imports" "ns-interns" "ns-resolve" "ns-aliases" "ns-imports" "ns-interns"
"read-string" "macroexpand-1" "defonce" "ns" "in-ns" "require" # require/in-ns are now clojure.core fns (compile as plain invokes).
"read-string" "macroexpand-1" "defonce" "ns"
"import" "use" "refer" "defrecord" "import" "use" "refer" "defrecord"
# defprotocol/extend-type/extend-protocol/reify now expand to plain # defprotocol/extend-type/extend-protocol/reify now expand to plain
# def + protocol-dispatch/register-method/make-reified invokes. # def + protocol-dispatch/register-method/make-reified invokes.

View file

@ -15,7 +15,6 @@
(defn- stateful-head? [head-name] (defn- stateful-head? [head-name]
(or (= head-name "defmacro") (= head-name "ns") (or (= head-name "defmacro") (= head-name "ns")
(= head-name "deftype") (= head-name "defmulti") (= head-name "defmethod") (= head-name "deftype") (= head-name "defmulti") (= head-name "defmethod")
(= head-name "require") (= head-name "in-ns")
(= head-name "set!") (= head-name "set!")
(= head-name ".") (= head-name "new") (= head-name ".") (= head-name "new")
(= head-name "eval"))) (= head-name "eval")))

View file

@ -42,13 +42,20 @@
"(def answer 42)" "(map inc [1 2 3])" "(reduce + 0 [1 2 3])" "(def answer 42)" "(map inc [1 2 3])" "(reduce + 0 [1 2 3])"
"(get {:a 1} :a)" "(vec (range 5))" "(get {:a 1} :a)" "(vec (range 5))"
# set?/disj are plain fns now, not special forms (jolt-g3h) # set?/disj are plain fns now, not special forms (jolt-g3h)
"(set? #{1 2})" "(disj #{1 2 3} 2)"]) "(set? #{1 2})" "(disj #{1 2 3} 2)"
# Stage 2 (jolt-eaa): stateful forms moved onto the compile path. (binding only
# compiles over an INTERNED var; the built-in dynamic vars aren't interned yet,
# so it's exercised end-to-end in the state spec instead.)
"(require (quote [clojure.string :as s]))" "(in-ns (quote foo.bar))"
"(defprotocol P (m [x]))" "(extend-type Long P (m [x] x))"
"(reify P (m [this] 1))" "(var map)"])
# --- Intentional fallback (sanity sample): these SHOULD punt to the interpreter. # --- Intentional fallback (sanity sample): these SHOULD punt to the interpreter.
# Not the frozen set (that's Task 2) — just a few to confirm the boundary holds # Shrinking as Stage 2 (jolt-eaa) moves stateful forms onto the compile path
# in the punt direction so the harness can't pass by compiling everything. # (require/in-ns/protocols/binding now compile). The remaining frozen/uncompiled
# set keeps the harness honest in the punt direction.
(def must-punt (def must-punt
["(ns foo.bar)" "(defmacro m [x] x)" "(require (quote [clojure.string]))" ["(ns foo.bar)" "(defmacro m [x] x)" "(deftype T [a])"
"(set! *warn-on-reflection* true)" "(letfn [(f [n] (g n)) (g [n] (f n))] (f 1))"]) "(set! *warn-on-reflection* true)" "(letfn [(f [n] (g n)) (g [n] (f n))] (f 1))"])
(var fails @[]) (var fails @[])

View file

@ -2,21 +2,28 @@
(use ../../src/jolt/types) (use ../../src/jolt/types)
(use ../../src/jolt/evaluator) (use ../../src/jolt/evaluator)
# in-ns/require are now ordinary clojure.core fns (Stage 2 jolt-eaa), interned by
# install-stateful-fns! — api/init does this; a bare make-ctx must do it too.
(defn- fresh-ctx []
(let [ctx (make-ctx)]
(install-stateful-fns! ctx)
ctx))
# Helper: parse and eval in a fresh ctx # Helper: parse and eval in a fresh ctx
(defn eval-str [s] (defn eval-str [s]
(let [ctx (make-ctx) (let [ctx (fresh-ctx)
form (parse-string s)] form (parse-string s)]
(eval-form ctx @{} form))) (eval-form ctx @{} form)))
(print "1: in-ns...") (print "1: in-ns...")
(let [ctx (make-ctx)] (let [ctx (fresh-ctx)]
(def form (parse-string "(in-ns 'my.app)")) (def form (parse-string "(in-ns 'my.app)"))
(eval-form ctx @{} form) (eval-form ctx @{} form)
(assert (= "my.app" (ctx-current-ns ctx)) "in-ns switches namespace")) (assert (= "my.app" (ctx-current-ns ctx)) "in-ns switches namespace"))
(print " passed") (print " passed")
(print "2: def in different namespace...") (print "2: def in different namespace...")
(let [ctx (make-ctx)] (let [ctx (fresh-ctx)]
(eval-form ctx @{} (parse-string "(in-ns 'my.app)")) (eval-form ctx @{} (parse-string "(in-ns 'my.app)"))
(eval-form ctx @{} (parse-string "(def x 42)")) (eval-form ctx @{} (parse-string "(def x 42)"))
(let [ns (ctx-find-ns ctx "my.app") (let [ns (ctx-find-ns ctx "my.app")
@ -25,13 +32,13 @@
(print " passed") (print " passed")
(print "3: ns form...") (print "3: ns form...")
(let [ctx (make-ctx)] (let [ctx (fresh-ctx)]
(eval-form ctx @{} (parse-string "(ns my.lib)")) (eval-form ctx @{} (parse-string "(ns my.lib)"))
(assert (= "my.lib" (ctx-current-ns ctx)) "ns sets current namespace")) (assert (= "my.lib" (ctx-current-ns ctx)) "ns sets current namespace"))
(print " passed") (print " passed")
(print "4: ns with require...") (print "4: ns with require...")
(let [ctx (make-ctx)] (let [ctx (fresh-ctx)]
# Set up a namespace with some vars # Set up a namespace with some vars
(let [other-ns (ctx-find-ns ctx "other.lib")] (let [other-ns (ctx-find-ns ctx "other.lib")]
(ns-intern other-ns "f" (fn [x] (inc x)))) (ns-intern other-ns "f" (fn [x] (inc x))))
@ -46,7 +53,7 @@
(print " passed") (print " passed")
(print "5: require form (standalone)...") (print "5: require form (standalone)...")
(let [ctx (make-ctx)] (let [ctx (fresh-ctx)]
(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-import-lookup ns "o")] aliased (ns-import-lookup ns "o")]
@ -54,7 +61,7 @@
(print " passed") (print " passed")
(print "6: qualified symbol via alias...") (print "6: qualified symbol via alias...")
(let [ctx (make-ctx)] (let [ctx (fresh-ctx)]
# Set up target ns # Set up target ns
(let [target (ctx-find-ns ctx "other.lib")] (let [target (ctx-find-ns ctx "other.lib")]
(ns-intern target "f" (fn [x] (inc x)))) (ns-intern target "f" (fn [x] (inc x))))
@ -68,7 +75,7 @@
(print " passed") (print " passed")
(print "7: require then use alias...") (print "7: require then use alias...")
(let [ctx (make-ctx)] (let [ctx (fresh-ctx)]
# Set up target ns # Set up target ns
(let [target (ctx-find-ns ctx "math.lib")] (let [target (ctx-find-ns ctx "math.lib")]
(ns-intern target "add" (fn [a b] (+ a b)))) (ns-intern target "add" (fn [a b] (+ a b))))
@ -79,7 +86,7 @@
(print " passed") (print " passed")
(print "8: ns form requires multiple...") (print "8: ns form requires multiple...")
(let [ctx (make-ctx)] (let [ctx (fresh-ctx)]
(let [ns1 (ctx-find-ns ctx "a.lib")] (let [ns1 (ctx-find-ns ctx "a.lib")]
(ns-intern ns1 "f" (fn [x] (inc x)))) (ns-intern ns1 "f" (fn [x] (inc x))))
(let [ns2 (ctx-find-ns ctx "b.lib")] (let [ns2 (ctx-find-ns ctx "b.lib")]