diff --git a/jolt-core/clojure/core/30-macros.clj b/jolt-core/clojure/core/30-macros.clj index 9a4e6d1..8378619 100644 --- a/jolt-core/clojure/core/30-macros.clj +++ b/jolt-core/clojure/core/30-macros.clj @@ -187,13 +187,13 @@ ;; definterface is JVM-only; bind the name to an empty marker. (defmacro definterface [name-sym & body] `(def ~name-sym {})) -;; Build a method map {kw (fn* ...)} as an embedded map literal — make-reified -;; evaluates it (the fn* forms become fns) via build-eval-map, which yields a -;; struct it can iterate; a (hash-map ...) call would instead yield a phm it can't. +;; make-reified is a fn (clojure.core); the method map {kw (fn* ...)} is an +;; ordinary map literal that evaluates to {keyword fn}, and the protocol NAME is +;; passed as a string (not the symbol) so the call compiles as a plain invoke. (defmacro reify [& forms] (loop [items (seq forms) proto nil methods {}] (if (empty? items) - `(make-reified ~proto ~methods) + `(make-reified ~(name proto) ~methods) (let [x (first items)] (if (symbol? x) (recur (rest items) (if proto proto x) methods) diff --git a/src/jolt/compiler.janet b/src/jolt/compiler.janet index 1529805..d3f60b0 100644 --- a/src/jolt/compiler.janet +++ b/src/jolt/compiler.janet @@ -158,7 +158,7 @@ "macroexpand-1" "defonce" "defmacro" "deftype" "defmulti" "defmethod" "prefer-method" "remove-method" "remove-all-methods" "get-method" "methods" - "make-reified" "satisfies?" "instance?" "set!" "var" "var-get" + "satisfies?" "instance?" "set!" "var" "var-get" "var-set" "var?" "in-ns" "ns" "require" "create-ns" "remove-ns" "find-ns" "all-ns" "the-ns" "find-var" "intern" "resolve" "ns-resolve" "ns-aliases" "ns-imports" "ns-interns" diff --git a/src/jolt/evaluator.janet b/src/jolt/evaluator.janet index 402657a..6c07416 100644 --- a/src/jolt/evaluator.janet +++ b/src/jolt/evaluator.janet @@ -27,7 +27,6 @@ (= name "alter-var-root") (= name "find-var") (= name "intern") (= name "alter-meta!") (= name "reset-meta!") (= name "satisfies?") - (= name "make-reified") (= name "prefer-method") (= name "remove-method") (= name "remove-all-methods") (= name "get-method") (= name "methods"))) @@ -742,6 +741,16 @@ (def type-tag (if host host (string (ctx-current-ns ctx) "." type-name))) (register-protocol-method ctx type-tag proto-name method-name f)) +(defn make-reified-impl [ctx proto-name methods-map] + # methods-map is the EVALUATED {keyword fn} map (a phm when compiled, a struct/ + # table when interpreted) — the fn* literals are already fns, just store them. + (def obj @{:jolt/deftype (string "reified-" proto-name) :jolt/protocol-methods @{}}) + (def pairs (if (phm? methods-map) + (phm-entries methods-map) + (map (fn [k] [k (get methods-map k)]) (keys methods-map)))) + (each p pairs (put (obj :jolt/protocol-methods) (in p 0) (in p 1))) + obj) + (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 @@ -755,6 +764,8 @@ (ns-intern core "register-method" (fn [type-name proto-name method-name f] (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))) core) # Dispatch a special form by its string name. @@ -1240,23 +1251,10 @@ (ns-intern ns (if (struct? sym-name) (sym-name :name) sym-name) val)) # set?/disj are plain clojure.core fns now (core-set?/core-disj) — no longer # special-cased here, the analyzer, or compiler.janet (jolt-g3h). - # protocol-dispatch / register-method are now ordinary clojure.core fns - # (install-stateful-fns!) — the defprotocol/extend-type macros call them with - # name STRINGS, so they compile + interpret as plain invokes (no special arm). - "make-reified" (let [proto-sym (in form 1) - methods-map (eval-form ctx bindings (in form 2)) - proto-name (proto-sym :name) - reified-tag (string "reified-" proto-name)] - (def obj @{:jolt/deftype reified-tag :jolt/protocol-methods @{}}) - (loop [[k v] :pairs methods-map] - (let [fn-value (if (and (table? v) (get v :fn*)) - (let [args-vec (get v :args) - body-forms (get v :body)] - (eval-form ctx @{} - @[{:jolt/type :symbol :ns nil :name "fn*"} args-vec ;body-forms])) - v)] - (put (obj :jolt/protocol-methods) k fn-value))) - obj) + # protocol-dispatch / register-method / make-reified are now ordinary + # clojure.core fns (install-stateful-fns!) — the defprotocol/extend-type/reify + # macros call them with name STRINGS, so they compile + interpret as plain + # invokes (no special-form arms). "satisfies?" (let [proto-sym (eval-form ctx bindings (in form 1)) obj (eval-form ctx bindings (in form 2)) type-tag (if (and (table? obj) (get obj :jolt/deftype)) diff --git a/src/jolt/host_iface.janet b/src/jolt/host_iface.janet index 66c23dd..5e86d1a 100644 --- a/src/jolt/host_iface.janet +++ b/src/jolt/host_iface.janet @@ -75,18 +75,18 @@ "locking" "eval" "instance?" "defmulti" "defmethod" "deftype" "new" "." "var-get" "var-set" "var?" "alter-var-root" "find-var" "intern" "alter-meta!" "reset-meta!" "satisfies?" - # protocol-dispatch/register-method are now clojure.core fns (compile - # as plain invokes); only make-reified is still a special. - "make-reified" "prefer-method" + # protocol-dispatch/register-method/make-reified are now clojure.core + # fns (compile as plain invokes). + "prefer-method" "remove-method" "remove-all-methods" "get-method" "methods" # 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" "import" "use" "refer" "defrecord" - # defprotocol/extend-type/extend-protocol now expand to plain - # def + protocol-dispatch/register-method invokes — let them compile. - "reify" "gen-class" + # defprotocol/extend-type/extend-protocol/reify now expand to plain + # def + protocol-dispatch/register-method/make-reified invokes. + "gen-class" # letfn stays: its let* expansion needs letrec semantics (mutual # recursion between the fns), which compiled sequential let* lacks. "monitor-enter" "monitor-exit" "binding" "letfn"]