From f2da6f29a7e856d05f70f96b93e0c5542bf1d71c Mon Sep 17 00:00:00 2001 From: Christopher Rink Date: Mon, 30 Dec 2019 22:42:41 -0500 Subject: [PATCH 01/24] Protocol initial impl --- src/basilisp/core.lpy | 131 +++++++++++++++++++++++++++++- tests/basilisp/test_protocols.lpy | 3 + 2 files changed, 133 insertions(+), 1 deletion(-) create mode 100644 tests/basilisp/test_protocols.lpy diff --git a/src/basilisp/core.lpy b/src/basilisp/core.lpy index c454c1455..8b2ad084b 100644 --- a/src/basilisp/core.lpy +++ b/src/basilisp/core.lpy @@ -3620,6 +3620,9 @@ [name & body] (let [doc (when (string? (first body)) (first body)) + name (if doc + (vary-meta name assoc :doc doc) + name) body (if doc (rest body) body) @@ -4066,7 +4069,9 @@ Callers should use `definterface` to generate new interfaces." [interface-name methods] (let [methods (reduce (fn [m [method-name args docstring]] - (let [method-args (->> (concat ['^:no-warn-when-unused self] args) + (let [method-args (->> args + (map #(vary-meta % assoc :no-warn-when-unused true)) + (concat ['^:no-warn-when-unused self]) (apply vector)) method (->> (list 'fn* method-name method-args) (eval) @@ -4456,3 +4461,127 @@ ~type-name))) +;;;;;;;;;;;;;;; +;; Protocols ;; +;;;;;;;;;;;;;;; + +(def ^:private protocols + "" + (atom {})) + +(defn ^:private gen-protocol-multi + "Return the `defmulti` and default `defmethod` for a protocol method." + [[method-name args docstring]] + (let [dotted-method-name (symbol (str "." (name method-name))) + has-varargs (some #(= '& %) args) + clean-args (filter #(not= '& %) args) + + obj-sym (gensym "o")] + [`(defmulti ~method-name + ~docstring + (fn [~obj-sym ~@(map #(vary-meta % assoc :no-warn-when-unused true) args)] + (python/type ~obj-sym))) + `(defmethod ~method-name :default + [~obj-sym ~@args] + ~(if has-varargs + `(apply-method ~obj-sym ~method-name ~@clean-args) + `(~dotted-method-name ~obj-sym ~@clean-args)))])) + +(defmacro defprotocol + "Define a new protocol. + + Protocols consist of an interface (a Python `ABC`) and a set of generated methods + which dispatch to objects implementing the interface." + [protocol-name & methods] + (let [doc (when (string? (first methods)) + (first methods)) + methods (if doc (rest methods) methods) + protocol-name (vary-meta + (cond-> protocol-name + doc (vary-meta assoc :doc doc)) + assoc :protocol true)] + `(do + (definterface ~protocol-name ~@methods) + ~@(mapcat gen-protocol-multi methods) + (->> {:extending-types #{} + :interface ~protocol-name + :methods ~(apply hash-map + (mapcat #(let [v (first %)] + [(keyword (name v)) v]) + methods))} + (swap! protocols assoc ~protocol-name)) + ~protocol-name))) + +(defn protocol? + "Return true if x is a Protocol." + [x] + (boolean (get @protocols x))) + +(defn extend + [target-type & type+methods] + (let [proto-map (apply hash-map type+methods)] + (swap! protocols (fn [proto-state] + (reduce-kv (fn [m proto method-map] + (when-not (contains? proto-state proto) + (throw (ex-info "Invalid protocol type" + {:protocol proto}))) + (let [proto-methods (get-in m [proto :methods])] + (doseq [method-def method-map + :let [[method-name fn] method-def]] + (let [mmethod (get proto-methods method-name)] + (.add-method mmethod target-type fn)))) + (update-in m [proto :extending-types] conj target-type)) + proto-state + proto-map))))) + +(defn extends? + "Return true if type extends protocol proto." + [proto type] + (some-> (get-in @protocols [proto :extending-types]) + (contains? type))) + +(defn satisfies? + "Return true if x satisfies protocol proto." + [proto x] + (or (instance? proto x) + (let [types (get-in @protocols [proto :extending-types])] + (python/isinstance x (python/tuple types))))) + +;;;;;;;;;;;;;;; +;; Volatiles ;; +;;;;;;;;;;;;;;; + +(defprotocol IVolatile + "Protocol for a volatile reference container. Volatile references do not provide + atomic semantics, but they may be useful as a mutable reference container in a + single-threaded context." + + (vreset! + [new-val] + "Reset the value of a volatile non-atomically.") + (vswap! + [f & args] + "Swap the value of a volatile non-atomically to the return of + (apply f old-val args). Returns the new value of that function + call.")) + +(deftype Volatile [^:mutable val] + basilisp.lang.interfaces/IDeref + (deref [this] val) + + IVolatile + (vreset! [this new-val] + (set! val new-val)) + (vswap! [this f & args] + (let [new-val (apply f val args)] + (set! val new-val)))) + +(defn volatile! + "Return a Volatile reference container with the initial value v." + [v] + (Volatile v)) + +(defn volatile? + "Return true if implements IVolatile." + [x] + (instance? IVolatile x)) diff --git a/tests/basilisp/test_protocols.lpy b/tests/basilisp/test_protocols.lpy new file mode 100644 index 000000000..dceee160d --- /dev/null +++ b/tests/basilisp/test_protocols.lpy @@ -0,0 +1,3 @@ +(ns tests.basilisp.test-protocols + (:require + [basilisp.test :refer [deftest is testing]])) From e80de3097c6a6a8d294e0ff6c69f6937c37e6854 Mon Sep 17 00:00:00 2001 From: Christopher Rink Date: Tue, 28 Jan 2020 09:37:33 -0500 Subject: [PATCH 02/24] Changelog --- CHANGELOG.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 40c00644b..05e2fa913 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,6 +9,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 * Added support for Shebang-style line comments (#469) * Added multiline REPL support using `prompt-toolkit` (#467) * Added node syntactic location (statement or expression) to Basilisp AST nodes emitted by the analyzer (#463) + * Added support for Protocols (#460) + * Added support for Volatiles (#460) ### Changed * Change the default user namespace to `basilisp.user` (#466) From 35cdd39cf673442e50005e060b1ab608c224f465 Mon Sep 17 00:00:00 2001 From: Christopher Rink Date: Tue, 17 Mar 2020 20:25:50 -0400 Subject: [PATCH 03/24] Volatile tests --- src/basilisp/core.lpy | 2 +- src/basilisp/lang/compiler/analyzer.py | 15 ++++++++++----- tests/basilisp/core_fns_test.lpy | 23 +++++++++++++++++++++++ 3 files changed, 34 insertions(+), 6 deletions(-) diff --git a/src/basilisp/core.lpy b/src/basilisp/core.lpy index a88750bc5..47694d683 100644 --- a/src/basilisp/core.lpy +++ b/src/basilisp/core.lpy @@ -4939,7 +4939,7 @@ (vreset! [new-val] - "Reset the value of a volatile non-atomically.") + "Reset the value of a volatile non-atomically. Returns the new value.") (vswap! [f & args] "Swap the value of a volatile non-atomically to the return of diff --git a/src/basilisp/lang/compiler/analyzer.py b/src/basilisp/lang/compiler/analyzer.py index 657d25dad..2989017e6 100644 --- a/src/basilisp/lang/compiler/analyzer.py +++ b/src/basilisp/lang/compiler/analyzer.py @@ -933,7 +933,8 @@ def __deftype_classmethod( params = args[1:] has_vargs, param_nodes = __deftype_method_param_bindings(ctx, params) - stmts, ret = _body_ast(ctx, runtime.nthrest(form, 2)) + with ctx.expr_pos(): + stmts, ret = _body_ast(ctx, runtime.nthrest(form, 2)) method = ClassMethod( form=form, name=method_name, @@ -987,7 +988,8 @@ def __deftype_method( loop_id = genname(method_name) with ctx.new_recur_point(loop_id, param_nodes): - stmts, ret = _body_ast(ctx, runtime.nthrest(form, 2)) + with ctx.expr_pos(): + stmts, ret = _body_ast(ctx, runtime.nthrest(form, 2)) method = Method( form=form, name=method_name, @@ -1047,7 +1049,8 @@ def __deftype_property( assert not has_vargs, "deftype* properties may not have arguments" - stmts, ret = _body_ast(ctx, runtime.nthrest(form, 2)) + with ctx.expr_pos(): + stmts, ret = _body_ast(ctx, runtime.nthrest(form, 2)) prop = PropertyMethod( form=form, name=method_name, @@ -1077,7 +1080,8 @@ def __deftype_staticmethod( """Emit a node for a :staticmethod member of a deftype* form.""" with ctx.hide_parent_symbol_table(), ctx.new_symbol_table(method_name): has_vargs, param_nodes = __deftype_method_param_bindings(ctx, args) - stmts, ret = _body_ast(ctx, runtime.nthrest(form, 2)) + with ctx.expr_pos(): + stmts, ret = _body_ast(ctx, runtime.nthrest(form, 2)) method = StaticMethod( form=form, name=method_name, @@ -1432,7 +1436,8 @@ def __fn_method_ast( # pylint: disable=too-many-branches,too-many-locals fn_loop_id = genname("fn_arity" if fnname is None else fnname.name) with ctx.new_recur_point(fn_loop_id, param_nodes): - stmts, ret = _body_ast(ctx, form.rest) + with ctx.expr_pos(): + stmts, ret = _body_ast(ctx, form.rest) method = FnMethod( form=form, loop_id=fn_loop_id, diff --git a/tests/basilisp/core_fns_test.lpy b/tests/basilisp/core_fns_test.lpy index 48051caea..3fe90bd25 100644 --- a/tests/basilisp/core_fns_test.lpy +++ b/tests/basilisp/core_fns_test.lpy @@ -336,6 +336,10 @@ (is (= "lo w" (subs "hello world" 3 7))) (is (thrown? python/IndexError (subs "hello world" 12 3)))) +;;;;;;;;;;;;; +;; Futures ;; +;;;;;;;;;;;;; + (deftest futures-test (testing "successful future" (let [fut (future 1)] @@ -390,6 +394,10 @@ (slow 3) (slow 4)))))))) +;;;;;;;;;;;; +;; Arrays ;; +;;;;;;;;;;;; + (deftest to-array-test (is (= #py [] (to-array []))) (is (= #py [] (to-array '()))) @@ -505,3 +513,18 @@ (is (= 5 (aset l 0 2 5))) (is (= #py [#py [:a :b 5] #py [:d :e :f]] l)) (is (thrown? python/IndexError (aset l 0 5 :cc))))) + +;;;;;;;;;;;;;;; +;; Volatiles ;; +;;;;;;;;;;;;;;; + +(deftest volatile-test + (let [v (volatile! :a)] + (is (not (volatile? :a))) + (is (not (volatile? (atom :a)))) + (is (volatile? v)) + (is (= :a @v)) + (is (= :b (vreset! v :b))) + (is (= :b @v)) + (is (= :b/a (vswap! v #(keyword (name %) "a")))) + (is (= :b/a @v)))) From d8df16fe72a2508a50a3a6291b22d64cfff2294c Mon Sep 17 00:00:00 2001 From: Christopher Rink Date: Tue, 17 Mar 2020 21:57:01 -0400 Subject: [PATCH 04/24] Some small changes --- src/basilisp/core.lpy | 34 +++++++++++++++++++++++++------- tests/basilisp/core_fns_test.lpy | 2 ++ 2 files changed, 29 insertions(+), 7 deletions(-) diff --git a/src/basilisp/core.lpy b/src/basilisp/core.lpy index 47694d683..894cea9da 100644 --- a/src/basilisp/core.lpy +++ b/src/basilisp/core.lpy @@ -3698,7 +3698,7 @@ (import importlib) -(defn- require-libspec +(defn ^:private require-libspec "Convert a user-specified require libspec into a map with well-defined keys. Required keys: @@ -3720,7 +3720,7 @@ (ex-info "Invalid libspec for require" {:value req})))) -(defn- require-lib +(defn ^:private require-lib "Require the library described by `libspec` into the Namespace `requiring-ns`." [requiring-ns libspec] (let [required-ns-sym (:namespace libspec)] @@ -3737,7 +3737,7 @@ ;; during the require process (set! *ns* requiring-ns))) -(defn- refer-filtered-interns +(defn ^:private refer-filtered-interns "Return a map of symbols to interned Vars in the Namespace `referred-ns` subject to the filters described in `libspec`." [referred-ns libspec] @@ -3759,7 +3759,7 @@ m)) {})))) -(defn- refer-lib +(defn ^:private refer-lib "Refer Vars into `requiring-ns` as described by `libspec`. This function assumes the referred-to Namespace has already been loaded by @@ -4847,7 +4847,16 @@ ;;;;;;;;;;;;;;; (def ^:private protocols - "" + "Internal registry of all Protocols. + + The registry is a mapping of Protocol types to a map of details about the + protocol. For each protocol, the following keys are defined: + + - :extending-types - a set of types which dynamically extend the Protocol + (e.g. by `extend`) + - :interface - the Python interface type which backs the Protocol + - :methods - a mapping of method names (as Basilisp keywords) to + the multi-method backing the Protocol method" (atom {})) (defn ^:private gen-protocol-multi @@ -4915,11 +4924,22 @@ proto-state proto-map))))) +(defn extenders + "Return a collection of types explicitly extending proto. + + The returned collection will not include types which extend proto via + inheritance (as by `deftype` and `defrecord`). Only types extending + proto via `extend` (or `extend-protocol` or `extend-type`) will appear." + [proto] + (->> (get-in @protocols [proto :extending-types]) + (apply list))) + (defn extends? "Return true if type extends protocol proto." [proto type] - (some-> (get-in @protocols [proto :extending-types]) - (contains? type))) + (or (python/issubclass type proto) + (some-> (get-in @protocols [proto :extending-types]) + (contains? type)))) (defn satisfies? "Return true if x satisfies protocol proto." diff --git a/tests/basilisp/core_fns_test.lpy b/tests/basilisp/core_fns_test.lpy index 3fe90bd25..6bcebbfab 100644 --- a/tests/basilisp/core_fns_test.lpy +++ b/tests/basilisp/core_fns_test.lpy @@ -520,6 +520,8 @@ (deftest volatile-test (let [v (volatile! :a)] + (is (satisfies? IVolatile v)) + (is (not (satisfies? IVolatile @v))) (is (not (volatile? :a))) (is (not (volatile? (atom :a)))) (is (volatile? v)) From 770979201cf94697aad3ae15525603dfd07cc30a Mon Sep 17 00:00:00 2001 From: Christopher Rink Date: Wed, 18 Mar 2020 08:41:45 -0400 Subject: [PATCH 05/24] Getting there --- src/basilisp/core.lpy | 99 +++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 95 insertions(+), 4 deletions(-) diff --git a/src/basilisp/core.lpy b/src/basilisp/core.lpy index 894cea9da..a938f64a5 100644 --- a/src/basilisp/core.lpy +++ b/src/basilisp/core.lpy @@ -4908,13 +4908,52 @@ (boolean (get @protocols x))) (defn extend - [target-type & type+methods] - (let [proto-map (apply hash-map type+methods)] + "Extend a type dynamically with one or Protocol implementations. This is useful + for types which were defined outside your control or which were not otherwise + defined as direct implementors of the named Protocol(s). With `extend`, such + types may be extended without modifying the types directly. + + `target-type` should name a type which is to be extended. Virtually any type + is permitted, so long as that that type is not also a Protocol. + + `proto+methods` are interleaved Protocol names and maps of Protocol method + implementations intended for `target-type`. The keys of each map are keywords + corresponding to the names of the Protocol methods (as defined in the + `defprotocol`). Each value should be either an existing function (referenced + by its Var or name binding) or a new function definition. + + `extend` may be called multiple times for a single `target-type`, so not all + implementations need to be known a priori. Successive calls to `extend` on + `target-type` with the same Protocol implementations will overwrite previous + implementations. + + If you are extending types with explicit function definitions, the + `extend-protocol` and `extend-type` macros offer some additional conveniences. + + Returns `nil`. + + Example: + + (extend SomeType + FirstProto + {:spam spam-fn + :eggs (fn [...] ...)} + OtherProto + {:ham (fn [...] ...)})" + [target-type & proto+methods] + (let [proto-map (apply hash-map proto+methods)] (swap! protocols (fn [proto-state] + (when (contains? proto-state target-type) + (throw (ex-info "Protocols may not be extended with other Protocols" + {:target-type target-type}))) (reduce-kv (fn [m proto method-map] (when-not (contains? proto-state proto) - (throw (ex-info "Invalid protocol type" + (throw (ex-info "Specified Protocol does not exist" {:protocol proto}))) + (when (identical? target-type proto) + (throw (ex-info "Protocol may not extend itself" + {:target-type target-type + :proto proto}))) (let [proto-methods (get-in m [proto :methods])] (doseq [method-def method-map :let [[method-name fn] method-def]] @@ -4922,7 +4961,59 @@ (.add-method mmethod target-type fn)))) (update-in m [proto :extending-types] conj target-type)) proto-state - proto-map))))) + proto-map))) + nil)) + +(defn ^:private sym-and-method-groups + "Group methods for `extend-protocol` and `extend-type` into a map of interface + names to a vector of method bodies." + [specs] + (loop [iface (first specs) + specs (rest specs) + methods [] + groups {}] + (cond + (not (seq specs)) + (assoc groups iface methods) + + (list? (first specs)) + (recur iface + (rest specs) + (conj methods (first specs)) + groups) + + (symbol? (first specs)) + (recur (first specs) + (rest specs) + [] + (assoc groups iface methods))))) + +(defn ^:private extend-map + "Convert a vector of method definitions (as expected by `extend-protocol` and + `extend-type`) into a map of method definitions which can be passed to `extend`. " + [methods] + (reduce (fn [m fn-body] + (let [method-name (name (first fn-body))] + (assoc m (keyword method-name) (apply list `fn fn-body)))) + {} + methods)) + +(defmacro extend-protocol + "" + [proto & specs] + `(do ~@(map (fn [[target-type methods]] + `(extend ~target-type + ~proto + ~(extend-map methods))) + (sym-and-method-groups specs)))) + +(defmacro extend-type + "" + [target-type & specs] + `(extend ~target-type + ~@(mapcat (fn [[proto methods]] + [proto (extend-map methods)]) + (sym-and-method-groups specs)))) (defn extenders "Return a collection of types explicitly extending proto. From 9762f01e0decd5dfcb27d0f523ad575fba207374 Mon Sep 17 00:00:00 2001 From: Christopher Rink Date: Wed, 18 Mar 2020 08:59:10 -0400 Subject: [PATCH 06/24] Docstrings --- src/basilisp/core.lpy | 54 +++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 52 insertions(+), 2 deletions(-) diff --git a/src/basilisp/core.lpy b/src/basilisp/core.lpy index a938f64a5..162f9f72c 100644 --- a/src/basilisp/core.lpy +++ b/src/basilisp/core.lpy @@ -4999,7 +4999,34 @@ methods)) (defmacro extend-protocol - "" + "Extend a Protocol with implementations for multiple types. + + This convenience macro is useful for extending multiple different types with + a single Protocol definition in one call. Note that this macro only supports + new function declarations. If you intend to reference an existing function, + call `extend` directly. + + For example, this call: + + (extend-protocol SomeProto + FirstType + (spam [this] ...) + (eggs [this arg1 arg2] ...) + OtherType + (spam [this] ...) + (eggs [this arg1 arg2] ...)) + + Would be turned into the following `extend` calls: + + (do + (extend FirstType + SomeProto + {:spam (fn spam [this] ...) + :eggs (fn [this arg1 arg2] ...)}) + (extend OtherType + SomeProto + {:spam (fn spam [this] ...) + :eggs (fn [this arg1 arg2] ...)}))" [proto & specs] `(do ~@(map (fn [[target-type methods]] `(extend ~target-type @@ -5008,7 +5035,30 @@ (sym-and-method-groups specs)))) (defmacro extend-type - "" + "Extend a type with multiple Protocol implementations. + + This convenience macro is useful for extending a single type with multiple + different Protocol definitions in one call. Note that this macro only supports + new function declarations. If you intend to reference an existing function, + call `extend` directly. + + For example, this call: + + (extend-type SomeType + FirstProto + (spam [this] ...) + (eggs [this arg1 arg2] ...) + SecondProto + (ham [this & args] ...)) + + Would be turned into the following `extend` call: + + (extend SomeType + FirstProto + {:spam (fn spam [this] ...) + :eggs (fn eggs [this arg1 arg2] ...)} + SecondProto + {:ham (fn ham [this & args] ...)})" [target-type & specs] `(extend ~target-type ~@(mapcat (fn [[proto methods]] From 788e1216d8f40017cba22f9077072609edacb230 Mon Sep 17 00:00:00 2001 From: Christopher Rink Date: Wed, 18 Mar 2020 21:13:53 -0400 Subject: [PATCH 07/24] Simple tests --- tests/basilisp/test_protocols.lpy | 38 +++++++++++++++++++++++++++++++ 1 file changed, 38 insertions(+) diff --git a/tests/basilisp/test_protocols.lpy b/tests/basilisp/test_protocols.lpy index dceee160d..b4c8711d6 100644 --- a/tests/basilisp/test_protocols.lpy +++ b/tests/basilisp/test_protocols.lpy @@ -1,3 +1,41 @@ (ns tests.basilisp.test-protocols + (:import math) (:require [basilisp.test :refer [deftest is testing]])) + +(defprotocol Shape + (area + [] + "Return the area of the shape.")) + +(defprotocol Polygon + (interior-angle + [] + "Return the interior angle of the shape in degrees.")) + +(defrecord Circle [radius] + Shape + (area [this] (* math/pi radius radius))) + +(defrecord Rectangle [x y] + Shape + (area [this] (* x y)) + Polygon + (interior-angle [this] 360)) + +(deftest protocol?-test + (is (protocol? Shape)) + (is (not (protocol? Circle))) + (is (not (protocol? Rectangle)))) + +(deftest extends?-test + (is (extends? Shape Circle)) + (is (extends? Shape Rectangle)) + (is (not (extends? Polygon Circle))) + (is (extends? Polygon Rectangle))) + +(deftest satisfies?-test + (is (satisfies? Shape (->Circle 1))) + (is (satisfies? Shape (->Rectangle 2 2))) + (is (not (satisfies? Polygon (->Circle 1)))) + (is (satisfies? Polygon (->Rectangle 2 2)))) From 36d8e4727e87b823cb164c42ecb792033833ced7 Mon Sep 17 00:00:00 2001 From: Christopher Rink Date: Wed, 18 Mar 2020 21:49:03 -0400 Subject: [PATCH 08/24] Tests --- src/basilisp/core.lpy | 7 ++++--- src/basilisp/lang/runtime.py | 2 +- tests/basilisp/test_protocols.lpy | 30 +++++++++++++++++++++++++++--- 3 files changed, 32 insertions(+), 7 deletions(-) diff --git a/src/basilisp/core.lpy b/src/basilisp/core.lpy index 162f9f72c..ffb6692d5 100644 --- a/src/basilisp/core.lpy +++ b/src/basilisp/core.lpy @@ -4861,14 +4861,15 @@ (defn ^:private gen-protocol-multi "Return the `defmulti` and default `defmethod` for a protocol method." - [[method-name args docstring]] - (let [dotted-method-name (symbol (str "." (name method-name))) + [[method-name args :as method-def]] + (let [docstring (nth method-def 2 nil) + dotted-method-name (symbol (str "." (name method-name))) has-varargs (some #(= '& %) args) clean-args (filter #(not= '& %) args) obj-sym (gensym "o")] [`(defmulti ~method-name - ~docstring + ~@(when docstring [docstring]) (fn [~obj-sym ~@(map #(vary-meta % assoc :no-warn-when-unused true) args)] (python/type ~obj-sym))) `(defmethod ~method-name :default diff --git a/src/basilisp/lang/runtime.py b/src/basilisp/lang/runtime.py index 1c2ca097c..e8fc92d83 100644 --- a/src/basilisp/lang/runtime.py +++ b/src/basilisp/lang/runtime.py @@ -1132,7 +1132,7 @@ def contains(coll, k): def get(m, k, default=None): """Return the value of k in m. Return default if k not found in m.""" if isinstance(m, ILookup): - return m.val_at(k, default=default) + return m.val_at(k, default) try: return m[k] diff --git a/tests/basilisp/test_protocols.lpy b/tests/basilisp/test_protocols.lpy index b4c8711d6..5973b26c8 100644 --- a/tests/basilisp/test_protocols.lpy +++ b/tests/basilisp/test_protocols.lpy @@ -4,9 +4,7 @@ [basilisp.test :refer [deftest is testing]])) (defprotocol Shape - (area - [] - "Return the area of the shape.")) + (area [])) (defprotocol Polygon (interior-angle @@ -23,11 +21,37 @@ Polygon (interior-angle [this] 360)) +(defrecord Square [x]) + +(extend-type Square + Shape + (area [this] + (let [side (get this :x)] + (* side side)))) + +(deftest Shape-area-method-test + (is (= math/pi (area (->Circle 1)))) + (is (= 4 (area (->Rectangle 2 2)))) + (is (= 9 (area (->Square 3)))) + + (is (thrown? python/AttributeError (area :a))) + (is (thrown? python/AttributeError (area [4 5])))) + +(deftest Polygon-interior-angle-test + (is (= 360 (interior-angle (->Rectangle 2 2)))) + + (is (thrown? python/AttributeError (interior-angle (->Circle 1)))) + (is (thrown? python/AttributeError (interior-angle (->Square 3))))) + (deftest protocol?-test (is (protocol? Shape)) (is (not (protocol? Circle))) (is (not (protocol? Rectangle)))) +(deftest extenders-test + (is (= (list Square) (extenders Shape))) + (is (not (seq (extenders Polygon))))) + (deftest extends?-test (is (extends? Shape Circle)) (is (extends? Shape Rectangle)) From 4f6bb29ad1f098da48594942acd8302793ab6abe Mon Sep 17 00:00:00 2001 From: Christopher Rink Date: Thu, 19 Mar 2020 09:13:03 -0400 Subject: [PATCH 09/24] Extend tests --- tests/basilisp/test_protocols.lpy | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/tests/basilisp/test_protocols.lpy b/tests/basilisp/test_protocols.lpy index 5973b26c8..7084ba461 100644 --- a/tests/basilisp/test_protocols.lpy +++ b/tests/basilisp/test_protocols.lpy @@ -48,6 +48,19 @@ (is (not (protocol? Circle))) (is (not (protocol? Rectangle)))) +(deftest extend-test + (testing "Protocols cannot extend other Protocols" + (is (thrown? basilisp.lang.exception/ExceptionInfo + (extend Polygon Shape {:area identity})))) + + (testing "Protocol must be defined as by defprotocol" + (is (thrown? basilisp.lang.exception/ExceptionInfo + (extend Square python/str {:area identity})))) + + (testing "Protocols cannot extend themselves" + (is (thrown? basilisp.lang.exception/ExceptionInfo + (extend Shape Shape {:area identity}))))) + (deftest extenders-test (is (= (list Square) (extenders Shape))) (is (not (seq (extenders Polygon))))) From b5d0cfae7b18144d2e59910c5564dd6ff6c7b9e2 Mon Sep 17 00:00:00 2001 From: Christopher Rink Date: Sat, 21 Mar 2020 22:23:49 -0400 Subject: [PATCH 10/24] Lots of stuff all mashed up --- src/basilisp/core.lpy | 512 ++++++++++++------------ src/basilisp/lang/compiler/analyzer.py | 10 + src/basilisp/lang/compiler/generator.py | 7 +- src/basilisp/lang/compiler/nodes.py | 1 + 4 files changed, 274 insertions(+), 256 deletions(-) diff --git a/src/basilisp/core.lpy b/src/basilisp/core.lpy index ffb6692d5..4baec13ce 100644 --- a/src/basilisp/core.lpy +++ b/src/basilisp/core.lpy @@ -2826,8 +2826,8 @@ a `name` is not already defined as a Var in this namespace. `expr` will not be evaluated if the Var already exists." [name expr] - `(let [v (def ~name)] - (when-not (.-is-bound v) + `(let [v# (def ~name)] + (when-not (.-is-bound v#) (def ~name ~expr)))) (defmacro for @@ -4417,9 +4417,9 @@ ([o & {:keys [keywordize-keys] :or {keywordize-keys true}}] (basilisp.lang.runtime/to-lisp o keywordize-keys))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Data Types & Protocols ;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;; +;; Interfaces ;; +;;;;;;;;;;;;;;;; (import* abc) @@ -4497,6 +4497,256 @@ `(def ~interface-name (gen-interface ~name-str [~@method-sigs])))) +;;;;;;;;;;;;;;; +;; Protocols ;; +;;;;;;;;;;;;;;; + +(defn ^:private gen-protocol-multi + "Return the `defmulti` and default `defmethod` for a protocol method." + [[method-name args :as method-def]] + (let [docstring (nth method-def 2 nil) + dotted-method-name (symbol (str "." (name method-name))) + has-varargs (some #(= '& %) args) + clean-args (filter #(not= '& %) args) + + obj-sym (gensym "o")] + [`(defmulti ~method-name + ~@(when docstring [docstring]) + (fn [~obj-sym ~@(map #(vary-meta % assoc :no-warn-when-unused true) args)] + (python/type ~obj-sym))) + `(defmethod ~method-name :default + [~obj-sym ~@args] + ~(if has-varargs + `(apply-method ~obj-sym ~method-name ~@clean-args) + `(~dotted-method-name ~obj-sym ~@clean-args)))])) + +;; For each protocol, the following keys are defined: +;; +;; - :impls - a set of types which dynamically extend the Protocol +;; (e.g. by `extend`) +;; - :interface - the Python interface type which backs the Protocol +;; - :methods - a mapping of method names (as Basilisp keywords) to the multi- +;; method backing the Protocol method +;; - :var - a reference to the Var the Protocol is stored in + +(defmacro defprotocol + "Define a new protocol. + + Protocols consist of an interface (a Python `ABC`) and a set of generated methods + which dispatch to objects implementing the interface." + [protocol-name & methods] + (let [doc (when (string? (first methods)) + (first methods)) + methods (if doc (rest methods) methods) + protocol-name (vary-meta + (cond-> protocol-name + doc (vary-meta assoc :doc doc)) + assoc :protocol true)] + `(do + (defonce ~protocol-name {}) + (alter-meta! (var ~protocol-name) assoc :doc ~doc) + ~@(mapcat gen-protocol-multi methods) + (->> {:impls #{} + :interface (gen-interface ~(name protocol-name) + [~@(map #(list 'quote %) methods)]) + :methods ~(apply hash-map + (mapcat #(let [v (first %)] + [(keyword (name v)) v]) + methods)) + :var (var ~protocol-name)} + (alter-var-root (var ~protocol-name) merge ~protocol-name)) + ~protocol-name))) + +(defn ^:private protocol? + "Return true if x is a Protocol." + [x] + (boolean (and (map? x) (:interface x)))) + +(defn extend + "Extend a type dynamically with one or Protocol implementations. This is useful + for types which were defined outside your control or which were not otherwise + defined as direct implementors of the named Protocol(s). With `extend`, such + types may be extended without modifying the types directly. + + `target-type` should name a type which is to be extended. Virtually any type + is permitted, so long as that that type is not also a Protocol. + + `proto+methods` are interleaved Protocol names and maps of Protocol method + implementations intended for `target-type`. The keys of each map are keywords + corresponding to the names of the Protocol methods (as defined in the + `defprotocol`). Each value should be either an existing function (referenced + by its Var or name binding) or a new function definition. + + `extend` may be called multiple times for a single `target-type`, so not all + implementations need to be known a priori. Successive calls to `extend` on + `target-type` with the same Protocol implementations will overwrite previous + implementations. + + If you are extending types with explicit function definitions, the + `extend-protocol` and `extend-type` macros offer some additional conveniences. + + Returns `nil`. + + Example: + + (extend SomeType + FirstProto + {:spam spam-fn + :eggs (fn [...] ...)} + OtherProto + {:ham (fn [...] ...)})" + [target-type & proto+methods] + (cond + (protocol? target-type) + (throw (ex-info "Protocols may not be extended with other Protocols" + {:target-type target-type})) + + (instance? python/type target-type) + (throw (ex-info "extend target-type must be a type" + {:target-type target-type})) + + :else nil) + + (doseq [proto-pair (apply hash-map proto+methods) + :let [[proto method-map] proto-pair + proto-methods (:methods proto)]] + (when (identical? target-type proto) + (throw (ex-info "Protocol may not extend itself" + {:target-type target-type + :proto proto}))) + (doseq [method-def method-map + :let [[method-name fn] method-def]] + (let [mmethod (get proto-methods method-name)] + (.add-method mmethod target-type fn))) + (alter-var-root update (:var proto) :extending-types conj target-type)) + nil) + +(defn ^:private sym-and-method-groups + "Group methods for `extend-protocol` and `extend-type` into a map of interface + names to a vector of method bodies." + [specs] + (loop [iface (first specs) + specs (rest specs) + methods [] + groups {}] + (cond + (not (seq specs)) + (assoc groups iface methods) + + (list? (first specs)) + (recur iface + (rest specs) + (conj methods (first specs)) + groups) + + (symbol? (first specs)) + (recur (first specs) + (rest specs) + [] + (assoc groups iface methods))))) + +(defn ^:private extend-map + "Convert a vector of method definitions (as expected by `extend-protocol` and + `extend-type`) into a map of method definitions which can be passed to `extend`. " + [methods] + (reduce (fn [m fn-body] + (let [method-name (name (first fn-body))] + (assoc m (keyword method-name) (apply list `fn fn-body)))) + {} + methods)) + +(defmacro extend-protocol + "Extend a Protocol with implementations for multiple types. + + This convenience macro is useful for extending multiple different types with + a single Protocol definition in one call. Note that this macro only supports + new function declarations. If you intend to reference an existing function, + call `extend` directly. + + For example, this call: + + (extend-protocol SomeProto + FirstType + (spam [this] ...) + (eggs [this arg1 arg2] ...) + OtherType + (spam [this] ...) + (eggs [this arg1 arg2] ...)) + + Would be turned into the following `extend` calls: + + (do + (extend FirstType + SomeProto + {:spam (fn spam [this] ...) + :eggs (fn [this arg1 arg2] ...)}) + (extend OtherType + SomeProto + {:spam (fn spam [this] ...) + :eggs (fn [this arg1 arg2] ...)}))" + [proto & specs] + `(do ~@(map (fn [[target-type methods]] + `(extend ~target-type + ~proto + ~(extend-map methods))) + (sym-and-method-groups specs)))) + +(defmacro extend-type + "Extend a type with multiple Protocol implementations. + + This convenience macro is useful for extending a single type with multiple + different Protocol definitions in one call. Note that this macro only supports + new function declarations. If you intend to reference an existing function, + call `extend` directly. + + For example, this call: + + (extend-type SomeType + FirstProto + (spam [this] ...) + (eggs [this arg1 arg2] ...) + SecondProto + (ham [this & args] ...)) + + Would be turned into the following `extend` call: + + (extend SomeType + FirstProto + {:spam (fn spam [this] ...) + :eggs (fn eggs [this arg1 arg2] ...)} + SecondProto + {:ham (fn ham [this & args] ...)})" + [target-type & specs] + `(extend ~target-type + ~@(mapcat (fn [[proto methods]] + [proto (extend-map methods)]) + (sym-and-method-groups specs)))) + +(defn extenders + "Return a collection of types explicitly extending proto. + + The returned collection will not include types which extend proto via + inheritance (as by `deftype` and `defrecord`). Only types extending + proto via `extend` (or `extend-protocol` or `extend-type`) will appear." + [{:keys [impls] :as proto}] + (apply list impls)) + +(defn extends? + "Return true if type extends protocol proto." + [{:keys [interface impls] :as proto} type] + (or (python/issubclass type interface) + (contains? impls type))) + +(defn satisfies? + "Return true if x satisfies protocol proto." + [{:keys [interface impls] :as proto} x] + (or (instance? interface x) + (python/isinstance x (python/tuple impls)))) + +;;;;;;;;;;;;;;;; +;; Data Types ;; +;;;;;;;;;;;;;;;; + (defn ^:private collect-methods "Collect method and interface declarations for `deftype` and `defrecord` into a map containing `:interfaces` and `:methods` keys." @@ -4566,6 +4816,10 @@ (def ~ctor-name ~type-name) ~type-name))) +;;;;;;;;;;;;; +;; Records ;; +;;;;;;;;;;;;; + (import* attr) (defn record? @@ -4842,254 +5096,6 @@ ~type-name))) -;;;;;;;;;;;;;;; -;; Protocols ;; -;;;;;;;;;;;;;;; - -(def ^:private protocols - "Internal registry of all Protocols. - - The registry is a mapping of Protocol types to a map of details about the - protocol. For each protocol, the following keys are defined: - - - :extending-types - a set of types which dynamically extend the Protocol - (e.g. by `extend`) - - :interface - the Python interface type which backs the Protocol - - :methods - a mapping of method names (as Basilisp keywords) to - the multi-method backing the Protocol method" - (atom {})) - -(defn ^:private gen-protocol-multi - "Return the `defmulti` and default `defmethod` for a protocol method." - [[method-name args :as method-def]] - (let [docstring (nth method-def 2 nil) - dotted-method-name (symbol (str "." (name method-name))) - has-varargs (some #(= '& %) args) - clean-args (filter #(not= '& %) args) - - obj-sym (gensym "o")] - [`(defmulti ~method-name - ~@(when docstring [docstring]) - (fn [~obj-sym ~@(map #(vary-meta % assoc :no-warn-when-unused true) args)] - (python/type ~obj-sym))) - `(defmethod ~method-name :default - [~obj-sym ~@args] - ~(if has-varargs - `(apply-method ~obj-sym ~method-name ~@clean-args) - `(~dotted-method-name ~obj-sym ~@clean-args)))])) - -(defmacro defprotocol - "Define a new protocol. - - Protocols consist of an interface (a Python `ABC`) and a set of generated methods - which dispatch to objects implementing the interface." - [protocol-name & methods] - (let [doc (when (string? (first methods)) - (first methods)) - methods (if doc (rest methods) methods) - protocol-name (vary-meta - (cond-> protocol-name - doc (vary-meta assoc :doc doc)) - assoc :protocol true)] - `(do - (definterface ~protocol-name ~@methods) - ~@(mapcat gen-protocol-multi methods) - (->> {:extending-types #{} - :interface ~protocol-name - :methods ~(apply hash-map - (mapcat #(let [v (first %)] - [(keyword (name v)) v]) - methods))} - (swap! protocols assoc ~protocol-name)) - ~protocol-name))) - -(defn protocol? - "Return true if x is a Protocol." - [x] - (boolean (get @protocols x))) - -(defn extend - "Extend a type dynamically with one or Protocol implementations. This is useful - for types which were defined outside your control or which were not otherwise - defined as direct implementors of the named Protocol(s). With `extend`, such - types may be extended without modifying the types directly. - - `target-type` should name a type which is to be extended. Virtually any type - is permitted, so long as that that type is not also a Protocol. - - `proto+methods` are interleaved Protocol names and maps of Protocol method - implementations intended for `target-type`. The keys of each map are keywords - corresponding to the names of the Protocol methods (as defined in the - `defprotocol`). Each value should be either an existing function (referenced - by its Var or name binding) or a new function definition. - - `extend` may be called multiple times for a single `target-type`, so not all - implementations need to be known a priori. Successive calls to `extend` on - `target-type` with the same Protocol implementations will overwrite previous - implementations. - - If you are extending types with explicit function definitions, the - `extend-protocol` and `extend-type` macros offer some additional conveniences. - - Returns `nil`. - - Example: - - (extend SomeType - FirstProto - {:spam spam-fn - :eggs (fn [...] ...)} - OtherProto - {:ham (fn [...] ...)})" - [target-type & proto+methods] - (let [proto-map (apply hash-map proto+methods)] - (swap! protocols (fn [proto-state] - (when (contains? proto-state target-type) - (throw (ex-info "Protocols may not be extended with other Protocols" - {:target-type target-type}))) - (reduce-kv (fn [m proto method-map] - (when-not (contains? proto-state proto) - (throw (ex-info "Specified Protocol does not exist" - {:protocol proto}))) - (when (identical? target-type proto) - (throw (ex-info "Protocol may not extend itself" - {:target-type target-type - :proto proto}))) - (let [proto-methods (get-in m [proto :methods])] - (doseq [method-def method-map - :let [[method-name fn] method-def]] - (let [mmethod (get proto-methods method-name)] - (.add-method mmethod target-type fn)))) - (update-in m [proto :extending-types] conj target-type)) - proto-state - proto-map))) - nil)) - -(defn ^:private sym-and-method-groups - "Group methods for `extend-protocol` and `extend-type` into a map of interface - names to a vector of method bodies." - [specs] - (loop [iface (first specs) - specs (rest specs) - methods [] - groups {}] - (cond - (not (seq specs)) - (assoc groups iface methods) - - (list? (first specs)) - (recur iface - (rest specs) - (conj methods (first specs)) - groups) - - (symbol? (first specs)) - (recur (first specs) - (rest specs) - [] - (assoc groups iface methods))))) - -(defn ^:private extend-map - "Convert a vector of method definitions (as expected by `extend-protocol` and - `extend-type`) into a map of method definitions which can be passed to `extend`. " - [methods] - (reduce (fn [m fn-body] - (let [method-name (name (first fn-body))] - (assoc m (keyword method-name) (apply list `fn fn-body)))) - {} - methods)) - -(defmacro extend-protocol - "Extend a Protocol with implementations for multiple types. - - This convenience macro is useful for extending multiple different types with - a single Protocol definition in one call. Note that this macro only supports - new function declarations. If you intend to reference an existing function, - call `extend` directly. - - For example, this call: - - (extend-protocol SomeProto - FirstType - (spam [this] ...) - (eggs [this arg1 arg2] ...) - OtherType - (spam [this] ...) - (eggs [this arg1 arg2] ...)) - - Would be turned into the following `extend` calls: - - (do - (extend FirstType - SomeProto - {:spam (fn spam [this] ...) - :eggs (fn [this arg1 arg2] ...)}) - (extend OtherType - SomeProto - {:spam (fn spam [this] ...) - :eggs (fn [this arg1 arg2] ...)}))" - [proto & specs] - `(do ~@(map (fn [[target-type methods]] - `(extend ~target-type - ~proto - ~(extend-map methods))) - (sym-and-method-groups specs)))) - -(defmacro extend-type - "Extend a type with multiple Protocol implementations. - - This convenience macro is useful for extending a single type with multiple - different Protocol definitions in one call. Note that this macro only supports - new function declarations. If you intend to reference an existing function, - call `extend` directly. - - For example, this call: - - (extend-type SomeType - FirstProto - (spam [this] ...) - (eggs [this arg1 arg2] ...) - SecondProto - (ham [this & args] ...)) - - Would be turned into the following `extend` call: - - (extend SomeType - FirstProto - {:spam (fn spam [this] ...) - :eggs (fn eggs [this arg1 arg2] ...)} - SecondProto - {:ham (fn ham [this & args] ...)})" - [target-type & specs] - `(extend ~target-type - ~@(mapcat (fn [[proto methods]] - [proto (extend-map methods)]) - (sym-and-method-groups specs)))) - -(defn extenders - "Return a collection of types explicitly extending proto. - - The returned collection will not include types which extend proto via - inheritance (as by `deftype` and `defrecord`). Only types extending - proto via `extend` (or `extend-protocol` or `extend-type`) will appear." - [proto] - (->> (get-in @protocols [proto :extending-types]) - (apply list))) - -(defn extends? - "Return true if type extends protocol proto." - [proto type] - (or (python/issubclass type proto) - (some-> (get-in @protocols [proto :extending-types]) - (contains? type)))) - -(defn satisfies? - "Return true if x satisfies protocol proto." - [proto x] - (or (instance? proto x) - (let [types (get-in @protocols [proto :extending-types])] - (python/isinstance x (python/tuple types))))) - ;;;;;;;;;;;;;;; ;; Volatiles ;; ;;;;;;;;;;;;;;; diff --git a/src/basilisp/lang/compiler/analyzer.py b/src/basilisp/lang/compiler/analyzer.py index 2989017e6..f77e41410 100644 --- a/src/basilisp/lang/compiler/analyzer.py +++ b/src/basilisp/lang/compiler/analyzer.py @@ -403,6 +403,15 @@ def is_async_ctx(self) -> bool: except IndexError: return False + @property + def in_func_ctx(self) -> bool: + try: + self._func_ctx[-1] + except IndexError: + return False + else: + return True + @contextlib.contextmanager def new_func_ctx(self, is_async: bool = False): self._func_ctx.append(is_async) @@ -801,6 +810,7 @@ def _def_ast( # pylint: disable=too-many-branches,too-many-locals var=var, init=init, doc=doc, + in_func_ctx=ctx.in_func_ctx, children=children, env=def_node_env, ) diff --git a/src/basilisp/lang/compiler/generator.py b/src/basilisp/lang/compiler/generator.py index 6bbcf1c89..d6556fc3f 100644 --- a/src/basilisp/lang/compiler/generator.py +++ b/src/basilisp/lang/compiler/generator.py @@ -721,11 +721,12 @@ def _def_to_py_ast( # pylint: disable=too-many-branches # global declaration prior to emitting the Python `def` otherwise the # Python compiler will throw an exception during compilation # complaining that we assign the value prior to global declaration. + should_emit_global_decl = bool(node.top_level and not node.in_func_ctx) if is_defn: assert def_ast is not None, "def_ast must be defined at this point" def_dependencies = list( chain( - [] if node.top_level else [ast.Global(names=[safe_name])], + [ast.Global(names=[safe_name])] if should_emit_global_decl else [], def_ast.dependencies, [] if meta_ast is None else meta_ast.dependencies, ) @@ -736,7 +737,7 @@ def _def_to_py_ast( # pylint: disable=too-many-branches assert def_ast is None, "def_ast is not defined at this point" def_dependencies = list( chain( - [] if node.top_level else [ast.Global(names=[safe_name])], + [ast.Global(names=[safe_name])] if should_emit_global_decl else [], [] if meta_ast is None else meta_ast.dependencies, ) ) @@ -745,7 +746,7 @@ def _def_to_py_ast( # pylint: disable=too-many-branches def_dependencies = list( chain( def_ast.dependencies, - [] if node.top_level else [ast.Global(names=[safe_name])], + [ast.Global(names=[safe_name])] if should_emit_global_decl else [], [ ast.Assign( targets=[ast.Name(id=safe_name, ctx=ast.Store())], diff --git a/src/basilisp/lang/compiler/nodes.py b/src/basilisp/lang/compiler/nodes.py index e53b0cac9..722b0fb96 100644 --- a/src/basilisp/lang/compiler/nodes.py +++ b/src/basilisp/lang/compiler/nodes.py @@ -351,6 +351,7 @@ class Def(Node[SpecialForm]): var: Var init: Optional[Node] doc: Optional[str] + in_func_ctx: bool env: NodeEnv meta: NodeMeta = None children: Sequence[kw.Keyword] = vec.Vector.empty() From 295258d4d01b62c08c4e0a01fb7ed11b6f3f169c Mon Sep 17 00:00:00 2001 From: Christopher Rink Date: Sun, 22 Mar 2020 18:12:48 -0400 Subject: [PATCH 11/24] Compiler support --- src/basilisp/core.lpy | 9 ++--- src/basilisp/lang/compiler/analyzer.py | 14 +++++++- src/basilisp/lang/compiler/constants.py | 2 ++ src/basilisp/lang/compiler/generator.py | 45 +++++++++++++++++++++---- 4 files changed, 58 insertions(+), 12 deletions(-) diff --git a/src/basilisp/core.lpy b/src/basilisp/core.lpy index 4baec13ce..4e564d3e2 100644 --- a/src/basilisp/core.lpy +++ b/src/basilisp/core.lpy @@ -4544,7 +4544,10 @@ assoc :protocol true)] `(do (defonce ~protocol-name {}) - (alter-meta! (var ~protocol-name) assoc :doc ~doc) + (alter-meta! (var ~protocol-name) + assoc + :doc ~doc + :basilisp.core/protocol true) ~@(mapcat gen-protocol-multi methods) (->> {:impls #{} :interface (gen-interface ~(name protocol-name) @@ -4603,9 +4606,7 @@ (instance? python/type target-type) (throw (ex-info "extend target-type must be a type" - {:target-type target-type})) - - :else nil) + {:target-type target-type}))) (doseq [proto-pair (apply hash-map proto+methods) :let [[proto method-map] proto-pair diff --git a/src/basilisp/lang/compiler/analyzer.py b/src/basilisp/lang/compiler/analyzer.py index d8f1931c7..71fb24384 100644 --- a/src/basilisp/lang/compiler/analyzer.py +++ b/src/basilisp/lang/compiler/analyzer.py @@ -62,6 +62,7 @@ SYM_PRIVATE_META_KEY, SYM_PROPERTY_META_KEY, SYM_STATICMETHOD_META_KEY, + VAR_IS_PROTOCOL_META_KEY, SpecialForm, ) from basilisp.lang.compiler.exception import CompilerException, CompilerPhase @@ -143,6 +144,7 @@ # Constants used in analyzing AS = kw.keyword("as") IMPLEMENTS = kw.keyword("implements") +INTERFACE = kw.keyword("interface") _DOUBLE_DOT_MACRO_NAME = ".." _BUILTINS_NS = "python" @@ -1245,6 +1247,9 @@ def __is_abstract(tp: Type) -> bool: ) +_var_is_protocol = _meta_getter(VAR_IS_PROTOCOL_META_KEY) + + def __assert_deftype_impls_are_abstract( # pylint: disable=too-many-branches,too-many-locals fields: Iterable[str], interfaces: Iterable[DefTypeBase], @@ -1258,7 +1263,14 @@ def __assert_deftype_impls_are_abstract( # pylint: disable=too-many-branches,to if isinstance(interface, (MaybeClass, MaybeHostForm)): interface_type = interface.target elif isinstance(interface, VarRef): - interface_type = interface.var.value + # Protocols are defined as maps, with the interface being simply a member + # of the map, denoted by the keyword `:interface`. + if _var_is_protocol(interface.var): + proto_map = interface.var.value + assert isinstance(proto_map, lmap.Map) + interface_type = proto_map.val_at(INTERFACE) + else: + interface_type = interface.var.value else: # pragma: no cover assert False, "Interface must be MaybeClass, MaybeHostForm, or VarRef" diff --git a/src/basilisp/lang/compiler/constants.py b/src/basilisp/lang/compiler/constants.py index 1d590b6e0..e8faecd90 100644 --- a/src/basilisp/lang/compiler/constants.py +++ b/src/basilisp/lang/compiler/constants.py @@ -156,3 +156,5 @@ class SpecialForm: LINE_KW = kw.keyword("line") NAME_KW = kw.keyword("name") NS_KW = kw.keyword("ns") + +VAR_IS_PROTOCOL_META_KEY = kw.keyword("protocol", "basilisp.core") diff --git a/src/basilisp/lang/compiler/generator.py b/src/basilisp/lang/compiler/generator.py index a0c2bfe4f..f4afb590c 100644 --- a/src/basilisp/lang/compiler/generator.py +++ b/src/basilisp/lang/compiler/generator.py @@ -41,6 +41,7 @@ SYM_DYNAMIC_META_KEY, SYM_NO_WARN_ON_REDEF_META_KEY, SYM_REDEF_META_KEY, + VAR_IS_PROTOCOL_META_KEY, ) from basilisp.lang.compiler.exception import CompilerException, CompilerPhase from basilisp.lang.compiler.nodes import ( @@ -919,6 +920,42 @@ def __deftype_member_to_py_ast( return handle_deftype_member(ctx, node) +def __deftype_bases_to_py_ast(ctx: GeneratorContext, node: DefType) -> List[ast.AST]: + """Return a list of AST nodes for the base classes for a `deftype*`.""" + bases: List[ast.AST] = [] + for base in node.interfaces: + base_node = gen_py_ast(ctx, base) + assert ( + count(base_node.dependencies) == 0 + ), "Class and host form nodes do not have dependencies" + + # Protocols are defined as Maps + if ( + isinstance(base, VarRef) + and base.var.meta is not None + and base.var.meta.val_at(VAR_IS_PROTOCOL_META_KEY) + ): + bases.append( + ast.Call( + func=ast.Attribute( + value=base_node.node, attr="val_at", ctx=ast.Load() + ), + args=[ + ast.Call( + func=_NEW_KW_FN_NAME, + args=[ast.Constant("interface")], + keywords=[], + ) + ], + keywords=[], + ) + ) + else: + bases.append(base_node.node) + + return bases + + _ATTR_CMP_OFF = getattr(attr, "__version_info__", (0,)) >= (19, 2) _ATTR_CMP_KWARGS = ( [ @@ -939,13 +976,7 @@ def _deftype_to_py_ast( # pylint: disable=too-many-branches type_name = munge(node.name) ctx.symbol_table.new_symbol(sym.symbol(node.name), type_name, LocalType.DEFTYPE) - bases = [] - for base in node.interfaces: - base_node = gen_py_ast(ctx, base) - assert ( - count(base_node.dependencies) == 0 - ), "Class and host form nodes do not have dependencies" - bases.append(base_node.node) + bases = __deftype_bases_to_py_ast(ctx, node) decorator = ast.Call( func=_ATTR_CLASS_DECORATOR_NAME, From c14749b41f42d335722b710829e01470980425b1 Mon Sep 17 00:00:00 2001 From: Christopher Rink Date: Sun, 22 Mar 2020 18:44:45 -0400 Subject: [PATCH 12/24] Oopsie --- src/basilisp/core.lpy | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/basilisp/core.lpy b/src/basilisp/core.lpy index 4e564d3e2..ddd192f4e 100644 --- a/src/basilisp/core.lpy +++ b/src/basilisp/core.lpy @@ -4604,7 +4604,7 @@ (throw (ex-info "Protocols may not be extended with other Protocols" {:target-type target-type})) - (instance? python/type target-type) + (not (instance? python/type target-type)) (throw (ex-info "extend target-type must be a type" {:target-type target-type}))) From 4a39175c8238add0764a79e4fcb0fbed4fcc9a41 Mon Sep 17 00:00:00 2001 From: Christopher Rink Date: Thu, 28 May 2020 20:18:38 -0400 Subject: [PATCH 13/24] Fix gen-interface call --- src/basilisp/core.lpy | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/basilisp/core.lpy b/src/basilisp/core.lpy index 01955a2a4..9c483b615 100644 --- a/src/basilisp/core.lpy +++ b/src/basilisp/core.lpy @@ -4634,8 +4634,8 @@ :basilisp.core/protocol true) ~@(mapcat gen-protocol-multi methods) (->> {:impls #{} - :interface (gen-interface ~(name protocol-name) - [~@(map #(list 'quote %) methods)]) + :interface (gen-interface :name ~(name protocol-name) + :methods [~@(map #(list 'quote %) methods)]) :methods ~(apply hash-map (mapcat #(let [v (first %)] [(keyword (name v)) v]) From f1e7b73cf7f55eb78637620eeddaef49f30a9aa8 Mon Sep 17 00:00:00 2001 From: Christopher Rink Date: Thu, 28 May 2020 20:53:54 -0400 Subject: [PATCH 14/24] Fix that redef --- src/basilisp/core.lpy | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/basilisp/core.lpy b/src/basilisp/core.lpy index 9c483b615..d3702c972 100644 --- a/src/basilisp/core.lpy +++ b/src/basilisp/core.lpy @@ -4625,7 +4625,9 @@ protocol-name (vary-meta (cond-> protocol-name doc (vary-meta assoc :doc doc)) - assoc :protocol true)] + assoc + :protocol true + :redef true)] `(do (defonce ~protocol-name {}) (alter-meta! (var ~protocol-name) From a870e8498fe22fdb961ae6d7c7cb3301a017b71a Mon Sep 17 00:00:00 2001 From: Christopher Rink Date: Thu, 28 May 2020 21:37:11 -0400 Subject: [PATCH 15/24] Fix a bunch of buggos --- src/basilisp/core.lpy | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/basilisp/core.lpy b/src/basilisp/core.lpy index d3702c972..48381b06f 100644 --- a/src/basilisp/core.lpy +++ b/src/basilisp/core.lpy @@ -4705,7 +4705,7 @@ :let [[method-name fn] method-def]] (let [mmethod (get proto-methods method-name)] (.add-method mmethod target-type fn))) - (alter-var-root update (:var proto) :extending-types conj target-type)) + (alter-var-root (:var proto) update :extending-types conj target-type)) nil) (defn ^:private sym-and-method-groups @@ -5282,4 +5282,4 @@ (defn volatile? "Return true if implements IVolatile." [x] - (instance? IVolatile x)) + (satisfies? IVolatile x)) From 852fd2745e3c3b6261cefdc82defa4e760a1d33e Mon Sep 17 00:00:00 2001 From: Christopher Rink Date: Thu, 28 May 2020 22:01:42 -0400 Subject: [PATCH 16/24] Do better --- src/basilisp/core.lpy | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) diff --git a/src/basilisp/core.lpy b/src/basilisp/core.lpy index 48381b06f..9243f449f 100644 --- a/src/basilisp/core.lpy +++ b/src/basilisp/core.lpy @@ -4695,17 +4695,21 @@ {:target-type target-type}))) (doseq [proto-pair (apply hash-map proto+methods) - :let [[proto method-map] proto-pair - proto-methods (:methods proto)]] + :let [[proto method-map] proto-pair]] + (when-not (protocol? proto) + (throw (ex-info "extend protocol must be protocol as defined by defprotocol" + {:target-type target-type + :proto proto}))) (when (identical? target-type proto) (throw (ex-info "Protocol may not extend itself" {:target-type target-type :proto proto}))) - (doseq [method-def method-map - :let [[method-name fn] method-def]] - (let [mmethod (get proto-methods method-name)] - (.add-method mmethod target-type fn))) - (alter-var-root (:var proto) update :extending-types conj target-type)) + (let [proto-methods (:methods proto)] + (doseq [method-def method-map + :let [[method-name fn] method-def]] + (let [mmethod (get proto-methods method-name)] + (.add-method mmethod target-type fn)))) + (alter-var-root (:var proto) update :impls conj target-type)) nil) (defn ^:private sym-and-method-groups From dbbfce873db83c56145fe89c8a9563d8db233974 Mon Sep 17 00:00:00 2001 From: Christopher Rink Date: Fri, 29 May 2020 09:39:29 -0400 Subject: [PATCH 17/24] Fix definterface and defprotocol this-ns --- src/basilisp/core.lpy | 52 ++++++++++++++++++++----------- tests/basilisp/test_protocols.lpy | 5 ++- 2 files changed, 36 insertions(+), 21 deletions(-) diff --git a/src/basilisp/core.lpy b/src/basilisp/core.lpy index 9243f449f..839c613de 100644 --- a/src/basilisp/core.lpy +++ b/src/basilisp/core.lpy @@ -4493,10 +4493,11 @@ (python/tuple $))] (->> (:methods opt-map) (map (fn [[method-name args docstring]] - (let [total-arity (count args) - is-variadic? (let [[_ [amp rest-arg]] (split-with #(not= '& %) args)] - (and (= '& amp) (not (nil? rest-arg)))) - fixed-arity (cond-> total-arity is-variadic? (- 2))] + (let [includes-self? (contains? #{'self 'this} (first args)) + total-arity (cond-> (count args) includes-self? (dec)) + is-variadic? (let [[_ [amp rest-arg]] (split-with #(not= '& %) args)] + (and (= '& amp) (not (nil? rest-arg)))) + fixed-arity (cond-> total-arity is-variadic? (- 2))] {:method-name method-name :args args :fixed-arity fixed-arity @@ -4533,20 +4534,21 @@ {:arities arities :fixed-arity-for-variadic fixed-arity-for-variadic :fixed-arities fixed-arities}))) + ;; multi-arity methods need to include an outer dispatch method, + ;; which will not be defined by the user and must be defined here (conj arities {:method-name method-name :python-name (munge method-name) :args '[& args] :docstring (-> arities first :docstring)})) - ;; single arity methods should not have the special arity - ;; python name + ;; single arity methods should not have a private Python name + ;; since they do not have an outer dispatch method (map (fn [{:keys [method-name] :as arity}] (assoc arity :python-name (munge method-name))) arities)))) (reduce (fn [m {:keys [method-name python-name args docstring]}] (let [method (->> args (map #(vary-meta % assoc :no-warn-when-unused true)) - (concat ['^:no-warn-when-unused self]) (apply vector) (list 'fn* method-name) (eval) @@ -4562,7 +4564,8 @@ "Define a new Python interface (abstract base clase) with the given name and method signatures. - Method signatures are in the form (method-name [arg1 arg2 ...]). + Method signatures are in the form (method-name [arg1 arg2 ...]). `self` or + `this` arguments must be omitted from all interfaces. Interface objects cannot be directly instantiated. Instead, you must create a concrete implementation of an interface (perhaps via deftype) and supply @@ -4576,7 +4579,10 @@ methods, or static methods, as with `deftype`." [interface-name & methods] (let [name-str (name interface-name) - method-sigs (map #(list 'quote %) methods)] + method-sigs (->> methods + (map (fn [[method-name args docstring]] + [method-name (conj args 'self) docstring])) + (map #(list 'quote %)))] `(def ~interface-name (gen-interface :name ~name-str :methods [~@method-sigs])))) @@ -4591,9 +4597,8 @@ (let [docstring (nth method-def 2 nil) dotted-method-name (symbol (str "." (name method-name))) has-varargs (some #(= '& %) args) - clean-args (filter #(not= '& %) args) - - obj-sym (gensym "o")] + [obj-sym & args] args + clean-args (filter #(not= '& %) args)] [`(defmulti ~method-name ~@(when docstring [docstring]) (fn [~obj-sym ~@(map #(vary-meta % assoc :no-warn-when-unused true) args)] @@ -4616,8 +4621,21 @@ (defmacro defprotocol "Define a new protocol. - Protocols consist of an interface (a Python `ABC`) and a set of generated methods - which dispatch to objects implementing the interface." + Protocols are similar to classical programming interfaces. Rather than defining an + interface and implementing that interface on different objects, protocols generate + a set of functions which dispatch to the correct implementation on the type of their + first argument (which is similar to the Python `self` argument). + + Also like interfaces, Protocols do not include implementations for any of their member + methods. Instead, implementations can be provided using `deftype`, `defrecord`, + `reify`, or `extend` (or any of the `extend-*` macros). + + Despite their differences from interfaces, Protocols do also generate a standard + Python interface type (deriving from `abc.ABC`) which is used for efficient dispatch + for implementing types. + + Method signatures are in the form (method-name [self arg1 arg2 ...]). Callers must + provide the `self` or `this` arguments for each method." [protocol-name & methods] (let [doc (when (string? (first methods)) (first methods)) @@ -5258,11 +5276,9 @@ atomic semantics, but they may be useful as a mutable reference container in a single-threaded context." - (vreset! - [new-val] + (vreset! [this new-val] "Reset the value of a volatile non-atomically. Returns the new value.") - (vswap! - [f & args] + (vswap! [this f & args] "Swap the value of a volatile non-atomically to the return of (apply f old-val args). Returns the new value of that function call.")) diff --git a/tests/basilisp/test_protocols.lpy b/tests/basilisp/test_protocols.lpy index 7084ba461..3873a12a0 100644 --- a/tests/basilisp/test_protocols.lpy +++ b/tests/basilisp/test_protocols.lpy @@ -4,11 +4,10 @@ [basilisp.test :refer [deftest is testing]])) (defprotocol Shape - (area [])) + (area [this])) (defprotocol Polygon - (interior-angle - [] + (interior-angle [this] "Return the interior angle of the shape in degrees.")) (defrecord Circle [radius] From f75d4ea4689272e537ab68342bbf8d6753097703 Mon Sep 17 00:00:00 2001 From: Christopher Rink Date: Fri, 29 May 2020 18:11:04 -0400 Subject: [PATCH 18/24] Verify that target-types implement all methods --- src/basilisp/core.lpy | 7 +++++++ tests/basilisp/test_protocols.lpy | 6 +++++- 2 files changed, 12 insertions(+), 1 deletion(-) diff --git a/src/basilisp/core.lpy b/src/basilisp/core.lpy index 839c613de..866dbdb78 100644 --- a/src/basilisp/core.lpy +++ b/src/basilisp/core.lpy @@ -4723,6 +4723,13 @@ {:target-type target-type :proto proto}))) (let [proto-methods (:methods proto)] + (let [proto-method-names (set (keys proto-methods)) + impl-method-names (set (keys method-map))] + (when-not (= proto-method-names impl-method-names) + (throw (ex-info "target-type must implement all protocol methods" + {:missing-methods (->> proto-method-names + (remove impl-method-names) + (set))})))) (doseq [method-def method-map :let [[method-name fn] method-def]] (let [mmethod (get proto-methods method-name)] diff --git a/tests/basilisp/test_protocols.lpy b/tests/basilisp/test_protocols.lpy index 3873a12a0..563aac9ff 100644 --- a/tests/basilisp/test_protocols.lpy +++ b/tests/basilisp/test_protocols.lpy @@ -58,7 +58,11 @@ (testing "Protocols cannot extend themselves" (is (thrown? basilisp.lang.exception/ExceptionInfo - (extend Shape Shape {:area identity}))))) + (extend Shape Shape {:area identity})))) + + (testing "extended type must implement all Protocol methods" + (is (thrown? basilisp.lang.exception/ExceptionInfo + (extend python/str Shape {}))))) (deftest extenders-test (is (= (list Square) (extenders Shape))) From 2d60f47d3ca99f576740b8a044b1044ca32e0a0f Mon Sep 17 00:00:00 2001 From: Christopher Rink Date: Sat, 30 May 2020 13:15:28 -0400 Subject: [PATCH 19/24] Use singledispatch --- src/basilisp/core.lpy | 135 ++++++++++++++++++++++++------------------ 1 file changed, 78 insertions(+), 57 deletions(-) diff --git a/src/basilisp/core.lpy b/src/basilisp/core.lpy index 866dbdb78..301d7fa4b 100644 --- a/src/basilisp/core.lpy +++ b/src/basilisp/core.lpy @@ -4591,30 +4591,43 @@ ;; Protocols ;; ;;;;;;;;;;;;;;; -(defn ^:private gen-protocol-multi - "Return the `defmulti` and default `defmethod` for a protocol method." - [[method-name args :as method-def]] +(import* functools) + +(defn ^:private gen-protocol-dispatch + "Return the dispatch function for a single protocol method." + [protocol-name interface-name [method-name args :as method-def]] (let [docstring (nth method-def 2 nil) dotted-method-name (symbol (str "." (name method-name))) has-varargs (some #(= '& %) args) [obj-sym & args] args clean-args (filter #(not= '& %) args)] - [`(defmulti ~method-name - ~@(when docstring [docstring]) - (fn [~obj-sym ~@(map #(vary-meta % assoc :no-warn-when-unused true) args)] - (python/type ~obj-sym))) - `(defmethod ~method-name :default - [~obj-sym ~@args] - ~(if has-varargs - `(apply-method ~obj-sym ~method-name ~@clean-args) - `(~dotted-method-name ~obj-sym ~@clean-args)))])) + [`(def ~(vary-meta method-name + assoc + :doc docstring + :arglists (list 'quote (vec (concat [obj-sym] args)))) + (functools/singledispatch + (fn ~method-name [~obj-sym ~@(map #(vary-meta % assoc :no-warn-when-unused true) args)] + (let [obj-type# (python/type ~obj-sym)] + (throw + (ex-info (str + ~(str "No implementation of method " method-name " found for type ") + obj-type#) + {:protocol (var ~protocol-name) + :method ~method-name + :object-type obj-type#})))))) + `(.register ~method-name + ~interface-name + (fn ~method-name [~obj-sym ~@args] + ~(if has-varargs + `(apply-method ~obj-sym ~method-name ~@clean-args) + `(~dotted-method-name ~obj-sym ~@clean-args))))])) ;; For each protocol, the following keys are defined: ;; ;; - :impls - a set of types which dynamically extend the Protocol ;; (e.g. by `extend`) ;; - :interface - the Python interface type which backs the Protocol -;; - :methods - a mapping of method names (as Basilisp keywords) to the multi- +;; - :methods - a mapping of method names (as Basilisp keywords) to the dispatch ;; method backing the Protocol method ;; - :var - a reference to the Var the Protocol is stored in @@ -4645,23 +4658,25 @@ doc (vary-meta assoc :doc doc)) assoc :protocol true - :redef true)] + :redef true) + interface-sym (gensym "interface-name")] `(do (defonce ~protocol-name {}) (alter-meta! (var ~protocol-name) assoc :doc ~doc :basilisp.core/protocol true) - ~@(mapcat gen-protocol-multi methods) - (->> {:impls #{} - :interface (gen-interface :name ~(name protocol-name) - :methods [~@(map #(list 'quote %) methods)]) - :methods ~(apply hash-map - (mapcat #(let [v (first %)] - [(keyword (name v)) v]) - methods)) - :var (var ~protocol-name)} - (alter-var-root (var ~protocol-name) merge ~protocol-name)) + (let [~interface-sym (gen-interface :name ~(name protocol-name) + :methods [~@(map #(list 'quote %) methods)])] + ~@(mapcat #(gen-protocol-dispatch protocol-name interface-sym %) methods) + (->> {:impls #{} + :interface ~interface-sym + :methods ~(apply hash-map + (mapcat #(let [v (first %)] + [(keyword (name v)) v]) + methods)) + :var (var ~protocol-name)} + (alter-var-root (var ~protocol-name) merge ~protocol-name))) ~protocol-name))) (defn ^:private protocol? @@ -4676,7 +4691,8 @@ types may be extended without modifying the types directly. `target-type` should name a type which is to be extended. Virtually any type - is permitted, so long as that that type is not also a Protocol. + is permitted, so long as that that type is not also a Protocol. If `target-type` + is `nil`, it will be interpreted as `(python/type nil)`. `proto+methods` are interleaved Protocol names and maps of Protocol method implementations intended for `target-type`. The keys of each map are keywords @@ -4703,38 +4719,43 @@ OtherProto {:ham (fn [...] ...)})" [target-type & proto+methods] - (cond - (protocol? target-type) - (throw (ex-info "Protocols may not be extended with other Protocols" - {:target-type target-type})) - - (not (instance? python/type target-type)) - (throw (ex-info "extend target-type must be a type" - {:target-type target-type}))) - - (doseq [proto-pair (apply hash-map proto+methods) - :let [[proto method-map] proto-pair]] - (when-not (protocol? proto) - (throw (ex-info "extend protocol must be protocol as defined by defprotocol" - {:target-type target-type - :proto proto}))) - (when (identical? target-type proto) - (throw (ex-info "Protocol may not extend itself" - {:target-type target-type - :proto proto}))) - (let [proto-methods (:methods proto)] - (let [proto-method-names (set (keys proto-methods)) - impl-method-names (set (keys method-map))] - (when-not (= proto-method-names impl-method-names) - (throw (ex-info "target-type must implement all protocol methods" - {:missing-methods (->> proto-method-names - (remove impl-method-names) - (set))})))) - (doseq [method-def method-map - :let [[method-name fn] method-def]] - (let [mmethod (get proto-methods method-name)] - (.add-method mmethod target-type fn)))) - (alter-var-root (:var proto) update :impls conj target-type)) + (let [target-type (cond-> target-type (nil? target-type) (python/type))] + (cond + (protocol? target-type) + (throw (ex-info "Protocols may not be extended with other Protocols" + {:target-type target-type})) + + (not (instance? python/type target-type)) + (throw (ex-info "extend target-type must be a type" + {:target-type target-type}))) + + (doseq [proto-pair (apply hash-map proto+methods) + :let [[proto method-map] proto-pair]] + (when-not (protocol? proto) + (throw (ex-info "extend protocol must be protocol as defined by defprotocol" + {:target-type target-type + :proto proto}))) + (when (identical? target-type proto) + (throw (ex-info "Protocol may not extend itself" + {:target-type target-type + :proto proto}))) + + (->> (fn [old-root] + (let [proto-methods (:methods proto)] + (let [proto-method-names (set (keys proto-methods)) + impl-method-names (set (keys method-map))] + (when-not (= proto-method-names impl-method-names) + (throw (ex-info "target-type must implement all protocol methods" + {:missing-methods (->> proto-method-names + (remove impl-method-names) + (set))})))) + (doseq [method-def method-map + :let [[method-name fn] method-def]] + (let [dispatch-method (get proto-methods method-name)] + (.register dispatch-method target-type fn)))) + (update old-root :impls conj target-type)) + (alter-var-root (:var proto))))) + nil) (defn ^:private sym-and-method-groups From 9d6a82d1b4373fb5291296176f8d5cd13e9219a5 Mon Sep 17 00:00:00 2001 From: Christopher Rink Date: Sat, 30 May 2020 14:37:30 -0400 Subject: [PATCH 20/24] Convert basilisp.walk to use a protocol --- src/basilisp/lang/list.py | 2 +- src/basilisp/lang/runtime.py | 1 + src/basilisp/walk.lpy | 69 +++++++++++++++++++------------ tests/basilisp/test_protocols.lpy | 12 ++++-- 4 files changed, 52 insertions(+), 32 deletions(-) diff --git a/src/basilisp/lang/list.py b/src/basilisp/lang/list.py index 8cb8f5b42..cb0bb725c 100644 --- a/src/basilisp/lang/list.py +++ b/src/basilisp/lang/list.py @@ -10,7 +10,7 @@ T = TypeVar("T") -class List(IWithMeta, ISeq[T], IPersistentList[T]): +class List(IWithMeta, IPersistentList[T], ISeq[T]): """Basilisp List. Delegates internally to a pyrsistent.PList object. Do not instantiate directly. Instead use the l() and list() factory diff --git a/src/basilisp/lang/runtime.py b/src/basilisp/lang/runtime.py index 959ec03cb..870a64296 100644 --- a/src/basilisp/lang/runtime.py +++ b/src/basilisp/lang/runtime.py @@ -418,6 +418,7 @@ class Namespace(ReferenceBase): [ "attr", "builtins", + "functools", "io", "importlib", "operator", diff --git a/src/basilisp/walk.lpy b/src/basilisp/walk.lpy index b8442e3d9..90b88a8f6 100644 --- a/src/basilisp/walk.lpy +++ b/src/basilisp/walk.lpy @@ -1,5 +1,46 @@ (ns basilisp.walk) +(defprotocol IWalkable + (walk* [this inner outer] + "Walk the data structure applying `inner` to each element of the data structure, + if any, and then applying `outer` to the result.")) + +(extend-protocol IWalkable + basilisp.lang.interfaces/IPersistentList + (walk* [this inner outer] + (outer (apply list (map inner this)))) + + basilisp.lang.interfaces/IMapEntry + (walk* [this inner outer] + (outer (map-entry (inner (key this)) (inner (val this))))) + + basilisp.lang.interfaces/ISeq + (walk* [this inner outer] + (outer (doall (map inner this)))) + + basilisp.lang.interfaces/IPersistentVector + (walk* [this inner outer] + (outer (apply vector (map inner this)))) + + basilisp.lang.interfaces/IPersistentMap + (walk* [this inner outer] + (outer (apply hash-map (mapcat inner this)))) + + basilisp.lang.interfaces/IPersistentSet + (walk* [this inner outer] + (outer (apply hash-set (map inner this)))) + + basilisp.lang.interfaces/IRecord + (walk* [this inner outer] + (outer (reduce (fn [rec field] + (conj rec (inner field))) + this + this))) + + python/object + (walk* [this ^:no-warn-when-unused inner outer] + (outer this))) + (defn walk "Walk an arbitrary, possibly nested data structure, applying inner to each element of form and then applying outer to the resulting form. @@ -8,33 +49,7 @@ Lazy sequences will be completely consumed (and thus may not be infinite)." [inner outer form] - (cond - (list? form) - (outer (apply list (map inner form))) - - (map-entry? form) - (outer (map-entry (inner (key form)) (inner (val form)))) - - (seq? form) - (outer (doall (map inner form))) - - (vector? form) - (outer (apply vector (map inner form))) - - (map? form) - (outer (apply hash-map (mapcat inner form))) - - (set? form) - (outer (apply hash-set (map inner form))) - - (record? form) - (outer (reduce (fn [rec field] - (conj rec (inner field))) - form - form)) - - :else - (outer form))) + (walk* form inner outer)) (defn postwalk "Walk form using depth-first, post-order traversal, applying f to each form diff --git a/tests/basilisp/test_protocols.lpy b/tests/basilisp/test_protocols.lpy index 563aac9ff..1f6ce2958 100644 --- a/tests/basilisp/test_protocols.lpy +++ b/tests/basilisp/test_protocols.lpy @@ -33,14 +33,18 @@ (is (= 4 (area (->Rectangle 2 2)))) (is (= 9 (area (->Square 3)))) - (is (thrown? python/AttributeError (area :a))) - (is (thrown? python/AttributeError (area [4 5])))) + (is (thrown? basilisp.lang.exception/ExceptionInfo + (area :a))) + (is (thrown? basilisp.lang.exception/ExceptionInfo + (area [4 5])))) (deftest Polygon-interior-angle-test (is (= 360 (interior-angle (->Rectangle 2 2)))) - (is (thrown? python/AttributeError (interior-angle (->Circle 1)))) - (is (thrown? python/AttributeError (interior-angle (->Square 3))))) + (is (thrown? basilisp.lang.exception/ExceptionInfo + (interior-angle (->Circle 1)))) + (is (thrown? basilisp.lang.exception/ExceptionInfo + (interior-angle (->Square 3))))) (deftest protocol?-test (is (protocol? Shape)) From d971a9c7cc34da14260155e6c8b7caa378cb745f Mon Sep 17 00:00:00 2001 From: Christopher Rink Date: Sat, 30 May 2020 15:14:36 -0400 Subject: [PATCH 21/24] Switch MRO --- src/basilisp/lang/list.py | 2 +- src/basilisp/lang/map.py | 2 +- src/basilisp/lang/set.py | 2 +- src/basilisp/lang/vector.py | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/basilisp/lang/list.py b/src/basilisp/lang/list.py index cb0bb725c..e187f2cbe 100644 --- a/src/basilisp/lang/list.py +++ b/src/basilisp/lang/list.py @@ -10,7 +10,7 @@ T = TypeVar("T") -class List(IWithMeta, IPersistentList[T], ISeq[T]): +class List(IPersistentList[T], ISeq[T], IWithMeta): """Basilisp List. Delegates internally to a pyrsistent.PList object. Do not instantiate directly. Instead use the l() and list() factory diff --git a/src/basilisp/lang/map.py b/src/basilisp/lang/map.py index decff20da..19e3467ad 100644 --- a/src/basilisp/lang/map.py +++ b/src/basilisp/lang/map.py @@ -24,7 +24,7 @@ _ENTRY_SENTINEL = object() -class Map(ILispObject, IWithMeta, IPersistentMap[K, V]): +class Map(IPersistentMap[K, V], ILispObject, IWithMeta): """Basilisp Map. Delegates internally to a pyrsistent.PMap object. Do not instantiate directly. Instead use the m() and map() factory methods below.""" diff --git a/src/basilisp/lang/set.py b/src/basilisp/lang/set.py index 17b4f49a8..9c3c5bf04 100644 --- a/src/basilisp/lang/set.py +++ b/src/basilisp/lang/set.py @@ -15,7 +15,7 @@ T = TypeVar("T") -class Set(IWithMeta, ILispObject, IPersistentSet[T]): +class Set(IPersistentSet[T], ILispObject, IWithMeta): """Basilisp Set. Delegates internally to a pyrsistent.PSet object. Do not instantiate directly. Instead use the s() and set() factory diff --git a/src/basilisp/lang/vector.py b/src/basilisp/lang/vector.py index 324afe370..0659a2dcd 100644 --- a/src/basilisp/lang/vector.py +++ b/src/basilisp/lang/vector.py @@ -16,7 +16,7 @@ T = TypeVar("T") -class Vector(ILispObject, IWithMeta, IPersistentVector[T]): +class Vector(IPersistentVector[T], ILispObject, IWithMeta): """Basilisp Vector. Delegates internally to a pyrsistent.PVector object. Do not instantiate directly. Instead use the v() and vec() factory methods below.""" From 83022dbd01364296c3980b03fe7530e71671f077 Mon Sep 17 00:00:00 2001 From: Christopher Rink Date: Sat, 30 May 2020 17:08:48 -0400 Subject: [PATCH 22/24] Slightly more tests --- src/basilisp/core.lpy | 5 +- tests/basilisp/test_protocols.lpy | 88 +++++++++++++++++++++++++++---- 2 files changed, 83 insertions(+), 10 deletions(-) diff --git a/src/basilisp/core.lpy b/src/basilisp/core.lpy index 301d7fa4b..203257d83 100644 --- a/src/basilisp/core.lpy +++ b/src/basilisp/core.lpy @@ -4692,6 +4692,9 @@ `target-type` should name a type which is to be extended. Virtually any type is permitted, so long as that that type is not also a Protocol. If `target-type` + is an interface, objects of types implementing that interface will be extended + by the given implementation unless a more concrete implementation is available + (by the Python method resolution order of the object's type). If `target-type` is `nil`, it will be interpreted as `(python/type nil)`. `proto+methods` are interleaved Protocol names and maps of Protocol method @@ -4776,7 +4779,7 @@ (conj methods (first specs)) groups) - (symbol? (first specs)) + (or (symbol? (first specs)) (nil? (first specs))) (recur (first specs) (rest specs) [] diff --git a/tests/basilisp/test_protocols.lpy b/tests/basilisp/test_protocols.lpy index 1f6ce2958..fa527ee63 100644 --- a/tests/basilisp/test_protocols.lpy +++ b/tests/basilisp/test_protocols.lpy @@ -1,7 +1,7 @@ (ns tests.basilisp.test-protocols (:import math) (:require - [basilisp.test :refer [deftest is testing]])) + [basilisp.test :refer [deftest is are testing]])) (defprotocol Shape (area [this])) @@ -28,6 +28,25 @@ (let [side (get this :x)] (* side side)))) +(defprotocol Describable + (self-name [this]) + (describe-me [this])) + +(extend-protocol Describable + python/int + (self-name [this] "int") + (describe-me [this] + (cond + (pos? this) "I am a positive integer." + (zero? this) "I am zero." + (neg? this) "I am a negative integer.")) + python/str + (self-name [this] "str") + (describe-me [this] (str "I am a string of length " (count this) ".")) + nil + (self-name [this] "nil") + (describe-me [this] "I am the value nil.")) + (deftest Shape-area-method-test (is (= math/pi (area (->Circle 1)))) (is (= 4 (area (->Rectangle 2 2)))) @@ -46,6 +65,45 @@ (is (thrown? basilisp.lang.exception/ExceptionInfo (interior-angle (->Square 3))))) +(deftest Describable-self-name-method-test + (are [x y] (= x (self-name y)) + "str" "some-value" + "str" "" + "nil" nil + "int" 1 + "int" true + "int" 0 + "int" false + "int" -1) + + (are [x] (thrown? basilisp.lang.exception/ExceptionInfo (self-name x)) + -1.5 + :kw + 'sym + [] + #{} + {} + '())) + +(deftest Describable-describe-me-method-test + (are [x y] (= x (describe-me y)) + "I am a string of length 10." "some-value" + "I am the value nil." nil + "I am a positive integer." 1 + "I am a positive integer." true + "I am zero." 0 + nil false ;; (zero? false) => false + "I am a negative integer." -1) + + (are [x] (thrown? basilisp.lang.exception/ExceptionInfo (describe-me x)) + -1.5 + :kw + 'sym + [] + #{} + {} + '())) + (deftest protocol?-test (is (protocol? Shape)) (is (not (protocol? Circle))) @@ -53,20 +111,32 @@ (deftest extend-test (testing "Protocols cannot extend other Protocols" - (is (thrown? basilisp.lang.exception/ExceptionInfo - (extend Polygon Shape {:area identity})))) + (are [x] (thrown? basilisp.lang.exception/ExceptionInfo x) + (extend Polygon Shape {:area identity}) + (extend-protocol Polygon + Shape + (area [this] this)))) (testing "Protocol must be defined as by defprotocol" - (is (thrown? basilisp.lang.exception/ExceptionInfo - (extend Square python/str {:area identity})))) + (are [x] (thrown? basilisp.lang.exception/ExceptionInfo x) + (extend Square python/str {:area identity}) + (extend-type Square + python/str + (area [this] this)))) (testing "Protocols cannot extend themselves" - (is (thrown? basilisp.lang.exception/ExceptionInfo - (extend Shape Shape {:area identity})))) + (are [x] (thrown? basilisp.lang.exception/ExceptionInfo x) + (extend Shape Shape {:area identity}) + (extend-protocol Shape + Shape + (area [this] this))) (testing "extended type must implement all Protocol methods" - (is (thrown? basilisp.lang.exception/ExceptionInfo - (extend python/str Shape {}))))) + (are [x] (thrown? basilisp.lang.exception/ExceptionInfo x) + (extend python/str Shape {}) + (extend-type python/float + Describable + (self-name [this] "float")))))) (deftest extenders-test (is (= (list Square) (extenders Shape))) From 8a6309b56dd9a8909ab7fc106ba18bd29385abd7 Mon Sep 17 00:00:00 2001 From: Christopher Rink Date: Sat, 30 May 2020 17:53:33 -0400 Subject: [PATCH 23/24] Support multi-arity fns --- src/basilisp/core.lpy | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/src/basilisp/core.lpy b/src/basilisp/core.lpy index 203257d83..5531599b0 100644 --- a/src/basilisp/core.lpy +++ b/src/basilisp/core.lpy @@ -4789,11 +4789,12 @@ "Convert a vector of method definitions (as expected by `extend-protocol` and `extend-type`) into a map of method definitions which can be passed to `extend`. " [methods] - (reduce (fn [m fn-body] - (let [method-name (name (first fn-body))] - (assoc m (keyword method-name) (apply list `fn fn-body)))) - {} - methods)) + (->> (group-by first methods) + (reduce (fn [m [method-name arities]] + (->> (map rest arities) + (apply list `fn method-name) + (assoc m (keyword (name method-name))))) + {}))) (defmacro extend-protocol "Extend a Protocol with implementations for multiple types. From eef0d3418e71399e0a084eedf143a31065c9dc5f Mon Sep 17 00:00:00 2001 From: Christopher Rink Date: Sun, 31 May 2020 14:46:32 -0400 Subject: [PATCH 24/24] Support multiple-arity protocols --- src/basilisp/core.lpy | 115 +++++++++++++++++------- src/basilisp/lang/compiler/generator.py | 50 ++++++++++- src/basilisp/lang/runtime.py | 17 ++-- tests/basilisp/core_test.py | 2 +- tests/basilisp/test_protocols.lpy | 37 +++++++- 5 files changed, 178 insertions(+), 43 deletions(-) diff --git a/src/basilisp/core.lpy b/src/basilisp/core.lpy index 5531599b0..c9955329d 100644 --- a/src/basilisp/core.lpy +++ b/src/basilisp/core.lpy @@ -4187,7 +4187,8 @@ [arg] (throw (ex-info "Invalid destructuring argument type" - {:type (python/type arg)}))) + {:type (python/type arg) + :arg arg}))) (defmulti ^:private destructure-binding (fn [ddef] @@ -4595,32 +4596,37 @@ (defn ^:private gen-protocol-dispatch "Return the dispatch function for a single protocol method." - [protocol-name interface-name [method-name args :as method-def]] - (let [docstring (nth method-def 2 nil) - dotted-method-name (symbol (str "." (name method-name))) - has-varargs (some #(= '& %) args) - [obj-sym & args] args - clean-args (filter #(not= '& %) args)] + [protocol-name interface-name [method-name & args+docstring :as method-def]] + (let [[arglists [docstring]] (split-with (complement string?) args+docstring)] [`(def ~(vary-meta method-name assoc :doc docstring - :arglists (list 'quote (vec (concat [obj-sym] args)))) + :arglists (list 'quote arglists)) (functools/singledispatch - (fn ~method-name [~obj-sym ~@(map #(vary-meta % assoc :no-warn-when-unused true) args)] - (let [obj-type# (python/type ~obj-sym)] - (throw - (ex-info (str - ~(str "No implementation of method " method-name " found for type ") - obj-type#) - {:protocol (var ~protocol-name) - :method ~method-name - :object-type obj-type#})))))) - `(.register ~method-name - ~interface-name - (fn ~method-name [~obj-sym ~@args] - ~(if has-varargs - `(apply-method ~obj-sym ~method-name ~@clean-args) - `(~dotted-method-name ~obj-sym ~@clean-args))))])) + (fn ~method-name + ~@(map (fn [[obj-sym & args]] + (list `[~obj-sym ~@(map #(vary-meta % assoc :no-warn-when-unused true) args)] + `(let [obj-type# (python/type ~obj-sym)] + (throw + (ex-info (str + ~(str "No implementation of method " method-name " found for type ") + obj-type#) + {:protocol (var ~protocol-name) + :method ~method-name + :object-type obj-type#}))))) + arglists)))) + (let [dotted-method-name (symbol (str "." (name method-name)))] + `(.register ~method-name + ~interface-name + (fn ~method-name + ~@(map (fn [[obj-sym & args]] + (let [has-varargs (some #(= '& %) args) + clean-args (filter #(not= '& %) args)] + (list `[~obj-sym ~@args] + (if has-varargs + `(apply-method ~obj-sym ~method-name ~@clean-args) + `(~dotted-method-name ~obj-sym ~@clean-args))))) + arglists))))])) ;; For each protocol, the following keys are defined: ;; @@ -4647,8 +4653,11 @@ Python interface type (deriving from `abc.ABC`) which is used for efficient dispatch for implementing types. - Method signatures are in the form (method-name [self arg1 arg2 ...]). Callers must - provide the `self` or `this` arguments for each method." + Method signatures are in the form: + + (method-name [self arg1] [self arg1 arg2] \"This method foos the bars.\") + + Callers must provide the `self` or `this` arguments for each method." [protocol-name & methods] (let [doc (when (string? (first methods)) (first methods)) @@ -4667,7 +4676,18 @@ :doc ~doc :basilisp.core/protocol true) (let [~interface-sym (gen-interface :name ~(name protocol-name) - :methods [~@(map #(list 'quote %) methods)])] + :methods [~@(mapcat + (fn [[method-name & args+docstring]] + (let [[arglists [docstring]] (split-with + (complement string?) + args+docstring)] + (map (fn [args] + (list 'quote + `(~method-name + ~args + ~@(when docstring [docstring])))) + arglists))) + methods)])] ~@(mapcat #(gen-protocol-dispatch protocol-name interface-sym %) methods) (->> {:impls #{} :interface ~interface-sym @@ -4752,6 +4772,25 @@ {:missing-methods (->> proto-method-names (remove impl-method-names) (set))})))) + (let [proto-method-arity-map (reduce-kv (fn [m k v] + (assoc m k (.-arities v))) + {} + proto-methods) + impl-method-arity-map (reduce-kv (fn [m k v] + (assoc m k (.-arities v))) + {} + method-map)] + (doseq [proto-method proto-method-arity-map + :let [[proto-method-name proto-method-arities] proto-method]] + (let [impl-method-arities (get impl-method-arity-map proto-method-name)] + (when (not= impl-method-arities proto-method-arities) + (throw (ex-info "target-type must implement all protocol method arities" + {:proto-method proto-method-name + :proto-method-arities proto-method-arity-map + :impl-method-arities impl-method-arity-map + :missing-arities (->> proto-method-arities + (remove impl-method-arities) + (set))})))))) (doseq [method-def method-map :let [[method-name fn] method-def]] (let [dispatch-method (get proto-methods method-name)] @@ -4808,10 +4847,14 @@ (extend-protocol SomeProto FirstType - (spam [this] ...) + (spam + ([this] ...) + ([this arg] ...)) (eggs [this arg1 arg2] ...) OtherType - (spam [this] ...) + (spam + ([this] ...) + ([this arg] ...)) (eggs [this arg1 arg2] ...)) Would be turned into the following `extend` calls: @@ -4819,11 +4862,15 @@ (do (extend FirstType SomeProto - {:spam (fn spam [this] ...) + {:spam (fn spam + ([this] ...) + ([this arg] ...)) :eggs (fn [this arg1 arg2] ...)}) (extend OtherType SomeProto - {:spam (fn spam [this] ...) + {:spam (fn spam + ([this] ...) + ([this arg] ...)) :eggs (fn [this arg1 arg2] ...)}))" [proto & specs] `(do ~@(map (fn [[target-type methods]] @@ -4844,7 +4891,9 @@ (extend-type SomeType FirstProto - (spam [this] ...) + (spam + ([this] ...) + ([this arg] ...)) (eggs [this arg1 arg2] ...) SecondProto (ham [this & args] ...)) @@ -4853,7 +4902,9 @@ (extend SomeType FirstProto - {:spam (fn spam [this] ...) + {:spam (fn spam + ([this] ...) + ([this arg] ...)) :eggs (fn eggs [this arg1 arg2] ...)} SecondProto {:ham (fn ham [this & args] ...)})" diff --git a/src/basilisp/lang/compiler/generator.py b/src/basilisp/lang/compiler/generator.py index 3c593f0ea..b8d4a9d0f 100644 --- a/src/basilisp/lang/compiler/generator.py +++ b/src/basilisp/lang/compiler/generator.py @@ -1504,6 +1504,35 @@ def __fn_args_to_py_ast( return fn_args, varg, fn_body_ast +def __fn_decorator(arities: Iterable[int], has_rest_arg: bool = False,) -> ast.Call: + return ast.Call( + func=_BASILISP_FN_FN_NAME, + args=[], + keywords=[ + ast.keyword( + arg="arities", + value=ast.Tuple( + elts=list( + chain( + map(ast.Constant, arities), + [ + ast.Call( + func=_NEW_KW_FN_NAME, + args=[ast.Constant("rest")], + keywords=[], + ) + ] + if has_rest_arg + else [], + ) + ), + ctx=ast.Load(), + ), + ) + ], + ) + + def __fn_meta( ctx: GeneratorContext, meta_node: Optional[MetaNode] = None ) -> Tuple[Iterable[ast.AST], Iterable[ast.AST]]: @@ -1584,7 +1613,14 @@ def __single_arity_fn_to_py_ast( chain( __kwargs_support_decorator(node), meta_decorators, - [_BASILISP_FN_FN_NAME], + [ + __fn_decorator( + (len(fn_args),) + if not method.is_variadic + else (), + has_rest_arg=method.is_variadic, + ) + ], [_TRAMPOLINE_FN_NAME] if ctx.recur_point.has_recur else [], @@ -1749,7 +1785,17 @@ def fn(*args): kw_defaults=[], ), body=body, - decorator_list=list(chain(meta_decorators, [_BASILISP_FN_FN_NAME])), + decorator_list=list( + chain( + meta_decorators, + [ + __fn_decorator( + arity_map.keys(), + has_rest_arg=default_name is not None, + ) + ], + ) + ), returns=None, ) ], diff --git a/src/basilisp/lang/runtime.py b/src/basilisp/lang/runtime.py index 870a64296..86fdbf447 100644 --- a/src/basilisp/lang/runtime.py +++ b/src/basilisp/lang/runtime.py @@ -1454,14 +1454,19 @@ def wrapped_f(*args, **kwargs): return wrapped_f -def _basilisp_fn(f): +def _basilisp_fn(arities: Tuple[Union[int, kw.Keyword]]): """Create a Basilisp function, setting meta and supplying a with_meta method implementation.""" - assert not hasattr(f, "meta") - f._basilisp_fn = True - f.meta = None - f.with_meta = partial(_fn_with_meta, f) - return f + + def wrap_fn(f): + assert not hasattr(f, "meta") + f._basilisp_fn = True + f.arities = lset.set(arities) + f.meta = None + f.with_meta = partial(_fn_with_meta, f) + return f + + return wrap_fn def _basilisp_type( diff --git a/tests/basilisp/core_test.py b/tests/basilisp/core_test.py index 2d4b8d411..406059ab0 100644 --- a/tests/basilisp/core_test.py +++ b/tests/basilisp/core_test.py @@ -525,7 +525,7 @@ def test_truth_values_are_not_false(self, truthy_value): class TestIsFn: @pytest.fixture(scope="class") def basilisp_fn(self): - @runtime._basilisp_fn + @runtime._basilisp_fn(arities=(1,)) def repeat(v): while True: yield v diff --git a/tests/basilisp/test_protocols.lpy b/tests/basilisp/test_protocols.lpy index fa527ee63..490e3c548 100644 --- a/tests/basilisp/test_protocols.lpy +++ b/tests/basilisp/test_protocols.lpy @@ -1,6 +1,7 @@ (ns tests.basilisp.test-protocols (:import math) (:require + [basilisp.string :as str] [basilisp.test :refer [deftest is are testing]])) (defprotocol Shape @@ -29,12 +30,15 @@ (* side side)))) (defprotocol Describable - (self-name [this]) + (self-name [this] [this upper-case?]) (describe-me [this])) (extend-protocol Describable python/int (self-name [this] "int") + (self-name [this upper-case?] + (cond-> (self-name this) + upper-case? (str/upper-case))) (describe-me [this] (cond (pos? this) "I am a positive integer." @@ -42,9 +46,15 @@ (neg? this) "I am a negative integer.")) python/str (self-name [this] "str") + (self-name [this upper-case?] + (cond-> (self-name this) + upper-case? (str/upper-case))) (describe-me [this] (str "I am a string of length " (count this) ".")) nil (self-name [this] "nil") + (self-name [this upper-case?] + (cond-> (self-name this) + upper-case? (str/upper-case))) (describe-me [this] "I am the value nil.")) (deftest Shape-area-method-test @@ -76,7 +86,26 @@ "int" false "int" -1) + (are [x y] (= x (self-name y true)) + "STR" "some-value" + "STR" "" + "NIL" nil + "INT" 1 + "INT" true + "INT" 0 + "INT" false + "INT" -1) + (are [x] (thrown? basilisp.lang.exception/ExceptionInfo (self-name x)) + -1.5 + :kw + 'sym + [] + #{} + {} + '()) + + (are [x] (thrown? basilisp.lang.exception/ExceptionInfo (self-name x true)) -1.5 :kw 'sym @@ -136,7 +165,11 @@ (extend python/str Shape {}) (extend-type python/float Describable - (self-name [this] "float")))))) + (self-name [this] "float")) + (extend-type python/float + Describable + (self-name [this] "float") + (describe-me [this] "I am a float.")))))) (deftest extenders-test (is (= (list Square) (extenders Shape)))