~subsetpark/fugue

eab95f0e1bedb01f0b62dc68f50fe1fd0555564a — Zach Smith 2 months ago 16a776c
Minor updates
2 files changed, 156 insertions(+), 107 deletions(-)

M fugue.janet
M test/fugue.janet
M fugue.janet => fugue.janet +121 -101
@@ 200,7 200,9 @@
  output of `type`.
  ```
  [obj]
  (if (table? obj) (table/getproto obj) (type obj)))
  (if (table? obj)
    (or (table/getproto obj) (type obj))
    (type obj)))

(defn- pred-name [name] (symbol name "?"))



@@ 286,60 288,59 @@

  ## Usage

  `name` should be any symbol. The resulting prototype will be
  named after it.
  `name` should be any symbol. The resulting prototype will be 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`.
  `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`.

  `fields` should be 0 or more pairs of the following format:

  `<field-name> <field-attributes>`

  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:
  `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

  - `:init?`: if truthy, then this field will be a required parameter to the
  prototype's constructor

  - `:default`: provide a default 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
  the prototype when putting this field.

  - `:allocate-value`: this field will have this attribute set at the
  prototype, so that any children without their own values will
  inherit it.
  - `:getter`: specify a name for the defined function to access this
  field (by default, has the same name as the field). Specify `false`
  to prevent a getter from being defined.

  `defproto` will define a getter function for each of the defined
  fields, unless `:getter` is false.

  `defproto` will also create a `:new` method in the created
  prototype. This will take as positional arguments all of the fields
  specified as `init?`, and then accept in `&keys` format any other
  attributes to set on this object.

  The special method `:_init` will be called as the last step in the
  `:new` constructor. 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
  instantiation. By default it simply returns the instance.

  The value provided to a field's `:default` entry will be inserted
  directly to the instance. Thus, mutable/referenced terms like tables
  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 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>`.
  prototype, so that any children without their own values will inherit it.

  - `:getter`: specify a name for the defined function to access this field (by
  default, has the same name as the field). Specify `false` to prevent a getter
  from being defined.

  `defproto` will define a getter function for each of the defined fields,
  unless `:getter` is false.

  `defproto` will also create a `:new` method in the created prototype. This
  will take as positional arguments all of the fields specified as `init?`, and
  then accept in `&keys` format any other attributes to set on this object.

  The special method `:_init` will be called as the last step in the `:new`
  constructor. 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 instantiation. By default it simply returns the instance.

  The value provided to a field's `:default` entry will be inserted directly to
  the instance. Thus, mutable/referenced terms like tables 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 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>`.

  ---



@@ 377,7 378,7 @@

(defn prototype?
  ```
  Is `obj` the result of a `defproto ` call? 
  Is `obj` the result of a `defproto ` call?
  ```
  [obj]
  (and (Root*? obj)


@@ 385,10 386,10 @@

(defn allocate
  ```
  Allocation-aware put. If `obj` has inherited an allocation to a
  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.
  Allocation-aware put. If `obj` has inherited an allocation to a 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.
  ```
  [obj key value]
  (var source-of-defaults obj)


@@ 425,10 426,9 @@

(defmacro defgeneric
  ```
  Define a generic function. When this function is called, if the
  first argument has a method corresponding to the name of the
  function, call that object 's method with the arguments. Otherwise,
  evaluate `body`.
  Define a generic function. When this function is called, if the first
  argument has a method corresponding to the name of the function, call that
  object 's method with the arguments. Otherwise, evaluate `body`.
  ```
  [name & rest]
  (let [[docstring args body] (if (string? (first rest))


@@ 451,8 451,8 @@

(defmacro defmethod
  ```
  Simple single-dispatch method definition. Roughly equivalent to
  `put` ing a function directly into a prototype.
  Simple single-dispatch method definition. Roughly equivalent to `put` ing a
  function directly into a prototype.

  Defines a few symbols for reference in the body of the method.



