~subsetpark/fugue

1aaea684afc5901e7943ad491453f955500d7dfc — Zach Smith 6 months ago 74299d8
Differentiate between :default and :default-fn
3 files changed, 122 insertions(+), 78 deletions(-)

M README.md
M fugue.janet
M test/fugue.janet
M README.md => README.md +57 -27
@@ 57,25 57,53 @@ be selected for any descendent prototype instances.

## fugue

[Root](#Root), [allocate](#allocate), [declare-open-multi](#declare-open-multi), [defgeneric](#defgeneric), [defmethod](#defmethod), [defmulti](#defmulti), [defproto](#defproto), [extend-multi](#extend-multi), [fields](#fields), [get-type-or-proto](#get-type-or-proto), [multimethod-types-match?](#multimethod-types-match), [prototype?](#prototype)
[Root](#Root), [Root*?](#Root-1), [Root?](#Root-2), [allocate](#allocate), [declare-open-multi](#declare-open-multi), [defgeneric](#defgeneric), [defmethod](#defmethod), [defmulti](#defmulti), [defproto](#defproto), [extend-multi](#extend-multi), [fields](#fields), [get-type-or-proto](#get-type-or-proto), [multimethod-types-match?](#multimethod-types-match), [prototype?](#prototype)

## Root

**table**  | [source][1]

```janet
@{:new <function new-from-Root> :_meta @{ :prototype-allocations @{} :object-type :prototype :fields () :instance-defaults @{}} :_name "Prototype" :_after-init <function identity>}
@{:_init <function identity> :_meta @{ :instance-default-fns @{} :prototype-allocations @{} :object-type :prototype :fields () :instance-defaults @{}} :_name "Prototype" :new <function new-from-Root>}
```

Root of the Fugue object hierarchy.

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

## allocate
## Root*?

**function**  | [source][2]

```janet
(Root*? obj)
```

 Proto ancestor predicate: return if `obj` is a
 descendent of Root.
 

[2]: eval#L-1

## Root?

**function**  | [source][3]

```janet
(Root? obj)
```

 Proto instance predicate: return if `obj` is an
 instance (that is, a direct child) of Root.
 

[3]: eval#L-1

## allocate

**function**  | [source][4]

```janet
(allocate obj key value)
```



@@ 84,11 112,11 @@ 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#L257
[4]: fugue.janet#L263

## declare-open-multi

**macro**  | [source][3]
**macro**  | [source][5]

```janet
(declare-open-multi name)


@@ 100,11 128,11 @@ 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#L579
[5]: fugue.janet#L584

## defgeneric

**macro**  | [source][4]
**macro**  | [source][6]

```janet
(defgeneric name args &opt body)


@@ 115,11 143,11 @@ 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#L291
[6]: fugue.janet#L297

## defmethod

**macro**  | [source][5]
**macro**  | [source][7]

```janet
(defmethod name proto args & body)


@@ 133,11 161,11 @@ 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#L302
[7]: fugue.janet#L308

## defmulti

**macro**  | [source][6]
**macro**  | [source][8]

```janet
(defmulti name multi-types args & body)


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

[6]: fugue.janet#L503
[8]: fugue.janet#L508

## defproto

**macro**  | [source][7]
**macro**  | [source][9]

```janet
(defproto name parent-name & fields)


@@ 224,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:



@@ 235,6 263,8 @@ following attributes are currently recognized:

- `:default`: provide a default value for all new instances of this
prototype
- `:default-fn` a 0-arity function to provide the value for all new
  instances of this prototype
- `:init?`: if truthy, then this field will be a required parameter
to the prototype 's constructor
- `:allocation`: if `:prototype`, then `fugue/allocate` will always act on


@@ 254,7 284,7 @@ prototype. This will take as positional arguments all of the fields
specified as `init?`, and then accept in `&keys` format any of the
other fields defined on this protoype.

The special method ` :_after-init` will be called as the last step
The special method ` :_init` will be called as the last step
in the `:new` conststructor. It can be defined for a prototype (see
`defmethod`) to take a new instance and to make any arbitrary
mutations on the instance or prototype as part of object


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

[7]: fugue.janet#L173
[9]: fugue.janet#L168

## extend-multi

**macro**  | [source][8]
**macro**  | [source][10]

```janet
(extend-multi multi multi-types args & body)


@@ 293,11 323,11 @@ 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#L593
[10]: fugue.janet#L600

## fields

**function**  | [source][9]
**function**  | [source][11]

```janet
(fields obj)


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

[9]: fugue.janet#L329
[11]: fugue.janet#L335

## get-type-or-proto

**function**  | [source][10]
**function**  | [source][12]

```janet
(get-type-or-proto obj)


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

[10]: fugue.janet#L341
[12]: fugue.janet#L347

## multimethod-types-match?

**function**  | [source][11]
**function**  | [source][13]

```janet
(multimethod-types-match? args arg-types)


@@ 333,11 363,11 @@ 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#L432
[13]: fugue.janet#L436

## prototype?

**function**  | [source][12]
**function**  | [source][14]

```janet
(prototype? obj)


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

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

[12]: fugue.janet#L250
[14]: fugue.janet#L256


M fugue.janet => fugue.janet +44 -47
@@ 8,28 8,20 @@
  @{:_meta @{:object-type :prototype
             :fields defined-fields
             :prototype-allocations @{}
             :instance-defaults @{}}
             :instance-defaults @{}
             :instance-default-fns @{}}
    :_name name})

(def Root
  "Root of the Fugue object hierarchy."
  (->
    (bare-proto "Prototype" [])
    (put :_after-init identity)))
    (put :_init identity)))

#
# defproto Forms
#

(defn- make-copy
  "TODO: This is really hacky. There must be a better way."
  [value]
  (cond
    (table? value) (table/clone value)
    (array? value) (array ;value)
    (buffer? value) (buffer value)
    value))

(defn- proto-docstring
  [name defined-fields]
  (string/format


@@ 37,10 29,38 @@
    (string name)
    ((comp freeze (partial map symbol)) defined-fields)))

(defn- field-definitions
  [name fields]
  (let [init-args @[]
        proto-allocated-fields @[]
        proto-allocations @{}
        instance-defaults @{}
        instance-default-fns @{}]
    (loop [[field-name attrs] :in fields
           :let [key-field (keyword field-name)]]
      # Assemble list of arguments to constructor
      (when (attrs :init?)
        (array/push init-args field-name))
      # Assemble fields that should be set directly on this prototype
      (when (= (attrs :allocation) :prototype)
        (array/push proto-allocated-fields key-field))
      # Assemble values to be set directly on prototype
      (when-let [proto-value (attrs :allocate-value)]
        (put proto-allocations key-field (eval proto-value)))
      # Assemble mapping of fields to default values for instances
      (when-let [default-value (attrs :default)]
        (put instance-defaults key-field (eval default-value)))
      # Assemble mapping of fields to default functions for instances
      # (eg for newly generated values)
      (when-let [default-fn (attrs :default-fn)]
        (put instance-default-fns key-field (eval default-fn))))

    [init-args proto-allocated-fields proto-allocations instance-defaults instance-default-fns]))

(defn- proto-form
  "Generate the def form for a Prototype."
  [name parent fields defined-fields
   proto-allocated-fields proto-allocations instance-defaults]
   _init-args proto-allocated-fields proto-allocations instance-defaults instance-default-fns]
  ~(let [parent ',parent
         object (,bare-proto (string ',name) ,defined-fields)
         proto-allocations @{}]


@@ 53,6 73,7 @@
               (get-in parent [:_meta :prototype-allocations])))

     (put-in object [:_meta :instance-defaults] ',instance-defaults)
     (put-in object [:_meta :instance-default-fns] ',instance-default-fns)

     (loop [[allocation-field allocation-value] :pairs ',proto-allocations]
       (put object allocation-field allocation-value))


@@ 71,12 92,10 @@
       (while source-of-defaults
         (let [defaults (get-in source-of-defaults [:_meta :instance-defaults])]
           (loop [[default-key default-value] :pairs defaults]
             # Ensure the value inserted into a new instance is
             # distinct from any previous examples.
             # Theoretically we might want to directly insert
             # the value, but until the usecase arises we can
             # always make a copy.
             (put inst default-key (,make-copy default-value))))
             (put inst default-key default-value)))
         (let [default-fns (get-in source-of-defaults [:_meta :instance-default-fns])]
           (loop [[default-key default-fn] :pairs default-fns]
             (put inst default-key (default-fn))))
         # Recurse to grandparent
         (set source-of-defaults (table/getproto source-of-defaults)))



@@ 93,33 112,10 @@
       # Associate instance with Prototype
       (table/setproto inst self)

       (:_after-init inst))))
       (:_init inst))))

