From e8c19c351f1509847240f86df00a54ed140ead32 Mon Sep 17 00:00:00 2001 From: Dmitri Sotnikov Date: Wed, 10 Jun 2026 03:37:55 +0800 Subject: [PATCH] =?UTF-8?q?core:=20Stage=202=20Task=202=20tier=204a=20?= =?UTF-8?q?=E2=80=94=20compile=20require=20+=20in-ns=20(#14)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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 --- src/jolt/compiler.janet | 2 +- src/jolt/evaluator.janet | 35 ++++++++++++++++------- src/jolt/host_iface.janet | 3 +- src/jolt/loader.janet | 1 - test/integration/fallback-zero-test.janet | 15 +++++++--- test/integration/namespace-test.janet | 25 ++++++++++------ 6 files changed, 55 insertions(+), 26 deletions(-) diff --git a/src/jolt/compiler.janet b/src/jolt/compiler.janet index d3f60b0..7dac091 100644 --- a/src/jolt/compiler.janet +++ b/src/jolt/compiler.janet @@ -159,7 +159,7 @@ "defmethod" "prefer-method" "remove-method" "remove-all-methods" "get-method" "methods" "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" "ns-resolve" "ns-aliases" "ns-imports" "ns-interns" "alter-var-root" "alter-meta!" "reset-meta!" "locking" "new" diff --git a/src/jolt/evaluator.janet b/src/jolt/evaluator.janet index 6c07416..1c9f3d3 100644 --- a/src/jolt/evaluator.janet +++ b/src/jolt/evaluator.janet @@ -751,6 +751,27 @@ (each p pairs (put (obj :jolt/protocol-methods) (in p 0) (in p 1))) 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! "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 @@ -766,6 +787,8 @@ (register-method-impl ctx type-name proto-name method-name f))) (ns-intern core "make-reified" (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) # Dispatch a special form by its string name. @@ -972,11 +995,8 @@ (set i (+ i 1))) (do (set result clause) (++ i))))))) result) - "require" (let [spec0 (eval-form ctx bindings (in form 1)) - spec (if (pvec? spec0) (pv->array spec0) spec0)] - (if (and (indexed? spec) (> (length spec) 0)) - (eval-require ctx spec) - (error "require expects a vector spec"))) + # require / in-ns are now ordinary clojure.core fns (install-stateful-fns!) — + # no special-form arm; they compile + interpret as plain invokes. "all-ns" (all-ns ctx) "the-ns" (the-ns ctx) "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-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)) - "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))] (if (and (struct? sym) (= :symbol (sym :jolt/type))) (let [r (protect (resolve-var ctx bindings sym))] diff --git a/src/jolt/host_iface.janet b/src/jolt/host_iface.janet index 0edf6db..802a720 100644 --- a/src/jolt/host_iface.janet +++ b/src/jolt/host_iface.janet @@ -82,7 +82,8 @@ # ns-management forms dispatched by the interpreter (not core vars) "create-ns" "remove-ns" "find-ns" "all-ns" "the-ns" "resolve" "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" # defprotocol/extend-type/extend-protocol/reify now expand to plain # def + protocol-dispatch/register-method/make-reified invokes. diff --git a/src/jolt/loader.janet b/src/jolt/loader.janet index 36b5edc..d5e4103 100644 --- a/src/jolt/loader.janet +++ b/src/jolt/loader.janet @@ -15,7 +15,6 @@ (defn- stateful-head? [head-name] (or (= head-name "defmacro") (= head-name "ns") (= head-name "deftype") (= head-name "defmulti") (= head-name "defmethod") - (= head-name "require") (= head-name "in-ns") (= head-name "set!") (= head-name ".") (= head-name "new") (= head-name "eval"))) diff --git a/test/integration/fallback-zero-test.janet b/test/integration/fallback-zero-test.janet index c5bcc50..30529ce 100644 --- a/test/integration/fallback-zero-test.janet +++ b/test/integration/fallback-zero-test.janet @@ -42,13 +42,20 @@ "(def answer 42)" "(map inc [1 2 3])" "(reduce + 0 [1 2 3])" "(get {:a 1} :a)" "(vec (range 5))" # 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. -# Not the frozen set (that's Task 2) — just a few to confirm the boundary holds -# in the punt direction so the harness can't pass by compiling everything. +# Shrinking as Stage 2 (jolt-eaa) moves stateful forms onto the compile path +# (require/in-ns/protocols/binding now compile). The remaining frozen/uncompiled +# set keeps the harness honest in the punt direction. (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))"]) (var fails @[]) diff --git a/test/integration/namespace-test.janet b/test/integration/namespace-test.janet index 1c582f2..6362cee 100644 --- a/test/integration/namespace-test.janet +++ b/test/integration/namespace-test.janet @@ -2,21 +2,28 @@ (use ../../src/jolt/types) (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 (defn eval-str [s] - (let [ctx (make-ctx) + (let [ctx (fresh-ctx) form (parse-string s)] (eval-form ctx @{} form))) (print "1: in-ns...") -(let [ctx (make-ctx)] +(let [ctx (fresh-ctx)] (def form (parse-string "(in-ns 'my.app)")) (eval-form ctx @{} form) (assert (= "my.app" (ctx-current-ns ctx)) "in-ns switches namespace")) (print " passed") (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 "(def x 42)")) (let [ns (ctx-find-ns ctx "my.app") @@ -25,13 +32,13 @@ (print " passed") (print "3: ns form...") -(let [ctx (make-ctx)] +(let [ctx (fresh-ctx)] (eval-form ctx @{} (parse-string "(ns my.lib)")) (assert (= "my.lib" (ctx-current-ns ctx)) "ns sets current namespace")) (print " passed") (print "4: ns with require...") -(let [ctx (make-ctx)] +(let [ctx (fresh-ctx)] # Set up a namespace with some vars (let [other-ns (ctx-find-ns ctx "other.lib")] (ns-intern other-ns "f" (fn [x] (inc x)))) @@ -46,7 +53,7 @@ (print " passed") (print "5: require form (standalone)...") -(let [ctx (make-ctx)] +(let [ctx (fresh-ctx)] (eval-form ctx @{} (parse-string "(require '[other.lib :as o])")) (let [ns (ctx-find-ns ctx "user") aliased (ns-import-lookup ns "o")] @@ -54,7 +61,7 @@ (print " passed") (print "6: qualified symbol via alias...") -(let [ctx (make-ctx)] +(let [ctx (fresh-ctx)] # Set up target ns (let [target (ctx-find-ns ctx "other.lib")] (ns-intern target "f" (fn [x] (inc x)))) @@ -68,7 +75,7 @@ (print " passed") (print "7: require then use alias...") -(let [ctx (make-ctx)] +(let [ctx (fresh-ctx)] # Set up target ns (let [target (ctx-find-ns ctx "math.lib")] (ns-intern target "add" (fn [a b] (+ a b)))) @@ -79,7 +86,7 @@ (print " passed") (print "8: ns form requires multiple...") -(let [ctx (make-ctx)] +(let [ctx (fresh-ctx)] (let [ns1 (ctx-find-ns ctx "a.lib")] (ns-intern ns1 "f" (fn [x] (inc x)))) (let [ns2 (ctx-find-ns ctx "b.lib")]