3 files changed, 71 insertions(+), 40 deletions(-)

M README.md
M fugue.janet
M test/fugue.janet

@@ 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
 

@@ 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?
   ```

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