11fb5a7de6
* core: Stage 2 Task 2 tier 5a — compile defmulti + defmethod
defmulti/defmethod become macros (30-macros) over ctx-capturing
clojure.core fns (defmulti-setup/defmethod-setup, interned by
install-stateful-fns!):
- defmulti: (defmulti name dispatch & opts) -> (defmulti-setup 'name
dispatch ~@opts). name quoted; dispatch + opts (:default/:hierarchy)
evaluated. defmulti-setup builds the dispatch closure over the method
table and interns the var (same hierarchy/default/cache behavior).
- defmethod: (defmethod mm dval & fn-tail) -> (defmethod-setup 'mm dval
(fn ~@fn-tail)). The method impl is now a COMPILED (fn …) (was an
interpreted fn* eval). Auto-creates the multimethod if missing.
- removed their special-symbol? entries + eval-list arms, and dropped them
from host_iface special-names + loader stateful-head?.
Both compile + interpret as plain invokes; dispatch incl. :default and
derive/hierarchy works in both modes.
Tests: evaluator-test (defmulti case) + namespace-test now use init (these
forms are overlay macros now, so a bare make-ctx lacks them).
Gate green: conformance 269x3, fallback-zero 38/4, bootstrap-fixpoint
stage1==2==3, self-host, staged-bootstrap, sci-bootstrap, clojure-test-suite
>=4034/67, features 78/78, all unit + spec (multimethods 16/16).
* core: Stage 2 Task 2 tier 5b — compile deftype + defrecord
deftype becomes a macro (30-macros) over make-deftype-ctor (a ctx-capturing
clojure.core fn that bakes the ns-qualified type tag at def time) plus
extend-type for any inline protocol methods — so it compiles as a plain (do …).
Mirrors defrecord's existing field-let/protocol-grouping pattern.
- make-deftype-ctor-impl (evaluator) builds the ctor; interned as a closure.
- removed the deftype special-symbol? entry + eval-list arm; dropped deftype/
defrecord from host_iface special-names + loader stateful-head?.
- defrecord no longer redefines ->name via (Name. …) interop (frozen) — deftype
already provides ->name, so defrecord compiles too (map->name builds via it).
- field-kws spliced into a vector LITERAL ([~@…]) so the analyzer sees a vector
form, not a runtime pvec; type name + fields are unwrapped of ^meta (the reader
yields (with-meta sym m) forms, e.g. sci's (deftype ^{:doc …} Var …)).
With tier 5a, all of deftype/defrecord/defmulti/defmethod compile. The loader's
interpret-only set is now just the frozen host-coupled forms: defmacro/set!/./
new/eval.
Tests: evaluator-test deftype case uses init (deftype is an overlay macro now);
fallback-zero moves deftype off must-punt, adds deftype/defrecord/defmulti/
defmethod to must-compile (43/3).
Gate green (full jpm build + jpm test): conformance 269x3, fallback-zero 43/3,
bootstrap-fixpoint stage1==2==3, self-host, staged-bootstrap, sci-bootstrap
422/0, clojure-test-suite >=4034/67, all unit + spec.
---------
Co-authored-by: Yogthos <yogthos@gmail.com>
98 lines
3.5 KiB
Text
98 lines
3.5 KiB
Text
(use ../../src/jolt/reader)
|
|
(use ../../src/jolt/types)
|
|
(use ../../src/jolt/evaluator)
|
|
(import ../../src/jolt/api :as api)
|
|
|
|
# ns/in-ns/require/use are overlay macros + clojure.core fns now (Stage 2 jolt-eaa),
|
|
# so these interpreter tests need the full env (init loads the overlay + installs
|
|
# the stateful fns), not a bare make-ctx.
|
|
(defn- fresh-ctx [] (api/init))
|
|
|
|
# Helper: parse and eval in a fresh ctx
|
|
(defn eval-str [s]
|
|
(let [ctx (fresh-ctx)
|
|
form (parse-string s)]
|
|
(eval-form ctx @{} form)))
|
|
|
|
(print "1: in-ns...")
|
|
(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 (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")
|
|
v (ns-find ns "x")]
|
|
(assert (= 42 (var-get v)) "def works in new namespace")))
|
|
(print " passed")
|
|
|
|
(print "3: ns form...")
|
|
(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 (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))))
|
|
# Now ns with require
|
|
(eval-form ctx @{} (parse-string "(ns my.app (:require [other.lib :as o]))"))
|
|
# current-ns should be my.app
|
|
(assert (= "my.app" (ctx-current-ns ctx)) "ns with require sets current namespace")
|
|
# Alias should be registered
|
|
(let [ns (ctx-find-ns ctx "my.app")
|
|
aliased (ns-import-lookup ns "o")]
|
|
(assert (= "other.lib" aliased) "alias o -> other.lib registered")))
|
|
(print " passed")
|
|
|
|
(print "5: require form (standalone)...")
|
|
(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")]
|
|
(assert (= "other.lib" aliased) "standalone require registers alias")))
|
|
(print " passed")
|
|
|
|
(print "6: qualified symbol via alias...")
|
|
(let [ctx (fresh-ctx)]
|
|
# Set up target ns
|
|
(let [target (ctx-find-ns ctx "other.lib")]
|
|
(ns-intern target "f" (fn [x] (inc x))))
|
|
# Register alias
|
|
(let [ns (ctx-find-ns ctx "user")]
|
|
(ns-import ns "o" "other.lib"))
|
|
# Resolve o/f and call it
|
|
(let [form (parse-string "(o/f 41)")
|
|
result (eval-form ctx @{} form)]
|
|
(assert (= 42 result) "qualified call via alias works")))
|
|
(print " passed")
|
|
|
|
(print "7: require then use alias...")
|
|
(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))))
|
|
# require + use
|
|
(eval-form ctx @{} (parse-string "(require '[math.lib :as m])"))
|
|
(let [result (eval-form ctx @{} (parse-string "(m/add 1 2)"))]
|
|
(assert (= 3 result) "require + alias + call chain works")))
|
|
(print " passed")
|
|
|
|
(print "8: ns form requires multiple...")
|
|
(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")]
|
|
(ns-intern ns2 "g" (fn [x] (dec x))))
|
|
(eval-form ctx @{} (parse-string "(ns user (:require [a.lib :as a] [b.lib :as b]))"))
|
|
(assert (= 43 (eval-form ctx @{} (parse-string "(a/f 42)"))) "alias a works")
|
|
(assert (= 41 (eval-form ctx @{} (parse-string "(b/g 42)"))) "alias b works"))
|
|
(print " passed")
|
|
|
|
(print "\nAll namespace tests passed!")
|