From 11fb5a7de61aae28f82439a64791dc8bfc196c73 Mon Sep 17 00:00:00 2001 From: Dmitri Sotnikov Date: Wed, 10 Jun 2026 08:13:42 +0800 Subject: [PATCH] Stage2 task2 tier5 (#16) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * 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 --- jolt-core/clojure/core/30-macros.clj | 45 ++++- src/jolt/evaluator.janet | 233 +++++++++------------- src/jolt/host_iface.janet | 9 +- src/jolt/loader.janet | 1 - test/integration/fallback-zero-test.janet | 12 +- test/integration/namespace-test.janet | 11 +- test/unit/evaluator-test.janet | 7 +- 7 files changed, 156 insertions(+), 162 deletions(-) diff --git a/jolt-core/clojure/core/30-macros.clj b/jolt-core/clojure/core/30-macros.clj index 8378619..34eaa4b 100644 --- a/jolt-core/clojure/core/30-macros.clj +++ b/jolt-core/clojure/core/30-macros.clj @@ -12,6 +12,16 @@ (defmacro comment [& body] nil) +;; defmulti/defmethod are sugar over defmulti-setup/defmethod-setup (ctx-capturing +;; clojure.core fns) so they compile as plain invokes. name/mm are passed quoted; +;; the dispatch fn, options, and dispatch value evaluate normally, and the method +;; body becomes a compiled (fn …). +(defmacro defmulti [name dispatch & opts] + `(defmulti-setup (quote ~name) ~dispatch ~@opts)) + +(defmacro defmethod [mm dispatch-val & fn-tail] + `(defmethod-setup (quote ~mm) ~dispatch-val (fn ~@fn-tail))) + ;; Single arglist (Jolt defmacro is single-arity); the optional else defaults nil ;; via rest-destructuring. (defmacro if-not [test then & [else]] @@ -149,6 +159,37 @@ (conj (pop acc) (conj (peek acc) x)))) [] items)) +;; deftype is sugar 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 …). Each method body sees the +;; type's fields, bound from the instance (the method's first param), matching +;; Clojure's deftype scope. defrecord (below) expands to a bodyless (deftype …) and +;; handles its own methods, so this also serves the no-body case. +(defmacro deftype [tname fields & body] + ;; strip ^meta off the type name and fields (the reader yields a (with-meta sym m) + ;; form for e.g. (deftype ^{:doc …} Foo …)), so (name …) sees a bare symbol. + (let [unwrap (fn [x] (if (and (seq? x) (symbol? (first x)) (= "with-meta" (name (first x)))) + (second x) x)) + tname (unwrap tname) + fields (map unwrap fields) + arrow (symbol (str "->" (name tname))) + ;; a seq of field keywords; spliced into a vector LITERAL below ([~@…]) so + ;; the analyzer sees a vector form, not a runtime pvec value. + field-kws (map (fn [f] (keyword (name f))) fields) + impl (fn [proto specs] + `(extend-type ~tname ~proto + ~@(map (fn [spec] + (let [argv (nth spec 1) + inst (first argv) + binds (vec (mapcat (fn [f] [f `(get ~inst ~(keyword (name f)))]) fields))] + `(~(first spec) ~argv (let [~@binds] ~@(drop 2 spec))))) + specs)))] + `(do + (def ~tname (make-deftype-ctor (quote ~tname) [~@field-kws])) + (def ~arrow ~tname) + ~@(map (fn [g] (impl (first g) (rest g))) (group-by-head body)) + ~tname))) + ;; The protocol value is built by make-protocol (a fn call) rather than an embedded ;; tagged map literal: the interpreter would otherwise self-evaluate such a struct ;; instead of evaluating its fields. methods is a {kw {:name str}} map (only :name @@ -203,7 +244,6 @@ (defmacro defrecord [name-sym fields & body] (let [tn (name name-sym) - dot (symbol (str tn ".")) arrow (symbol (str "->" tn)) mapf (symbol (str "map->" tn)) m (fresh-sym) @@ -219,8 +259,9 @@ `(~(first spec) ~argv (let [~@binds] ~@(drop 2 spec))))) specs)))] `(do + ;; deftype already defines ->name (= the ctor); no (name. …) interop needed, + ;; so defrecord compiles too. map->name builds via that ctor. (deftype ~name-sym ~fields) - (def ~arrow (fn* ~fields (~dot ~@fields))) (def ~mapf (fn* [~m] (~arrow ~@(map (fn [f] `(get ~m ~(keyword (name f)))) fields)))) ~@(map (fn [g] (impl (first g) (rest g))) (group-by-head body))))) diff --git a/src/jolt/evaluator.janet b/src/jolt/evaluator.janet index a9b0d8c..44376dc 100644 --- a/src/jolt/evaluator.janet +++ b/src/jolt/evaluator.janet @@ -21,8 +21,8 @@ (= name "recur") (= name "throw") (= name "try") (= name "set!") (= name "var") (= name "locking") (= name "eval") - (= name "instance?") (= name "defmulti") (= name "defmethod") - (= name "deftype") (= name "new") (= name ".") + (= name "instance?") + (= name "new") (= name ".") (= name "var-get") (= name "var-set") (= name "var?") (= name "alter-var-root") (= name "find-var") (= name "intern") (= name "alter-meta!") (= name "reset-meta!") @@ -816,6 +816,87 @@ (ns-unmap ns (if (and (struct? sym) (= :symbol (sym :jolt/type))) (sym :name) (string sym)))))) nil) +(defn defmulti-setup + "(defmulti name dispatch & opts) — intern a multimethod var. A fn; name arrives + quoted, dispatch + opts (:default key, :hierarchy h) arrive evaluated. The + defmulti macro is the thin wrapper. Builds the dispatch closure over the method + table (shared with the var's :jolt/methods so defmethod adds to it)." + [ctx name-sym dispatch-raw & opts] + (def dispatch-fn (if (keyword? dispatch-raw) (fn [x] (get x dispatch-raw)) dispatch-raw)) + (def default-key + (do (var dv :default) (var i 0) + (while (< i (length opts)) + (if (= :default (in opts i)) (do (set dv (in opts (+ i 1))) (set i (length opts))) (+= i 2))) + dv)) + (def hierarchy + (do (var h nil) (var i 0) + (while (< i (length opts)) + (if (= :hierarchy (in opts i)) (do (set h (in opts (+ i 1))) (set i (length opts))) (+= i 2))) + h)) + (def ns (ctx-find-ns ctx (ctx-current-ns ctx))) + (def methods @{}) + (def dispatch-cache @{}) + (def mm-fn + (fn [& args] + (let [dv (apply dispatch-fn args) + method (get methods dv)] + (if method + (apply method args) + (let [cached (get dispatch-cache dv)] + (if cached + (apply cached args) + (let [h (or hierarchy the-global-hierarchy) + found (do (var f nil) (var i 0) + (let [ks (keys methods)] + (while (and (nil? f) (< i (length ks))) + (if (isa? h dv (in ks i)) (set f (get methods (in ks i)))) + (++ i))) + f)] + (if found + (do (put dispatch-cache dv found) (apply found args)) + (let [dm (get methods default-key)] + (if dm (apply dm args) + (error (string "No method in multimethod " (name-sym :name) + " for dispatch value: " dv)))))))))))) + (def v (ns-intern ns (name-sym :name) mm-fn)) + (put v :jolt/methods methods) + (put v :jolt/dispatch-cache dispatch-cache) + (put v :jolt/default default-key) + (when hierarchy (put v :jolt/hierarchy hierarchy)) + (var-get v)) + +(defn defmethod-setup + "(defmethod mm dispatch-val impl) — add a method to a multimethod. A fn; mm + arrives quoted, dispatch-val evaluated, impl is the COMPILED method fn (the + defmethod macro builds (fn …)). Auto-creates the multimethod if it's missing." + [ctx mm-sym dispatch-val impl] + (def mm-var + (or (resolve-var ctx @{} mm-sym) + (let [ns (ctx-find-ns ctx (ctx-current-ns ctx))] + (def v (ns-intern ns (mm-sym :name) (fn [& args] nil))) + (put v :jolt/methods @{}) + v))) + (def methods (or (get mm-var :jolt/methods) (let [m @{}] (put mm-var :jolt/methods m) m))) + (put methods dispatch-val impl) + (let [dc (get mm-var :jolt/dispatch-cache)] + (when dc (each k (keys dc) (put dc k nil)))) + mm-var) + +(defn make-deftype-ctor-impl + "Build a deftype constructor closure. The ns-qualified type tag is baked at + definition time (this runs during the deftype's (def …), in the type's ns), so + instances carry a stable tag matching what extend-type registers methods under. + field-kws is the [:f1 :f2 …] keyword vector; the ctor maps positional args to + those keys. A ctx-capturing closure (make-deftype-ctor) is the public handle." + [ctx type-name-sym field-kws] + (def type-tag (string (ctx-current-ns ctx) "." (type-name-sym :name))) + (def kws (d-realize field-kws)) + (fn [& args] + (var inst @{:jolt/deftype type-tag}) + (var i 0) + (each kw kws (put inst kw (in args i)) (++ i)) + inst)) + (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 @@ -836,6 +917,9 @@ (ns-intern core "use" (fn [& specs] (use-impl ctx ;specs))) (ns-intern core "import" (fn [& specs] (import-impl ctx ;specs))) (ns-intern core "refer-clojure" (fn [& args] (refer-clojure-impl ctx ;args))) + (ns-intern core "defmulti-setup" (fn [name-sym dispatch & opts] (defmulti-setup ctx name-sym dispatch ;opts))) + (ns-intern core "defmethod-setup" (fn [mm-sym dval impl] (defmethod-setup ctx mm-sym dval impl))) + (ns-intern core "make-deftype-ctor" (fn [name-sym field-kws] (make-deftype-ctor-impl ctx name-sym field-kws))) core) # Dispatch a special form by its string name. @@ -1297,88 +1381,9 @@ "clojure.lang.IPersistentSet" (set? val) "Object" true false))) - "defmulti" (let [name-sym (in form 1) - dispatch-fn (do - (def raw (eval-form ctx bindings (in form 2))) - (if (keyword? raw) - (fn [x] (get x raw)) - raw)) - # Parse options: :default dispatch-key (defaults to :default) - # and :hierarchy h - opts (tuple/slice form 3) - default-key (do - (var dv :default) (var i 0) - (while (< i (length opts)) - (if (= :default (in opts i)) - (do (set dv (in opts (+ i 1))) (set i (length opts))) - (+= i 2))) dv) - hierarchy (do - (var h nil) (var i 0) - (while (< i (length opts)) - (if (= :hierarchy (in opts i)) - (do (set h (eval-form ctx bindings (in opts (+ i 1)))) (set i (length opts))) - (+= i 2))) h) - ns (ctx-find-ns ctx (ctx-current-ns ctx)) - methods @{} - # Cache for hierarchy-resolved dispatch values: the isa? walk - # over every method key is the expensive path (derive-based - # dispatch). Direct (get methods dv) hits stay uncached (already - # fast). Cleared in place when methods/prefs change (defmethod, - # prefer-method, remove-method, …) so a redef can't be hidden. - dispatch-cache @{} - mm-fn (fn [& args] - (let [dv (apply dispatch-fn args) - method (get methods dv)] - (if method - (apply method args) - (let [cached (get dispatch-cache dv)] - (if cached - (apply cached args) - # hierarchy-based match (explicit :hierarchy or - # the global hierarchy from derive) - (let [h (or hierarchy the-global-hierarchy) - found (do (var f nil) (var i 0) - (let [ks (keys methods)] - (while (and (nil? f) (< i (length ks))) - (if (isa? h dv (in ks i)) (set f (get methods (in ks i)))) - (++ i))) f)] - (if found - (do (put dispatch-cache dv found) (apply found args)) - # fall back to the method registered under the default key - (let [dm (get methods default-key)] - (if dm (apply dm args) - (error (string "No method in multimethod " - (name-sym :name) " for dispatch value: " dv))))))))))) ] - (def v (ns-intern ns (name-sym :name) mm-fn)) - (put v :jolt/methods methods) - (put v :jolt/dispatch-cache dispatch-cache) - (put v :jolt/default default-key) - (when hierarchy (put v :jolt/hierarchy hierarchy)) - (var-get v)) - "defmethod" (let [mm-sym (in form 1) - dispatch-val (eval-form ctx bindings (in form 2)) - # (defmethod mm dispatch [args] body...) — single-arity, or - # (defmethod mm dispatch ([args] body)...) — multi-arity. - # Build a fn* form and evaluate it (reuses arity dispatch - # and destructuring). - impl (eval-form ctx bindings - @[{:jolt/type :symbol :ns nil :name "fn*"} ;(tuple/slice form 3)]) - mm-var (resolve-var ctx bindings mm-sym) - # Auto-create multimethod if it doesn't exist - mm-var (if mm-var mm-var - (let [ns (ctx-find-ns ctx (ctx-current-ns ctx)) - dummy-fn (fn [& args] nil)] - (def v (ns-intern ns (mm-sym :name) dummy-fn)) - (put v :jolt/methods @{}) - v)) - # The resolved var may be a plain fn (e.g. a copy-core-var'd - # print-method) with no method table yet — initialize one. - methods (or (get mm-var :jolt/methods) - (let [m @{}] (put mm-var :jolt/methods m) m))] - (put methods dispatch-val impl) - (let [dc (get mm-var :jolt/dispatch-cache)] - (when dc (each k (keys dc) (put dc k nil)))) - mm-var) + # defmulti / defmethod are now macros (30-macros) over defmulti-setup / + # defmethod-setup (ctx-capturing clojure.core fns) — they compile as plain + # invokes; no special-form arms. defmethod's impl is a compiled (fn …). "prefer-method" (let [mm-arg (in form 1) mm-var (if (and (struct? mm-arg) (= :symbol (mm-arg :jolt/type))) (resolve-var ctx bindings mm-arg) @@ -1430,64 +1435,8 @@ (let [dc (get mm-var :jolt/dispatch-cache)] (when dc (each k (keys dc) (put dc k nil))))) mm-var) - "deftype" (let [raw-name (in form 1) - type-name (unwrap-meta-name raw-name) - fields-vec (in form 2) - field-names (map - (fn [f] - # Handle ^:meta and ^Type annotations — extract the actual name - (let [f (unwrap-meta-name f)] - (if (and (struct? f) (= :symbol (f :jolt/type))) - (keyword (f :name)) - (error (string "Unsupported deftype field: " (string f)))))) - fields-vec) - ns-name (ctx-current-ns ctx) - type-tag (string ns-name "." (type-name :name))] - (defn ctor [& args] - (var inst @{:jolt/deftype type-tag}) - (var i 0) - (each fn field-names - (put inst fn (args i)) - (++ i)) - inst) - (let [ns (ctx-find-ns ctx ns-name) - ctor-name (type-name :name) - arrow-name (string "->" ctor-name)] - (ns-intern ns ctor-name ctor) - (ns-intern ns arrow-name ctor) - # Process inline protocol/interface methods (like defrecord): - # (deftype T [fs] Proto (m [this] body) Proto2 (m2 [this] body)) - # Emit one extend-type per protocol, wrapping each method body in a - # let that binds the type's fields from the instance (first param), - # matching Clojure's field-in-scope semantics. - (let [body (tuple/slice form 3) - field-syms (map unwrap-meta-name fields-vec)] - (var bi 0) - (while (< bi (length body)) - (def elem (in body bi)) - (if (and (struct? elem) (= :symbol (elem :jolt/type))) - (let [proto-sym elem - et @[{:jolt/type :symbol :ns nil :name "extend-type"} type-name proto-sym]] - (++ bi) - (while (and (< bi (length body)) - (not (and (struct? (in body bi)) (= :symbol ((in body bi) :jolt/type))))) - (let [spec (in body bi) - mname (in spec 0) - argv (in spec 1) - mbody (tuple/slice spec 2) - instance (in argv 0) - field-binds @[] - _ (each f field-syms - (array/push field-binds f) - (array/push field-binds @[{:jolt/type :symbol :ns nil :name "get"} - instance (keyword (f :name))])) - wrapped @[{:jolt/type :symbol :ns nil :name "let"} - (tuple/slice (tuple ;field-binds)) ;mbody]] - (array/push et @[mname argv wrapped])) - (++ bi)) - (eval-form ctx bindings et)) - (++ bi)))) - (var-get (ns-intern ns ctor-name)))) + # deftype is now a macro (30-macros) over make-deftype-ctor + extend-type — + # compiles as a plain (do …); no special-form arm. "new" (let [type-sym (in form 1) args (map |(eval-form ctx bindings $) (tuple/slice form 2)) ctor (eval-form ctx bindings type-sym)] diff --git a/src/jolt/host_iface.janet b/src/jolt/host_iface.janet index 13a0780..07c3379 100644 --- a/src/jolt/host_iface.janet +++ b/src/jolt/host_iface.janet @@ -72,7 +72,8 @@ (let [t @{}] (each n ["quote" "syntax-quote" "unquote" "unquote-splicing" "do" "if" "def" "defmacro" "fn*" "let*" "loop*" "recur" "throw" "try" "set!" - "locking" "eval" "instance?" "defmulti" "defmethod" "deftype" "new" + # defmulti/defmethod/deftype now compile (macros over *-setup fns). + "locking" "eval" "instance?" "new" "." "var-get" "var-set" "var?" "alter-var-root" "find-var" "intern" "alter-meta!" "reset-meta!" "satisfies?" # protocol-dispatch/register-method/make-reified are now clojure.core @@ -85,9 +86,9 @@ # ns/require/in-ns/use/import/refer-clojure are now clojure.core # fns/macros (compile as plain invokes / expand to them). "read-string" "macroexpand-1" "defonce" - "refer" "defrecord" - # defprotocol/extend-type/extend-protocol/reify now expand to plain - # def + protocol-dispatch/register-method/make-reified invokes. + "refer" + # defprotocol/extend-type/extend-protocol/reify/defrecord now expand to + # plain def + protocol-dispatch/register-method/make-reified/deftype. "gen-class" # letfn stays: its let* expansion needs letrec semantics (mutual # recursion between the fns), which compiled sequential let* lacks. diff --git a/src/jolt/loader.janet b/src/jolt/loader.janet index c1223ec..7df16ff 100644 --- a/src/jolt/loader.janet +++ b/src/jolt/loader.janet @@ -14,7 +14,6 @@ # compile path; syntax-quote already compiles via the analyzer's `handled` set. (defn- stateful-head? [head-name] (or (= head-name "defmacro") - (= head-name "deftype") (= head-name "defmulti") (= head-name "defmethod") (= 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 3e1364f..dd98c82 100644 --- a/test/integration/fallback-zero-test.janet +++ b/test/integration/fallback-zero-test.janet @@ -49,14 +49,16 @@ "(require (quote [clojure.string :as s]))" "(in-ns (quote foo.bar))" "(ns foo.bar (:require [clojure.string :as s]))" "(defprotocol P (m [x]))" "(extend-type Long P (m [x] x))" - "(reify P (m [this] 1))" "(var map)"]) + "(reify P (m [this] 1))" "(var map)" + # Stage 2 tier 5: type/dispatch definitional forms compile too + "(deftype Pt [x y])" "(deftype Sq [s] P (m [this] s))" + "(defrecord Rec [a b])" "(defmulti mf :k)" "(defmethod mf :a [x] x)"]) # --- Intentional fallback (sanity sample): these SHOULD punt to the interpreter. -# 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. +# The remaining frozen/uncompiled set keeps the harness honest in the punt +# direction: defmacro + set! (frozen host-coupled), and letfn (needs letrec IR). (def must-punt - ["(defmacro m [x] x)" "(deftype T [a])" + ["(defmacro m [x] x)" "(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 6362cee..755128b 100644 --- a/test/integration/namespace-test.janet +++ b/test/integration/namespace-test.janet @@ -1,13 +1,12 @@ (use ../../src/jolt/reader) (use ../../src/jolt/types) (use ../../src/jolt/evaluator) +(import ../../src/jolt/api :as api) -# 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)) +# 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] diff --git a/test/unit/evaluator-test.janet b/test/unit/evaluator-test.janet index 3b216a3..a93aa1b 100644 --- a/test/unit/evaluator-test.janet +++ b/test/unit/evaluator-test.janet @@ -111,7 +111,9 @@ (print " passed") (print "15: defmulti/defmethod...") -(let [ctx (make-ctx)] +# defmulti/defmethod are overlay macros now (Stage 2 jolt-eaa), so this needs the +# full env (init loads the overlay + installs the *-setup fns), not a bare make-ctx. +(let [ctx (init)] (eval-form ctx @{} (parse-string "(defmulti my-dispatch (fn* [x] (x :type)))")) (eval-form ctx @{} (parse-string "(defmethod my-dispatch :foo [_] :got-foo)")) (eval-form ctx @{} (parse-string "(defmethod my-dispatch :bar [_] :got-bar)")) @@ -120,7 +122,8 @@ (print " passed") (print "16: deftype...") -(let [ctx (make-ctx) +# deftype is an overlay macro now (Stage 2 jolt-eaa) — needs the full env (init). +(let [ctx (init) _ (eval-form ctx @{} (parse-string "(deftype Point [x y])")) _ (eval-form ctx @{} (parse-string "(def p (Point. 10 20))")) p-val (eval-form ctx @{} (parse-string "p"))