From eab95f0e1bedb01f0b62dc68f50fe1fd0555564a Mon Sep 17 00:00:00 2001 From: Zach Smith Date: Sun, 18 Jul 2021 18:00:19 -0400 Subject: [PATCH] Minor updates --- fugue.janet | 222 ++++++++++++++++++++++++++--------------------- test/fugue.janet | 41 +++++++-- 2 files changed, 156 insertions(+), 107 deletions(-) diff --git a/fugue.janet b/fugue.janet index ab4df11..24cde1a 100644 --- a/fugue.janet +++ b/fugue.janet @@ -200,7 +200,9 @@ output of `type`. ``` [obj] - (if (table? obj) (table/getproto obj) (type obj))) + (if (table? obj) + (or (table/getproto obj) (type obj)) + (type obj))) (defn- pred-name [name] (symbol name "?")) @@ -286,60 +288,59 @@ ## Usage - `name` should be any symbol. The resulting prototype will be - named after it. + `name` should be any symbol. The resulting prototype will be named after it. - `parent-name` is required; it can be an existing prototype, *or* - some null-ish value. If null-ish (`nil` or `()` should make the most - sense...) the parent of the prototype will be set to `fugue/Root`. + `parent-name` is required; it can be an existing prototype, *or* some + null-ish value. If null-ish (`nil` or `()` should make the most sense...) the + parent of the prototype will be set to `fugue/Root`. `fields` should be 0 or more pairs of the following format: ` ` Where `field-name` is a field to define on the prototype and - `field-attributes` is a struct describing the field. The following - field attributes are currently recognized: + `field-attributes` is a struct describing the field. The following field + attributes are currently recognized: + + - `:default`: provide a default value for all new instances of this prototype + + - `:init?`: if truthy, then this field will be a required parameter to the + prototype's constructor - - `:default`: provide a default value for all new instances of this - prototype - - `:init?`: if truthy, then this field will be a required parameter - to the prototype 's constructor - `:allocation`: if `:prototype`, then `fugue/allocate` will always act on the prototype when putting this field. + - `:allocate-value`: this field will have this attribute set at the - prototype, so that any children without their own values will - inherit it. - - `:getter`: specify a name for the defined function to access this - field (by default, has the same name as the field). Specify `false` - to prevent a getter from being defined. - - `defproto` will define a getter function for each of the defined - fields, unless `:getter` is false. - - `defproto` will also create a `:new` method in the created - prototype. This will take as positional arguments all of the fields - specified as `init?`, and then accept in `&keys` format any other - attributes to set on this object. - - The special method `:_init` will be called as the last step in the - `:new` constructor. It can be defined for a prototype (see - `defmethod`) to take a new instance and to make any arbitrary - mutations on the instance or prototype as part of object - instantiation. By default it simply returns the instance. - - The value provided to a field's `:default` entry will be inserted - directly to the instance. Thus, mutable/referenced terms like tables - and arrays will be shared amongst all instances. In cases where you - want to insert a new term for each new instance, use the `_init` - method to put a value at that field. - - If `fields` is of an odd length, the last element will be treated as - a prototype attributes struct. There is currently one valid prototype attribute: - - - `:constructor` : Set the name of the defined function that - calls `:new`. If false, no additional constructor will be - defined. By default, will be set to `new-`. + prototype, so that any children without their own values will inherit it. + + - `:getter`: specify a name for the defined function to access this field (by + default, has the same name as the field). Specify `false` to prevent a getter + from being defined. + + `defproto` will define a getter function for each of the defined fields, + unless `:getter` is false. + + `defproto` will also create a `:new` method in the created prototype. This + will take as positional arguments all of the fields specified as `init?`, and + then accept in `&keys` format any other attributes to set on this object. + + The special method `:_init` will be called as the last step in the `:new` + constructor. It can be defined for a prototype (see `defmethod`) to take a + new instance and to make any arbitrary mutations on the instance or prototype + as part of object instantiation. By default it simply returns the instance. + + The value provided to a field's `:default` entry will be inserted directly to + the instance. Thus, mutable/referenced terms like tables and arrays will be + shared amongst all instances. In cases where you want to insert a new term + for each new instance, use the `_init` method to put a value at that field. + + If `fields` is of an odd length, the last element will be treated as a + prototype attributes struct. There is currently one valid prototype + attribute: + + - `:constructor` : Set the name of the defined function that calls `:new`. If + false, no additional constructor will be defined. By default, will be set to + `new-`. --- @@ -377,7 +378,7 @@ (defn prototype? ``` - Is `obj` the result of a `defproto ` call? + Is `obj` the result of a `defproto ` call? ``` [obj] (and (Root*? obj) @@ -385,10 +386,10 @@ (defn allocate ``` - Allocation-aware put. If `obj` has inherited an allocation to a - specific prototype for this key, then `fugue/allocate` will put `value` - at `key` in the appropriate prototype, and it will be inherited by - all descendents of that prototype. + Allocation-aware put. If `obj` has inherited an allocation to a specific + prototype for this key, then `fugue/allocate` will put `value` at `key` in + the appropriate prototype, and it will be inherited by all descendents of + that prototype. ``` [obj key value] (var source-of-defaults obj) @@ -425,10 +426,9 @@ (defmacro defgeneric ``` - Define a generic function. When this function is called, if the - first argument has a method corresponding to the name of the - function, call that object 's method with the arguments. Otherwise, - evaluate `body`. + Define a generic function. When this function is called, if the first + argument has a method corresponding to the name of the function, call that + object 's method with the arguments. Otherwise, evaluate `body`. ``` [name & rest] (let [[docstring args body] (if (string? (first rest)) @@ -451,8 +451,8 @@ (defmacro defmethod ``` - Simple single-dispatch method definition. Roughly equivalent to - `put` ing a function directly into a prototype. + Simple single-dispatch method definition. Roughly equivalent to `put` ing a + function directly into a prototype. Defines a few symbols for reference in the body of the method. @@ -497,10 +497,10 @@ (defn f [sym] (cond (or (= '_ sym) (= :_ sym)) nil - (or (tuple? sym) (struct? sym)) (compile-matcher sym) + (not (or (symbol? sym) (keyword? sym))) (compile-matcher sym) (let [evaled (eval sym)] (if (not (or (table? evaled) (keyword? evaled))) - (errorf `Multimethod type error. Expected keyword or prototype, got: + (errorf `Multimethod type error. Expected keyword, prototype, or match specification; got: %q of type %q` sym (type sym)) @@ -562,6 +562,7 @@ (var kk nil) (var vk nil) (var res true) + (while true (set kk (next args kk)) (if (= nil kk) (break)) @@ -569,22 +570,26 @@ (set vk (next arg-types vk)) (if (= nil vk) (break)) - (unless (or (= (arg-types vk) nil) - (and (function? (arg-types vk)) - ((arg-types vk) (args kk))) - (= (get-type-or-proto (args kk)) (arg-types vk))) - (set res false) - (break))) + (let [arg (args kk) + arg-type (arg-types vk)] + (unless (or (nil? arg-type) + (and (function? arg-type) (arg-type arg)) + (= (get-type-or-proto arg) arg-type)) + (set res false) + (break)))) res))) (defn- make-case [multi-types args body] (let [destructurable @[]] - (each [type arg] (map tuple multi-types args) + (each [type-spec arg] (map tuple multi-types args) (cond - (struct? type) (array/concat destructurable @[type arg]) - (tuple? type) (array/concat destructurable @[(first type) arg]))) + (or (keyword? type-spec) (symbol? type-spec)) :ok + (tuple? type-spec) (array/concat destructurable + @[(first type-spec) arg]) + (array/concat destructurable @[type-spec arg]))) + (eval ~(fn multimethod-case ,args (let ,destructurable @@ -624,8 +629,7 @@ (defmacro defmulti ```` - Define a multimethod based on all the arguments passed to the - function. + Define a multimethod based on all the arguments passed to the function. Example usage : @@ -643,17 +647,36 @@ "s!" ``` - `defmulti` takes a sequence of type-or-prototypes, and builds a - function which will check its arguments against those types (as well - as all other ones specified in other `defmulti` calls to the same - function name), and execute the function body for the matching type - signature. + `defmulti` takes a sequence of *multimethod specifications*, and builds a + function which will check its arguments against those types (as well as all + other ones specified in other `defmulti` calls to the same function name), + and execute the function body for the matching type signature. + + A multimethod specification can be any of the following data types: + + - a **keyword** representing the name of a simple or abstract type; for + instance, `:number` or `:string`. This will match against values of this + type. + + - A **symbol** referring to an existing table. This will match against tables + which have this table as a prototype. - In addition to type names or prototypes, you can use the symbol `_` - or keyword `:_` as a wildcard that means "match any type". For - instance, + - The **fallback symbols** `:_` and `_`. These will match against anything. - ``` + - A **match specification**, ie, a pattern understood by the `match` macro, + as long as it isn't one of the above values. This will match against any + value that would be matched in an execution of `match`. This includes tuples + with arbitrary predicates. + + Multimethod specs match in order of *most specific* to *least specific*; that + is: + + 1. Match specifications + 2. Prototypes + 3. Simple types + 4. Fallback + + ``` repl:2:> (defmulti cat [:string :_] [s1 s2] (string s1 s2)) repl:3:> (cat "hello " "world!") "hello world!" @@ -665,19 +688,18 @@ in _thunk [repl] (tailcall) on line 5, column 1 ``` - Defining a multimethod with the signature `[:string :_]` will match - on any two arguments if the first one is a string. + Defining a multimethod with the signature `[:string :_]` will match on any + two arguments if the first one is a string. - A multimethod without wilcards will be preferred to one with one in - the same position. For instance, if we define an additional - multimethod: + A multimethod without wilcards will be preferred to one with one in the same + position. For instance, if we define an additional multimethod: ``` repl:8:> (defmulti cat [:string :number] [s n] (string s " #" n)) ``` - Then that more specific method will be preferred and the wildcard - will be a fallback if the specific one doesn't match: + Then that more specific method will be preferred and the wildcard will be a + fallback if the specific one doesn't match: ``` repl:10:> (cat "hello " @"world") @@ -737,8 +759,8 @@ See that function's documentation for full usage reference. - Whenever a case is added to `multi`, that case is available - wherever the multimethod is imported. + Whenever a case is added to `multi`, that case is available wherever the + multimethod is imported. ``` [multi multi-types args & body] (let [ref (and (dyn multi) (in (dyn multi) :ref))] @@ -786,16 +808,15 @@ Introduces two useful forms for referring to `obj`. - It introduces a *reference symbol* - `@` by default - (see `with-slots-as `to specify the symbol). + It introduces a *reference symbol* - `@` by default (see `with-slots-as `to + specify the symbol). The pattern `(@ )`, where `` is a symbol, is - transformed into `(obj (keyword ))`, if and only if - `` is defined for `proto`, so that `(@ name)` or its - setter form `(set (@ name) foo)` do the right thing. + transformed into `(obj (keyword ))`, if and only if `` is defined for `proto`, so that `(@ name)` or its setter form `(set (@ + name) foo)` do the right thing. - The reference symbol by itself is introduces as a reference to - `obj`. + The reference symbol by itself is introduces as a reference to `obj`. Returns `obj`. @@ -837,10 +858,10 @@ `(@ SomePrototype :some-field)` - Translates into `:some-field`, if `some-field` is defined on `SomePrototype`. - `(@ SomePrototype some-object :some-field)` - Asserts (as above) at - compile time that `some-field` is defined on `SomePrototype`; at - runtime, checks that `some-object` is a descendent of - `SomePrototype` and if so, translates to `(some-object :some-field)`. + `(@ SomePrototype some-object :some-field)` - Asserts (as above) at compile + time that `some-field` is defined on `SomePrototype`; at runtime, checks that + `some-object` is a descendent of `SomePrototype` and if so, translates to + `(some-object :some-field)`. ``` [proto x &opt y] (let [[obj field] (if y [x y] [nil x]) @@ -858,10 +879,9 @@ ``` Prototype-aware version of `match`. Introduces one new case form: - - `(@ )`: Will pattern match against an - instance of `prototype-name`. Additionally, will validate at - compile-time that every key in `dictionary` is a field that's - present on the specified prototype. + - `(@ )`: Will pattern match against an instance + of `prototype-name`. Additionally, will validate at compile-time that every + key in `dictionary` is a field that's present on the specified prototype. ``` [x & cases] (defn transform diff --git a/test/fugue.janet b/test/fugue.janet index 810ef5a..1969696 100644 --- a/test/fugue.janet +++ b/test/fugue.janet @@ -254,6 +254,15 @@ (fugue/defmulti cat [_ :number] [m n] (+ m n)) (fugue/defmulti cat [_ _] [x y] (string/format "Falling back to %q<>%q" x y)) +(fugue/defproto CalculatorCell nil special-value {:init? true}) + +(fugue/defmulti cat + [:table :number] [t n] + (string (t :generic-value) "+" n)) +(fugue/defmulti cat + [CalculatorCell :number] [c n] + (string (c :special-value) "+" n)) + (deftest multi-specialization # [:string :string] matches [:string :_] (is (= "hello world" (cat "hello " @"world"))) @@ -263,7 +272,10 @@ # [:number :number] matches [:_ :number]} (is (= 9 (cat 4 5))) # [:_ :_] will never match before a more specific typing - (is (= "Falling back to @\"x\"<>@\"y\"" (cat @"x" @"y")))) + (is (= "Falling back to @\"x\"<>@\"y\"" (cat @"x" @"y"))) + # prototypes are more specific than types + (is (= "2+2" (cat (:new CalculatorCell 2) 2))) + (is (= "2+2" (cat @{:generic-value 2} 2)))) (fugue/defmulti cat2 [_ :number] [n m] (+ n m)) (fugue/defmulti cat2 [:string _] [s s2] (string s "+" s2)) @@ -418,6 +430,10 @@ (fugue/extend-multi open-in-test [:number] [n] (inc n)) (is (= 2 (open-in-test 1)))) +(comment(deftest defmulti-with-proto-in-test + (fugue/defproto InTestForMulti nil name {}) + (fugue/defmulti in-test-multi [InTestForMulti] [it] (it :name)))) + (fugue/declare-open-multi open-headless) (deftest open-defaults @@ -500,16 +516,29 @@ (is (= "Non-Matcher." (try-match "Non-Matcher")))) (deftest matching-multis - (fugue/defmulti with-matching - [{:magic-key z}] [x] + (fugue/defmulti with-matching + [{:magic-key z}] [x] (inc (x :magic-key))) (fugue/declare-open-multi open-with-matching) - (fugue/extend-multi open-with-matching - [{:magicer-key z}] [x] + (fugue/extend-multi open-with-matching + [{:magicer-key z}] [x] (inc (x :magicer-key))) - + (is (= 1 (with-matching {:magic-key 0}))) (is (= 1 (open-with-matching {:magicer-key 0})))) +(deftest matching-and-destructuring-multis + (fugue/defmulti with-bind-matching + [{:magic-key z}] [x] + (inc z)) + + (fugue/declare-open-multi open-with-bind-matching) + (fugue/extend-multi open-with-bind-matching + [{:magicer-key z}] [x] + (inc z)) + + (is (= 1 (with-bind-matching {:magic-key 0}))) + (is (= 1 (open-with-bind-matching {:magicer-key 0})))) + (run-tests!) -- 2.45.2