~subsetpark/fugue

07a06de8d8c5a969136ab375af9310d89eaec99b — Zach Smith 5 months ago daa5d83
2 or 3-argument form of @
2 files changed, 45 insertions(+), 9 deletions(-)

M fugue.janet
M test/fugue.janet
M fugue.janet => fugue.janet +35 -9
@@ 126,6 126,11 @@

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

(defn- prototype-check
  "Check if obj is an instance of proto."
  [proto obj]
  (and (table? obj) (= proto (table/getproto obj))))

(defn- pred-form
  "Generate the defn form for the Prototype predicate."
  [name]


@@ 138,10 143,16 @@
    ~(defn ,pred-name
       ,pred-docstring
       [obj]
       (and (,table? obj) (,= ,name (,table/getproto obj))))))
       (,prototype-check ,name obj))))

(eval (pred-form 'Root))

(defn- recursive-prototype-check
  "Check if obj is a descendent of ancestor."
  [ancestor obj]
  (or (prototype-check ancestor obj)
      (and (table? obj) (recursive-prototype-check ancestor (table/getproto obj)))))

(defn- pred*-form
  "Generate the defn form for the recursive Prototype predicate."
  [name]


@@ 156,8 167,7 @@
    ~(defn ,rec-pred-name
       ,rec-pred-docstring
       [obj]
       (or (,pred-name obj)
           (and (,table? obj) (,rec-pred-name (,table/getproto obj)))))))
       (,recursive-prototype-check ,name obj))))

(eval (pred*-form 'Root))



@@ 696,12 706,28 @@

(defmacro @
  ```
  Compile-time Prototype field checking. Translates into ordinary
  field keyword name, if `field` is present on `proto`.
  Compile-time Prototype field checking.

  Accepts two forms:

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

  `(@ SomePrototype some-object :some-field)` - Assets (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 field]
  (let [fields (fields (eval proto))]
  [proto x &opt y]
  (let [[obj field] (if y [x y] [nil x])
        fields (fields (eval proto))]

    (unless (index-of field fields)
      (errorf "Field `%s` not found; Got fields: %q" (string field) fields)))
      (errorf "Field `%s` not found; Got fields: %q" (string field) fields))

  field)
    (if-not obj
      field
      ~(if-not (,recursive-prototype-check ,proto ,obj)
         (errorf "Expected a %s, got: %q" (,get-type-or-proto ,obj))
         ,(tuple obj field)))))

M test/fugue.janet => test/fugue.janet +10 -0
@@ 361,4 361,14 @@
(deftest slots-validation
  (is (thrown? (apply fugue/with-slots '[SlotHaver {} (@ other)]))))

(deftest @-macro
  (is (= (fugue/@ SlotHaver :name) :name))
  (let [a-slot-haver (new-SlotHaver :name "Freddie")
        not-a-member-of-queen {:name "Queen Victoria"}]
    (is (= "Freddie" (a-slot-haver (fugue/@ SlotHaver :name))))
    (is (= "Freddie" (fugue/@ SlotHaver a-slot-haver :name)))
    (set (a-slot-haver (fugue/@ SlotHaver :name)) "Brian May")
    (is (= "Brian May" (a-slot-haver :name)))
    (is (thrown? (fugue/@ SlotHaver not-a-member-of-queen :name)))))

(run-tests!)