core: Stage 2 Task 2 tier 4a — compile require + in-ns
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).
This commit is contained in:
parent
124cbf370a
commit
3709c868e6
6 changed files with 55 additions and 26 deletions
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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))]
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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")))
|
||||
|
|
|
|||
|
|
@ -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 @[])
|
||||
|
|
|
|||
|
|
@ -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")]
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue