~subsetpark/fugue

ea47a686c6e414aca6c271d64336219772960a54 — Zach Smith 15 days ago f1a8cd4
type-check in getter
3 files changed, 59 insertions(+), 46 deletions(-)

M README.md
M fugue.janet
M test/fugue.janet
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})