~subsetpark/fugue

00156d6dc2c0723e2862e2111edf9b37fcbe417e — Zach Smith 26 days ago 3fa72f8 tweak-at-syntax
Allow specifying constructor name
3 files changed, 71 insertions(+), 40 deletions(-)

M README.md
M fugue.janet
M test/fugue.janet
M README.md => README.md +22 -16
@@ 84,7 84,7 @@ runtime, checks that `some-object` is a descendent of
`SomePrototype` and if so, translates to `(some-object
:some-field)`.

[1]: fugue.janet#L721
[1]: fugue.janet#L754

## Root



@@ 137,7 137,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.

[5]: fugue.janet#L306
[5]: fugue.janet#L335

## declare-open-multi



@@ 153,7 153,7 @@ Extending an open multimethod (see `extend-multi`) from any other
environment makes the case extension available wherever the
multimethod has been imported.

[6]: fugue.janet#L607
[6]: fugue.janet#L640

## defgeneric



@@ 168,7 168,7 @@ first argument has a method corresponding to the name of the
function, call that object 's method with the arguments. Otherwise,
evaluate `body`.

[7]: fugue.janet#L342
[7]: fugue.janet#L371

## defmethod



@@ 186,7 186,7 @@ Defines a few symbols for reference in the body of the method.
- `__parent` - Bound to the parent of `proto`.
- `__super` - Bound to the method at `name` within `__parent`.

[8]: fugue.janet#L353
[8]: fugue.janet#L382

## defmulti



@@ 258,7 258,7 @@ repl:12:> (cat "hello" 100)
"hello #100"
```

[9]: fugue.janet#L531
[9]: fugue.janet#L564

## defproto



@@ 283,8 283,9 @@ sense...) the parent of the prototype will be set to `fugue/Root`.

`<field-name> <field-attributes>`

Where `field-attributes` is a struct describing the field. The
following attributes are currently recognized:
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:

- `:default`: provide a default value for all new instances of this
prototype


@@ 319,7 320,12 @@ 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 not of an even length, it wil be taken as an error.
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 name>`.

---



@@ 334,7 340,7 @@ repl:47:> (speak (:new Pekingese))
"My name is Fido and I am Extremely Small"
```

[10]: fugue.janet#L205
[10]: fugue.janet#L232

## extend-multi



@@ 352,7 358,7 @@ 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.

[11]: fugue.janet#L623
[11]: fugue.janet#L656

## fields



@@ 378,7 384,7 @@ hierarchy.
Return the prototype of `obj`, if it has one, otherwise the keyword
output of `type`.

[13]: fugue.janet#L119
[13]: fugue.janet#L146

## multimethod-types-match?



@@ 392,7 398,7 @@ 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)

[14]: fugue.janet#L456
[14]: fugue.janet#L489

## new-Root



@@ 416,7 422,7 @@ Constructor for Root. Return a new object with Root as the prototype.

Is `obj` the result of a `defproto ` call? 

[16]: fugue.janet#L298
[16]: fugue.janet#L327

## with-slots



@@ 458,7 464,7 @@ true
@Foo{:_meta @{:object-type :instance} :name "Cosmo Kramer"}
```

[17]: fugue.janet#L673
[17]: fugue.janet#L706

## with-slots-as



@@ 474,5 480,5 @@ Specifies `as` as the reference symbol for `with-slots`.

See `with-slots` documentation for more details.

[18]: fugue.janet#L710
[18]: fugue.janet#L743


M fugue.janet => fugue.janet +40 -24
@@ 63,8 63,10 @@
    (put field-definitions :fields defined-fields)
    (put proto-field-registry (string (dyn :current-file) "-" name) field-definitions)

    (loop [[field-name attrs] :in fields
           :let [key-field (keyword field-name)]]
    (loop [entry :in fields
           :when (= 2 (length entry))
           :let [[field-name attrs] entry
                 key-field (keyword field-name)]]
      # Assemble list of arguments to constructor
      (when (attrs :init?)
        (array/push (field-definitions :init-args) field-name))


@@ 84,6 86,15 @@
        (put-in field-definitions [:getters field-name] getter-name)))
    field-definitions))

(defn- prototype-attributes
  [name attrs]
  (let [prototype-attributes @{}]
    (when-let [constructor-name (match attrs
                                  {:constructor constructor-name} constructor-name
                                  _ (symbol "new-" name))]
      (put prototype-attributes :constructor-name constructor-name))
    prototype-attributes))

(defn- proto-form
  "Generate the def form for a Prototype."
  [name parent fields defined-fields


@@ 189,17 200,17 @@

(defn- new-form
  "Generate the init form wrapper."
  [name]
  (let [init-name (symbol "new-" name)
        docstring (string/format "Constructor for %s. Return a new object with %s as the prototype."
                                 (string name)
                                 (string name))]
    ~(defn ,init-name
       ,docstring
       [& rest]
       (:new ,name ;rest))))
  [name constructor-name]
  (when constructor-name
    (let [docstring (string/format "Constructor for %s. Return a new object with %s as the prototype."
                                   (string name)
                                   (string name))]
      ~(defn ,constructor-name
         ,docstring
         [& rest]
         (:new ,name ;rest)))))

(eval (new-form 'Root))
(eval (new-form 'Root 'new-Root))

(defn- getters
  [name {:getters getter-list}]


@@ 235,8 246,9 @@

  `<field-name> <field-attributes>`

  Where `field-attributes` is a struct describing the field. The
  following attributes are currently recognized:
  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:

  - `:default`: provide a default value for all new instances of this
  prototype


@@ 271,8 283,13 @@
  want to insert a new term for each new instance, use the `_init`
  method to put a value at that field.
  
  If `fields` is not of an even length, it wil be taken as an error.
  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 name>`.
  
  ---
  
  An example usage:


@@ 287,14 304,13 @@
  ```
  ````
  [name parent-name & fields]
  (unless (zero? (mod (length fields) 2))
    (error "defproto received odd number of fields"))

  (let [fields (partition 2 fields)
  (let [has-proto-attributes (not (zero? (mod (length fields) 2)))
        fields (partition 2 fields)
        defined-fields (map (comp keyword 0) fields)
        field-definitions (field-definitions name fields defined-fields)]
    (array
      ~(def ,name
        field-definitions (field-definitions name fields defined-fields)
        [prototype-attributes-entry] (if has-proto-attributes (last fields) [{}])
        prototype-attributes (prototype-attributes name prototype-attributes-entry)]
    @[~(def ,name
         ,(proto-docstring name defined-fields)
         (->
           ,(proto-form name


@@ 305,8 321,8 @@
           (,put :new ,(init-form name (field-definitions :init-args)))))
      (pred-form name)
      (pred*-form name)
      (new-form name)
      ;(getters name field-definitions))))
      (new-form name (prototype-attributes :constructor-name))
      ;(getters name field-definitions)]))

(defn prototype?
  ```

M test/fugue.janet => test/fugue.janet +9 -0
@@ 345,6 345,15 @@
  (is (= "Wonkus" (ValueInTest :name)))
  (is (= some-particular-table (MutableValueInTest :tab))))

(deftest proto-attributes
  (fugue/defproto BasicConstructor nil)
  (fugue/defproto NameConstructor nil {:constructor another-name})
  (fugue/defproto NoConstructor nil {:constructor false})

  (is (BasicConstructor? (new-BasicConstructor)))
  (is (NameConstructor? (another-name)))
  (is (nil? (dyn 'new-NoConstructor))))

(deftest defgeneric-in-test
  (fugue/defgeneric in-test [x] (string x " ok"))
  (is (= "a ok" (in-test "a"))))