@@ 497,10 497,10 @@
  (defn f [sym]
    (cond
      (or (= '_ sym) (= :_ sym)) nil
      (or (tuple? sym) (struct? sym)) (compile-matcher sym)
      (not (or (symbol? sym) (keyword? sym))) (compile-matcher sym)
      (let [evaled (eval sym)]
        (if (not (or (table? evaled) (keyword? evaled)))
          (errorf `Multimethod type error. Expected keyword or prototype, got:
          (errorf `Multimethod type error. Expected keyword, prototype, or match specification; got:
                   %q of type %q`
                  sym
                  (type sym))


@@ 562,6 562,7 @@
      (var kk nil)
      (var vk nil)
      (var res true)

      (while true
        (set kk (next args kk))
        (if (= nil kk) (break))


@@ 569,22 570,26 @@
        (set vk (next arg-types vk))
        (if (= nil vk) (break))

        (unless (or (= (arg-types vk) nil)
                    (and (function? (arg-types vk))
                         ((arg-types vk) (args kk)))
                    (= (get-type-or-proto (args kk)) (arg-types vk)))
          (set res false)
          (break)))
        (let [arg (args kk)
              arg-type (arg-types vk)]
          (unless (or (nil? arg-type)
                      (and (function? arg-type) (arg-type arg))
                      (= (get-type-or-proto arg) arg-type))
            (set res false)
            (break))))

      res)))

(defn- make-case
  [multi-types args body]
  (let [destructurable @[]]
    (each [type arg] (map tuple multi-types args)
    (each [type-spec arg] (map tuple multi-types args)
      (cond
        (struct? type) (array/concat destructurable @[type arg])
        (tuple? type) (array/concat destructurable @[(first type) arg])))
        (or (keyword? type-spec) (symbol? type-spec)) :ok
        (tuple? type-spec) (array/concat destructurable
                                         @[(first type-spec) arg])
        (array/concat destructurable @[type-spec arg])))

    (eval ~(fn multimethod-case
             ,args
             (let ,destructurable


@@ 624,8 629,7 @@

(defmacro defmulti
  ````
  Define a multimethod based on all the arguments passed to the
  function.
  Define a multimethod based on all the arguments passed to the function.

  Example usage :



@@ 643,17 647,36 @@
  "s!"
  ```

  `defmulti` takes a sequence of type-or-prototypes, and builds a
  function which will check its arguments against those types (as well
  as all other ones specified in other `defmulti` calls to the same
  function name), and execute the function body for the matching type
  signature.
  `defmulti` takes a sequence of *multimethod specifications*, and builds a
  function which will check its arguments against those types (as well as all
  other ones specified in other `defmulti` calls to the same function name),
  and execute the function body for the matching type signature.

  A multimethod specification can be any of the following data types:

  - a **keyword** representing the name of a simple or abstract type; for
  instance, `:number` or `:string`. This will match against values of this
  type.

  - A **symbol** referring to an existing table. This will match against tables
  which have this table as a prototype.

  In addition to type names or prototypes, you can use the symbol `_`
  or keyword `:_` as a wildcard that means "match any type". For
  instance,
  - The **fallback symbols** `:_` and `_`. These will match against anything.

  ``` 
  - A **match specification**, ie, a pattern understood by the `match` macro,
  as long as it isn't one of the above values. This will match against any
  value that would be matched in an execution of `match`. This includes tuples
  with arbitrary predicates.

  Multimethod specs match in order of *most specific* to *least specific*; that
  is:

  1. Match specifications
  2. Prototypes
  3. Simple types
  4. Fallback

  ```
  repl:2:> (defmulti cat [:string :_] [s1 s2] (string s1 s2))
  repl:3:> (cat "hello " "world!")
  "hello world!"


@@ 665,19 688,18 @@
  in _thunk [repl] (tailcall) on line 5, column 1
  ```

  Defining a multimethod with the signature `[:string :_]` will match
  on any two arguments if the first one is a string.
  Defining a multimethod with the signature `[:string :_]` will match on any
  two arguments if the first one is a string.

  A multimethod without wilcards will be preferred to one with one in
  the same position. For instance, if we define an additional
  multimethod:
  A multimethod without wilcards will be preferred to one with one in the same
  position. For instance, if we define an additional multimethod:

  ```
  repl:8:> (defmulti cat [:string :number] [s n] (string s " #" n))
  ```

  Then that more specific method will be preferred and the wildcard
  will be a fallback if the specific one doesn't match:
  Then that more specific method will be preferred and the wildcard will be a
  fallback if the specific one doesn't match:

  ```
  repl:10:> (cat "hello " @"world")


@@ 737,8 759,8 @@

  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.
  Whenever a case is added to `multi`, that case is available wherever the
  multimethod is imported.
  ```
  [multi multi-types args & body]
  (let [ref (and (dyn multi) (in (dyn multi) :ref))]


@@ 786,16 808,15 @@

  Introduces two useful forms for referring to `obj`.

  It introduces a *reference symbol* - `@` by default
  (see `with-slots-as `to specify the symbol).
  It introduces a *reference symbol* - `@` by default (see `with-slots-as `to
  specify the symbol).

  The pattern `(@ <field name>)`, where `<field name>` is a symbol, is
  transformed into `(obj (keyword <field name>))`, if and only if
  `<field name>` is defined for `proto`, so that `(@ name)` or its
  setter form `(set (@ name) foo)` do the right thing.
  transformed into `(obj (keyword <field name>))`, if and only if `<field
  name>` is defined for `proto`, so that `(@ name)` or its setter form `(set (@
  name) foo)` do the right thing.

  The reference symbol by itself is introduces as a reference to
  `obj`.
  The reference symbol by itself is introduces as a reference to `obj`.

  Returns `obj`.



@@ 837,10 858,10 @@
  `(@ SomePrototype :some-field)` - Translates into `:some-field`, if
  `some-field` is defined on `SomePrototype`.

  `(@ SomePrototype some-object :some-field)` - Asserts (as above) at
  compile time that `some-field` is defined on `SomePrototype`; at
  runtime, checks that `some-object` is a descendent of
  `SomePrototype` and if so, translates to `(some-object :some-field)`.
  `(@ SomePrototype some-object :some-field)` - Asserts (as above) at compile
  time that `some-field` is defined on `SomePrototype`; at runtime, checks that
  `some-object` is a descendent of `SomePrototype` and if so, translates to
  `(some-object :some-field)`.
  ```
  [proto x &opt y]
  (let [[obj field] (if y [x y] [nil x])


@@ 858,10 879,9 @@
  ```
  Prototype-aware version of `match`. Introduces one new case form:

  - `(@ <prototype-name> <dictionary>)`: Will pattern match against an
  instance of `prototype-name`. Additionally, will validate at
  compile-time that every key in `dictionary` is a field that's
  present on the specified prototype. 
  - `(@ <prototype-name> <dictionary>)`: Will pattern match against an instance
  of `prototype-name`. Additionally, will validate at compile-time that every
  key in `dictionary` is a field that's present on the specified prototype.
  ```
  [x & cases]
  (defn transform

M test/fugue.janet => test/fugue.janet +35 -6
@@ 254,6 254,15 @@
(fugue/defmulti cat [_ :number] [m n] (+ m n))
(fugue/defmulti cat [_ _] [x y] (string/format "Falling back to %q<>%q" x y))

(fugue/defproto CalculatorCell nil special-value {:init? true})

(fugue/defmulti cat
                [:table :number] [t n]
                (string (t :generic-value) "+" n))
(fugue/defmulti cat
                [CalculatorCell :number] [c n]
                (string (c :special-value) "+" n))

(deftest multi-specialization
  # [:string :string] matches [:string :_]
  (is (= "hello world" (cat "hello " @"world")))


@@ 263,7 272,10 @@
  # [:number :number] matches [:_ :number]}
  (is (= 9 (cat 4 5)))
  # [:_ :_] will never match before a more specific typing
  (is (= "Falling back to @\"x\"<>@\"y\"" (cat @"x" @"y"))))
  (is (= "Falling back to @\"x\"<>@\"y\"" (cat @"x" @"y")))
  # prototypes are more specific than types
  (is (= "2+2" (cat (:new CalculatorCell 2) 2)))
  (is (= "2+2" (cat @{:generic-value 2} 2))))

(fugue/defmulti cat2 [_ :number] [n m] (+ n m))
(fugue/defmulti cat2 [:string _] [s s2] (string s "+" s2))


@@ 418,6 430,10 @@
  (fugue/extend-multi open-in-test [:number] [n] (inc n))
  (is (= 2 (open-in-test 1))))

(comment(deftest defmulti-with-proto-in-test
  (fugue/defproto InTestForMulti nil name {})
  (fugue/defmulti in-test-multi [InTestForMulti] [it] (it :name))))

(fugue/declare-open-multi open-headless)

(deftest open-defaults


@@ 500,16 516,29 @@
  (is (= "Non-Matcher." (try-match "Non-Matcher"))))

(deftest matching-multis
  (fugue/defmulti with-matching 
                  [{:magic-key z}] [x] 
  (fugue/defmulti with-matching
                  [{:magic-key z}] [x]
                  (inc (x :magic-key)))

  (fugue/declare-open-multi open-with-matching)
  (fugue/extend-multi open-with-matching 
                      [{:magicer-key z}] [x] 
  (fugue/extend-multi open-with-matching
                      [{:magicer-key z}] [x]
                      (inc (x :magicer-key)))
  

  (is (= 1 (with-matching {:magic-key 0})))
  (is (= 1 (open-with-matching {:magicer-key 0}))))

(deftest matching-and-destructuring-multis
  (fugue/defmulti with-bind-matching
                  [{:magic-key z}] [x]
                  (inc z))

  (fugue/declare-open-multi open-with-bind-matching)
  (fugue/extend-multi open-with-bind-matching
                      [{:magicer-key z}] [x]
                      (inc z))

  (is (= 1 (with-bind-matching {:magic-key 0})))
  (is (= 1 (open-with-bind-matching {:magicer-key 0}))))

(run-tests!)