M README.md => README.md +104 -98
@@ 57,19 57,19 @@ be selected for any descendent prototype instances.
## fugue
-[Root](#Root), [allocate](#allocate), [defgeneric](#defgeneric), [defmethod](#defmethod), [defmulti](#defmulti), [defproto](#defproto), [fields](#fields), [multimethod-types-match?](#multimethod-types-match), [proto-or-type](#proto-or-type), [prototype?](#prototype)
+[Root](#Root), [allocate](#allocate), [defgeneric](#defgeneric), [defmethod](#defmethod), [defproto](#defproto), [fields](#fields), [prototype?](#prototype)
## Root
**table** | [source][1]
```janet
-@{:_meta @{ :object-type :prototype :fields () :prototype_allocations @{} :object-id top_000001} :_name "Prototype" :new <function new-from-root>}
+@{:_meta @{ :object-type :prototype :fields () :prototype_allocations @{} :object-id top_000006} :_name "Prototype" :new <function new-from-root>}
```
-[1]: fugue.janet#L1
+[1]: fugue.janet#L3
## allocate
@@ 84,7 84,7 @@ 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.
-[2]: fugue.janet#L164
+[2]: fugue.janet#L166
## defgeneric
@@ 99,7 99,7 @@ first argument has a method corresponding to the name of the
function, call that object 's method with the arguments. Otherwise,
evaluate `body`.
-[3]: fugue.janet#L184
+[3]: fugue.janet#L186
## defmethod
@@ 117,83 117,11 @@ Defines a few symbols for reference in the body of the method.
`parent-protoype` - Bound to the parent of `proto`.
`prototype-method` - Bound to the method at `name` within `parent-prototype`.
-[4]: fugue.janet#L194
-
-## defmulti
-
-**macro** | [source][5]
-
-```janet
-(defmulti name multi-types args & body)
-```
-
-Define a multimethod based on all the arguments passed to the
-function.
-
-Example usage :
-
-```
-> (defproto Foo ())
-> (defmulti add [Foo] [f] (put f :value 1))
-> (defmulti add [:number] [x] (+ x 1))
-> (defmulti add [:string] [s] (string s "!"))
-> (def a-foo (:new Foo))
-> (add a-foo)
-@Foo{:value 1 :_meta @{:object-id Foo_00001v :object-type :instance}}
-> (add 1)
-2
-> (add "s")
-"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.
-
-In addition to type names or prototypes, you can use the symbol `_`
-or keyword `:_` as a wildcard that means "match any type". For
-instance,
-
-```
-repl:2:> (defmulti cat [:string :_] [s1 s2] (string s1 s2))
-repl:3:> (cat "hello " "world!")
-"hello world!"
-repl:4:> (cat "hello " 42)
-"hello 42"
-repl:5:> (cat 42 "hello")
-error: could not apply multimethod <function cat> to args (42 "hello")
- in cat [repl] on line 2, column 1
- 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.
-
-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:
-
-```
-repl:10:> (cat "hello " @"world")
-"hello world"
-repl:12:> (cat "hello" 100)
-"hello #100"
-```
-
-[5]: fugue.janet#L287
+[4]: fugue.janet#L196
## defproto
-**macro** | [source][6]
+**macro** | [source][5]
```janet
(defproto name parent-name & fields)
@@ 251,11 179,11 @@ repl:47:> (speak (:new Pekingese))
"My name is Fido and I am Extremely Small"
```
-[6]: fugue.janet#L15
+[5]: fugue.janet#L17
## fields
-**function** | [source][7]
+**function** | [source][6]
```janet
(fields obj)
@@ 264,11 192,101 @@ repl:47:> (speak (:new Pekingese))
Return all the defined fields for `obj` and its prototype
hierarchy.
-[7]: fugue.janet#L219
+[6]: fugue.janet#L221
+
+## prototype?
+
+**function** | [source][7]
+
+```janet
+(prototype? obj)
+```
+
+Is `obj` the result of a `defproto ` call?
+
+[7]: fugue.janet#L159
+
+## multi
+
+, [defmulti](#defmulti), [multimethod-types-match?](#multimethod-types-match), [proto-or-type](#proto-or-type)
+
+Multimethod / Protocol (runtime Multimethod) functionality
+
+## defmulti
+
+**macro** | [source][9]
+
+```janet
+(defmulti name multi-types args & body)
+```
+
+Define a multimethod based on all the arguments passed to the
+function.
+
+Example usage :
+
+```
+> (defproto Foo ())
+> (defmulti add [Foo] [f] (put f :value 1))
+> (defmulti add [:number] [x] (+ x 1))
+> (defmulti add [:string] [s] (string s "!"))
+> (def a-foo (:new Foo))
+> (add a-foo)
+@Foo{:value 1 :_meta @{:object-id Foo_00001v :object-type :instance}}
+> (add 1)
+2
+> (add "s")
+"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.
+
+In addition to type names or prototypes, you can use the symbol `_`
+or keyword `:_` as a wildcard that means "match any type". For
+instance,
+
+```
+repl:2:> (defmulti cat [:string :_] [s1 s2] (string s1 s2))
+repl:3:> (cat "hello " "world!")
+"hello world!"
+repl:4:> (cat "hello " 42)
+"hello 42"
+repl:5:> (cat 42 "hello")
+error: could not apply multimethod <function cat> to args (42 "hello")
+ in cat [repl] on line 2, column 1
+ 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.
+
+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:
+
+```
+repl:10:> (cat "hello " @"world")
+"hello world"
+repl:12:> (cat "hello" 100)
+"hello #100"
+```
+
+[9]: multi.janet#L59
## multimethod-types-match?
-**function** | [source][8]
+**function** | [source][10]
```janet
(multimethod-types-match? args arg-types)
@@ 278,11 296,11 @@ Check to see if the types `args` match the sequence `arg-types`,
according to multimethod rules (ie, following prototype membership
and using `:_` as a fallback)
-[8]: fugue.janet#L263
+[10]: multi.janet#L35
## proto-or-type
-**function** | [source][9]
+**function** | [source][11]
```janet
(proto-or-type obj)
@@ 291,17 309,5 @@ and using `:_` as a fallback)
Return the prototype of `obj`, if it has one, otherwise the keyword
output of `type`.
-[9]: fugue.janet#L231
-
-## prototype?
-
-**function** | [source][10]
-
-```janet
-(prototype? obj)
-```
-
-Is `obj` the result of a `defproto ` call?
-
-[10]: fugue.janet#L157
+[11]: multi.janet#L3
A env.janet => env.janet +3 -0
@@ 0,0 1,3 @@
+(use /fugue)
+(declare-protocol! speak)
+(defmulti speak [:number] [n] (+ n 1))
A env2.janet => env2.janet +7 -0
@@ 0,0 1,7 @@
+(use /fugue)
+(import /env)
+
+(pp (dyn 'env/speak))
+(pp (macex1
+ '(defmulti env/speak [:string] [s] (string s "!"))))
+
M fugue.janet => fugue.janet +2 -152
@@ 1,3 1,5 @@
+(import /multi :prefix "" :export true)
+
(var Root nil)
(defn- bare-proto
@@ 228,155 230,3 @@
@[])
;(or (get-in obj [:_meta :fields]) @[])))
-(defn proto-or-type
- ```
- Return the prototype of `obj`, if it has one, otherwise the keyword
- output of `type`.
- ```
- [obj]
- (if (table? obj)
- (or (table/getproto obj) (type obj))
- (type obj)))
-
-#
-# Private Multimethod State
-#
-
-(def- multi-asts @{})
-
-(defn- set-multi-default! [name]
- (unless (in multi-asts name) (put multi-asts name @{})))
-
-(defn- put-multi! [name types args body]
- (put-in multi-asts [name (tuple/slice types)] [args body]))
-
-(defn- get-multi-cases [name]
- (as-> name .
- (multi-asts .)
- (pairs .)
- (sorted . >)))
-
-#
-# Multimethod API
-#
-
-(defn multimethod-types-match?
- ```
- Check to see if the types `args` match the sequence `arg-types`,
- according to multimethod rules (ie, following prototype membership
- and using `:_` as a fallback)
- ```
- [args arg-types]
- (if (not= (length arg-types) (length args))
- false
- (do
- (var kk nil)
- (var vk nil)
- (var res true)
- (while true
- (set kk (next args kk))
- (if (= nil kk) (break))
- (set vk (next arg-types vk))
- (if (= nil vk) (break))
- (unless (or (= (arg-types vk) :_)
- (= (proto-or-type (args kk)) (arg-types vk)))
- (set res false)
- (break)))
- res)))
-
-(defmacro defmulti
- ````
- Define a multimethod based on all the arguments passed to the
- function.
-
- Example usage :
-
- ```
- > (defproto Foo ())
- > (defmulti add [Foo] [f] (put f :value 1))
- > (defmulti add [:number] [x] (+ x 1))
- > (defmulti add [:string] [s] (string s "!"))
- > (def a-foo (:new Foo))
- > (add a-foo)
- @Foo{:value 1 :_meta @{:object-id Foo_00001v :object-type :instance}}
- > (add 1)
- 2
- > (add "s")
- "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.
-
- In addition to type names or prototypes, you can use the symbol `_`
- or keyword `:_` as a wildcard that means "match any type". For
- instance,
-
- ```
- repl:2:> (defmulti cat [:string :_] [s1 s2] (string s1 s2))
- repl:3:> (cat "hello " "world!")
- "hello world!"
- repl:4:> (cat "hello " 42)
- "hello 42"
- repl:5:> (cat 42 "hello")
- error: could not apply multimethod <function cat> to args (42 "hello")
- in cat [repl] on line 2, column 1
- 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.
-
- 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:
-
- ```
- repl:10:> (cat "hello " @"world")
- "hello world"
- repl:12:> (cat "hello" 100)
- "hello #100"
- ```
- ````
- [name multi-types args & body]
- (let [transformed (map |(case $ '_ :_ $) multi-types)]
-
- (set-multi-default! name)
- (put-multi! name transformed args body)
-
- (with-syms [args]
- # Total hack: rely on the fact that `:_` is less than any table
- # or any type name (which are all alphabetical keywords). Thus,
- # when sorted, cases should always have the base case last for
- # any positional argument.
- #
- # ie: [:string :string]
- # [:string :_]
- # [:_ :number]
- # [:_ :_]
- (let [cases (get-multi-cases name)
- cond-body
- (mapcat (fn [[arg-types [fn-args fn-body]]]
- ~[(,multimethod-types-match? ,args (tuple ,;arg-types))
- ((fn ,fn-args ,;fn-body) ;,args)])
- cases)
- listed-types (string/join
- (map (comp (partial string/format "%q") 0)
- cases)
- "\n\n")
- docstring (string "Multimethod. Defined types:\n\n" listed-types)]
- ~(defn ,name
- ,docstring
- [& ,args]
- (cond ,;cond-body
- true (error (string/format "could not apply multimethod %q to args %q" ,name ,args))))))))
A multi.janet => multi.janet +166 -0
@@ 0,0 1,166 @@
+(setdyn :doc "Multimethod / Protocol (runtime Multimethod) functionality")
+
+(defn proto-or-type
+ ```
+ Return the prototype of `obj`, if it has one, otherwise the keyword
+ output of `type`.
+ ```
+ [obj]
+ (if (table? obj)
+ (or (table/getproto obj) (type obj))
+ (type obj)))
+
+#
+# Private Multimethod State
+#
+
+(def- multi-asts @{})
+(def- protocols @{})
+
+(defn- set-multi-default! [name]
+ (unless (in multi-asts name) (put multi-asts name @{})))
+
+(defn- put-multi! [name types args body]
+ (put-in multi-asts [name (tuple/slice types)] [args body]))
+
+(defn- get-multi-cases [name]
+ (as-> name .
+ (multi-asts .)
+ (pairs .)
+ (sorted . >)))
+
+(defn protocol? [f] (in protocols f))
+
+(defn- set-protocol [f] (put protocols f f))
+
+#
+# Multimethod API
+#
+
+(defmacro declare-protocol! [name]
+ ~(
+ @[(defn ,name [] nil)
+ (,set-protocol ,name)]))
+
+(defn multimethod-types-match?
+ ```
+ Check to see if the types `args` match the sequence `arg-types`,
+ according to multimethod rules (ie, following prototype membership
+ and using `:_` as a fallback)
+ ```
+ [args arg-types]
+ (if (not= (length arg-types) (length args))
+ false
+ (do
+ (var kk nil)
+ (var vk nil)
+ (var res true)
+ (while true
+ (set kk (next args kk))
+ (if (= nil kk) (break))
+ (set vk (next arg-types vk))
+ (if (= nil vk) (break))
+ (unless (or (= (arg-types vk) :_)
+ (= (proto-or-type (args kk)) (arg-types vk)))
+ (set res false)
+ (break)))
+ res)))
+
+(defmacro defmulti
+ ````
+ Define a multimethod based on all the arguments passed to the
+ function.
+
+ Example usage :
+
+ ```
+ > (defproto Foo ())
+ > (defmulti add [Foo] [f] (put f :value 1))
+ > (defmulti add [:number] [x] (+ x 1))
+ > (defmulti add [:string] [s] (string s "!"))
+ > (def a-foo (:new Foo))
+ > (add a-foo)
+ @Foo{:value 1 :_meta @{:object-id Foo_00001v :object-type :instance}}
+ > (add 1)
+ 2
+ > (add "s")
+ "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.
+
+ In addition to type names or prototypes, you can use the symbol `_`
+ or keyword `:_` as a wildcard that means "match any type". For
+ instance,
+
+ ```
+ repl:2:> (defmulti cat [:string :_] [s1 s2] (string s1 s2))
+ repl:3:> (cat "hello " "world!")
+ "hello world!"
+ repl:4:> (cat "hello " 42)
+ "hello 42"
+ repl:5:> (cat 42 "hello")
+ error: could not apply multimethod <function cat> to args (42 "hello")
+ in cat [repl] on line 2, column 1
+ 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.
+
+ 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:
+
+ ```
+ repl:10:> (cat "hello " @"world")
+ "hello world"
+ repl:12:> (cat "hello" 100)
+ "hello #100"
+ ```
+ ````
+ [name multi-types args & body]
+ (let [transformed (map |(case $ '_ :_ $) multi-types)]
+
+ (set-multi-default! name)
+ (put-multi! name transformed args body)
+
+ (with-syms [args]
+ # Total hack: rely on the fact that `:_` is less than any table
+ # or any type name (which are all alphabetical keywords). Thus,
+ # when sorted, cases should always have the base case last for
+ # any positional argument.
+ #
+ # ie: [:string :string]
+ # [:string :_]
+ # [:_ :number]
+ # [:_ :_]
+ (let [cases (get-multi-cases name)
+ cond-body
+ (mapcat (fn [[arg-types [fn-args fn-body]]]
+ ~[(,multimethod-types-match? ,args (tuple ,;arg-types))
+ ((fn ,fn-args ,;fn-body) ;,args)])
+ cases)
+ listed-types (string/join
+ (map (comp (partial string/format "%q") 0)
+ cases)
+ "\n\n")
+ docstring (string "Multimethod. Defined types:\n\n" listed-types)]
+ ~(if (,protocol? (get-in (dyn ',name) [:ref 0]))
+ (varfn ,name ,docstring [& ,args]
+ (cond ,;cond-body
+ true (error (string/format "could not apply multimethod %q to args %q" ,name ,args))))
+ (defn ,name ,docstring [& ,args]
+ (cond ,;cond-body
+ true (error (string/format "could not apply multimethod %q to args %q" ,name ,args)))))))))
M project.janet => project.janet +1 -1
@@ 63,4 63,4 @@ inheritable; a multimethod defined for an ancestor Prototype will not
be selected for any descendent prototype instances.```)
(declare-source
- :source ["fugue.janet"])
+ :source ["fugue.janet" "multi.janet"])