~subsetpark/fugue

ed4b912b96c0080b40a0c5a27bbde080383dcc55 — Zach Smith 6 months ago 4fdf5b1
Bugfix object id and only allocate after-init once
3 files changed, 29 insertions(+), 20 deletions(-)

M README.md
M fugue.janet
M test/fugue.janet
M README.md => README.md +12 -12
@@ 69,7 69,7 @@ be selected for any descendent prototype instances.

Root of the Fugue object hierarchy.

[1]: fugue.janet#L15
[1]: fugue.janet#L14

## allocate



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

[2]: fugue.janet#L287
[2]: fugue.janet#L294

## declare-open-multi



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

[3]: fugue.janet#L625
[3]: fugue.janet#L632

## defgeneric



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

[4]: fugue.janet#L321
[4]: fugue.janet#L328

## defmethod



@@ 133,7 133,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`.

[5]: fugue.janet#L332
[5]: fugue.janet#L339

## defmulti



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

[6]: fugue.janet#L549
[6]: fugue.janet#L556

## defproto



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

[7]: fugue.janet#L199
[7]: fugue.janet#L208

## extend-multi



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

[8]: fugue.janet#L638
[8]: fugue.janet#L645

## fields



@@ 306,7 306,7 @@ wherever the multimethod is imported.
Return all the defined fields for `obj` and its prototype
hierarchy.

[9]: fugue.janet#L359
[9]: fugue.janet#L366

## get-type-or-proto-id



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

[10]: fugue.janet#L377
[10]: fugue.janet#L384

## multimethod-types-match?



@@ 333,7 333,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)

[11]: fugue.janet#L478
[11]: fugue.janet#L485

## prototype?



@@ 345,5 345,5 @@ and using `:_` as a fallback)

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

[12]: fugue.janet#L280
[12]: fugue.janet#L287


M fugue.janet => fugue.janet +7 -7
@@ 9,14 9,14 @@
             :fields defined-fields
             :prototype_allocations @{}
             :object-id object-id}
    :_name name
    :_after-init identity})
    :_name name})

(def Root
  "Root of the Fugue object hierarchy."
  (let [top (keyword "top" (gensym))]
    (bare-proto top "Prototype" [])))

(put Root :_after-init identity)
(put Root :new
     (fn new-from-root
       [self &keys attrs]


@@ 83,9 83,8 @@

(defn- proto-form
  "Generate the def form for a Prototype."
  [name parent-name parent-sym fields proto-allocated-fields]
  (let [parent-closure |(if (symbol? parent-name) (eval parent-name) Root)
        defined-fields (map |(keyword ($0 0)) fields)
  [name parent-closure parent-sym fields proto-allocated-fields]
  (let [defined-fields (map |(keyword ($0 0)) fields)
        docstring (proto-docstring name defined-fields)]
    ~(def ,name
       ,docstring


@@ 274,12 273,13 @@
    (error "defproto received odd number of fields"))
  
  (let [fields (partition 2 fields)
        parent-sym (keyword parent-name (gensym))
        parent-closure |(if (symbol? parent-name) (eval parent-name) Root)
        parent-sym (keyword (in (parent-closure) :_name) (gensym))
        [init-args proto-allocated-fields] (field-definitions name fields parent-sym)]
    (populate-runtime-info! fields parent-sym)
    (array/push
     (getters name fields)
     (proto-form name parent-name parent-sym fields proto-allocated-fields)
     (proto-form name parent-closure parent-sym fields proto-allocated-fields)
     (init-form name init-args)
     (pred-form name parent-sym)
     (pred*-form name parent-sym))))

M test/fugue.janet => test/fugue.janet +10 -1
@@ 8,7 8,8 @@

(defn- proto-tests [proto]
  (is (fugue/prototype? proto))
  (is (= fugue/Root (table/getproto proto))))
  (is (= fugue/Root (table/getproto proto)))
  (is (string/has-prefix? "Prototype" (get-in proto [:_meta :object-id]))))

(defmacro- inst-tests [proto inst]
  (upscope


@@ 108,15 109,23 @@

(deftest inheritance
  (is (= Dog (table/getproto Pekingese)))
  (is (string/has-prefix? "Dog" (get-in Pekingese [:_meta :object-id])))

  (let [a-pekingese (:new Pekingese)]

    (inst-tests Pekingese a-pekingese)
    (accessor-tests name [a-pekingese Dog Pekingese])
    (accessor-tests size [a-pekingese Pekingese])

    (is (string/has-prefix? "Pekingese" (get-in a-pekingese [:_meta :object-id])))

    (is (nil? (size Dog)))
    (is (= "Fido" (name a-pekingese)))
    (is (= "Extremely Small" (size a-pekingese)))

    (is (not (Dog? a-pekingese)))
    (is (Dog*? a-pekingese))

    (is (= "blue" (collar-color a-pekingese)))))

(fugue/defproto Form () unique-field {:getter get-unique-field})