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"))))