~subsetpark/fugue

0f54a140d563eb1412bc3e183ba040ef1a49939d — Zach Smith 3 years ago 87f2b95 varfn
Some experiments around varfn. Probably unusabl
6 files changed, 283 insertions(+), 251 deletions(-)

M README.md
A env.janet
A env2.janet
M fugue.janet
A multi.janet
M project.janet
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"])