M README.md => README.md +12 -12
@@ 112,7 112,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.
-[4]: fugue.janet#L272
+[4]: fugue.janet#L291
## declare-open-multi
@@ 128,7 128,7 @@ Extending an open multimethod (see `extend-multi`) from any other
environment makes the case extension available wherever the
multimethod has been imported.
-[5]: fugue.janet#L593
+[5]: fugue.janet#L604
## defgeneric
@@ 143,7 143,7 @@ first argument has a method corresponding to the name of the
function, call that object 's method with the arguments. Otherwise,
evaluate `body`.
-[6]: fugue.janet#L306
+[6]: fugue.janet#L325
## defmethod
@@ 161,7 161,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`.
-[7]: fugue.janet#L317
+[7]: fugue.janet#L336
## defmulti
@@ 233,7 233,7 @@ repl:12:> (cat "hello" 100)
"hello #100"
```
-[8]: fugue.janet#L517
+[8]: fugue.janet#L528
## defproto
@@ 252,7 252,7 @@ named after it.
`parent-name` is required; it can be an existing prototype, *or*
some null-ish value. If null-ish (`nil` or `()` should make the most
- sense...) the parent of the prototype will be set to `fugue/Root`.
+sense...) the parent of the prototype will be set to `fugue/Root`.
`fields` should be 0 or more pairs of the following format:
@@ 309,7 309,7 @@ repl:47:> (speak (:new Pekingese))
"My name is Fido and I am Extremely Small"
```
-[9]: fugue.janet#L173
+[9]: fugue.janet#L192
## extend-multi
@@ 327,7 327,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.
-[10]: fugue.janet#L609
+[10]: fugue.janet#L620
## fields
@@ 340,7 340,7 @@ wherever the multimethod is imported.
Return all the defined fields for `obj` and its prototype
hierarchy.
-[11]: fugue.janet#L344
+[11]: fugue.janet#L363
## get-type-or-proto
@@ 353,7 353,7 @@ hierarchy.
Return the prototype of `obj`, if it has one, otherwise the keyword
output of `type`.
-[12]: fugue.janet#L356
+[12]: fugue.janet#L119
## multimethod-types-match?
@@ 367,7 367,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)
-[13]: fugue.janet#L445
+[13]: fugue.janet#L456
## prototype?
@@ 379,5 379,5 @@ and using `:_` as a fallback)
Is `obj` the result of a `defproto ` call?
-[14]: fugue.janet#L265
+[14]: fugue.janet#L284
M fugue.janet => fugue.janet +43 -32
@@ 116,24 116,13 @@
(put Root :new (eval (init-form 'Root [])))
-(defn- getters
- [name fields]
- (let [forms @[]]
- (loop [[field-name attrs] :in fields
- :let [key-field (keyword field-name)]]
- # Allow specifying another getter name or `false`
- # for no getter
- (when-let [docstring (string "Get " field-name " from a " name)
- getter-name (match attrs
- {:getter getter} getter
- _ field-name)
- qualified-name (symbol name "/" getter-name) ]
- (with-syms [self]
- (array/push forms ~(defn ,getter-name ,docstring [,self]
- (in ,self ,key-field)))
- (array/push forms ~(defn ,qualified-name ,docstring [,self]
- (in ,self ,key-field))))))
- forms))
+(defn get-type-or-proto
+ ```
+ Return the prototype of `obj`, if it has one, otherwise the keyword
+ output of `type`.
+ ```
+ [obj]
+ (if (table? obj) (table/getproto obj) (type obj)))
(defn- pred-name [name] (symbol name "?"))
@@ 170,6 159,36 @@
(eval (pred*-form 'Root))
+(defn- getters
+ [name fields]
+ (let [forms @[]]
+ (loop [[field-name attrs] :in fields
+ :let [key-field (keyword field-name)]]
+ # Allow specifying another getter name or `false`
+ # for no getter
+ (when-let [docstring (string "Get " field-name " from a " name)
+ getter-name (match attrs
+ {:getter getter} getter
+ _ field-name)
+ qualified-name (symbol name "/" getter-name)]
+ (with-syms [self]
+ (array/push forms ~(defn ,getter-name
+ ,docstring
+ [,self]
+ (in ,self ,key-field)))
+ (array/push forms ~(defn ,qualified-name
+ ,docstring
+ [,self]
+ (unless (,(pred-name name) ,self)
+ (let [found-name (match (,get-type-or-proto ,self)
+ @{:_name name} name
+ type type)]
+ (errorf "type error: expected %q, got: %q"
+ ',name
+ found-name)))
+ (in ,self ,key-field))))))
+ forms))
+
(defmacro defproto
````
Object prototype definition.
@@ 181,7 200,7 @@
`parent-name` is required; it can be an existing prototype, *or*
some null-ish value. If null-ish (`nil` or `()` should make the most
- sense...) the parent of the prototype will be set to `fugue/Root`.
+ sense...) the parent of the prototype will be set to `fugue/Root`.
`fields` should be 0 or more pairs of the following format:
@@ 247,9 266,8 @@
parent (if (symbol? parent-name) (eval parent-name) Root)
defined-fields (map (comp keyword 0) fields)
field-definitions (field-definitions name fields)
- [init-args] field-definitions]
- (array/push
- (getters name fields)
+ [init-args] field-definitions]
+ (array
~(def ,name
,(proto-docstring name defined-fields)
(->
@@ 260,7 278,8 @@
;field-definitions)
(put :new ,(init-form name init-args))))
(pred-form name)
- (pred*-form name))))
+ (pred*-form name)
+ ;(getters name fields))))
(defn prototype?
```
@@ 353,14 372,6 @@
obj-fields (or (get-in obj [:_meta :fields]) @[])]
(array ;proto-fields ;obj-fields)))
-(defn get-type-or-proto
- ```
- Return the prototype of `obj`, if it has one, otherwise the keyword
- output of `type`.
- ```
- [obj]
- (if (table? obj) (table/getproto obj) (type obj)))
-
#
# Multimethod Helpers
#
@@ 601,7 612,7 @@
[name]
(let [f (eval ~(fn ,name [& _] (error "No cases declared for open multimethod")))
ref @[f]
- cell @{:doc "Open multimethod." :ref ref}]
+ cell @{:doc "Open multimethod." :ref ref}]
(put var-cases ref @{})
(setdyn name cell)
f))
M test/fugue.janet => test/fugue.janet +4 -2
@@ 160,10 160,12 @@
(fugue/defproto Form () unique-field {:getter get-unique-field})
(deftest getter
- (let [a-form (:new Form :unique-field :echo)]
+ (let [a-form (:new Form :unique-field :echo)
+ a-dog (:new Dog)]
(is (nil? (dyn 'unique-field)))
(is (= :echo (get-unique-field a-form)))
- (is (= :echo (Form/get-unique-field a-form)))))
+ (is (= :echo (Form/get-unique-field a-form)))
+ (is (thrown? (Form/get-unique-field a-dog)))))
(fugue/defproto Form2 () second-unique-field {:getter false})