(put Root :new (eval (init-form 'Root [])))

(defn- field-definitions
  [name fields]
  (let [init-args @[]
        proto-allocated-fields @[]
        proto-allocations @{}
        instance-defaults @{}]
    (loop [[field-name attrs] :in fields
           :let [key-field (keyword field-name)]]
      # Assemble list of arguments to constructor
      (when (attrs :init?)
        (array/push init-args field-name))
      # Assemble fields that should be set directly on this prototype
      (when (= (attrs :allocation) :prototype)
        (array/push proto-allocated-fields key-field))
      # Assemble values to be set directly on prototype
      (when-let [proto-value (attrs :allocate-value)]
        (put proto-allocations key-field (eval proto-value)))
      # Assemble mapping of fields to default values for instances
      (when-let [default-value (attrs :default)]
        (put instance-defaults key-field (eval default-value))))

    [init-args proto-allocated-fields proto-allocations instance-defaults]))

(defn- getters
  [name fields]
  (seq [[field-name attrs] :in fields


@@ 191,6 187,8 @@

  - `:default`: provide a default value for all new instances of this
  prototype
  - `:default-fn` a 0-arity function to provide the value for all new
    instances of this prototype
  - `:init?`: if truthy, then this field will be a required parameter
  to the prototype 's constructor
  - `:allocation`: if `:prototype`, then `fugue/allocate` will always act on


@@ 210,7 208,7 @@
  specified as `init?`, and then accept in `&keys` format any of the
  other fields defined on this protoype.

  The special method ` :_after-init` will be called as the last step
  The special method ` :_init` will be called as the last step
  in the `:new` conststructor. It can be defined for a prototype (see
  `defmethod`) to take a new instance and to make any arbitrary
  mutations on the instance or prototype as part of object


@@ 239,7 237,8 @@
  (let [fields (partition 2 fields)
        parent (if (symbol? parent-name) (eval parent-name) Root)
        defined-fields (map (comp keyword 0) fields)
        [init-args proto-allocated-fields proto-allocations instance-defaults] (field-definitions name fields)]
        field-definitions (field-definitions name fields)
       [init-args] field-definitions]
    (array/push
      (getters name fields)
      ~(def ,name


@@ 249,9 248,7 @@
                        parent
                        fields
                        defined-fields
                        proto-allocated-fields
                        proto-allocations
                        instance-defaults)
                        ;field-definitions)
           (put :new ,(init-form name init-args))))
      (pred-form name)
      (pred*-form name))))

M test/fugue.janet => test/fugue.janet +21 -4
@@ 48,20 48,37 @@

(fugue/defproto Light () speed {:default math/inf})

(deftest non-idempotent-defaults
(deftest symbol-defaults
  (proto-tests Light)
  (let [a-light (:new Light)]
    (inst-tests Light a-light)
    (is (number? (a-light :speed)))))

(fugue/defproto Stack () data {:default @[]})
(fugue/defproto Stack () data {:default-fn |@[]})

(deftest mutable-defaults
(deftest mutable-default-fns
  (let [a-stack (:new Stack)
        b-stack (:new Stack)]
    (array/push (a-stack :data) :ok)
    (is (empty? (b-stack :data)))))

(fugue/defproto SharingStack () data {:default @[]})

(deftest mutable-defaults
  (let [a-stack (:new SharingStack)
        b-stack (:new SharingStack)]
    (array/push (a-stack :data) :ok)
    (is (== @[:ok] (b-stack :data)))))

(def inner-stack @[])
(fugue/defproto DeepStack () data {:default-fn |@[inner-stack]})

(deftest inner-references-are-not-copied
  (let [a-stack (:new DeepStack)
        b-stack (:new DeepStack)]
    (put-in a-stack [:data 0 0] :ok)
    (is (== @[@[:ok]] (b-stack :data)))))

(fugue/defproto Container () capacity {:init? true})

(deftest init


@@ 154,7 171,7 @@
    (is (nil? (dyn 'second-unique-field)))))

(fugue/defproto Caster ())
(fugue/defmethod _after-init Caster [inst] (freeze inst))
(fugue/defmethod _init Caster [inst] (freeze inst))

(deftest after-init
  (let [casted (:new Caster)]