~subsetpark/fugue

8dd16a26696cb745c2e9f2ad901c73a8d81f1070 — Zach Smith 10 days ago 18d7772
Initial with-slots
2 files changed, 59 insertions(+), 0 deletions(-)

M fugue.janet
M test/fugue.janet
M fugue.janet => fugue.janet +45 -0
@@ 624,3 624,48 @@
            cond-form (construct-cond fn-name cases args)
            docstring (make-docstring cases "Open ")]
        (emit-varfn multi (symbol fn-name) docstring args cond-form)))))

(defn- field-transformer
  [fields as proto-name]
  (fn [sym]
    (let [field-name (and (symbol? sym) (keyword (string/slice sym 1)))]
      (if (and (symbol? sym)
               (= ((string sym) 0) (chr "@")))
        (do
          (unless (index-of field-name fields)
            (errorf "Encountered field reference %q for prototype %q; expected one of: %q"
                    sym
                    proto-name
                    fields))
          ~(,as ,field-name))
        sym))))

(defn- with-slots-as
  [proto obj as body]
  (let [f (-> proto (eval) (fields) (field-transformer as proto))]
    ~(let [,as ,obj]
       ,;(prewalk f body))))

(defmacro with-slots
  ```
  Anaphoric macro with transformed getter/setters.

  Injects `this` into scope as a reference to `obj`.

  Any symbols that begin with `@` are transformed into `(this <field name>)`,
  so that `@name` or its setter form `(set @name foo)` do the right thing.
  ```
  [proto obj & body]
  (with-slots-as proto obj 'this body))

(defmacro with-slots-as
  ```
  Anaphoric macro with transformed getter/setters.

  Injects the arg `as` into scope as a reference to `obj`.

  Any symbols that begin with `@` are transformed into `(<as> <field name>)`,
  so that `@name` or its setter form `(set @name foo)` do the right thing.
  ```
  [proto obj as & body]
  (with-slots-as proto obj as body))

M test/fugue.janet => test/fugue.janet +14 -0
@@ 345,4 345,18 @@
(deftest multiple-file-multi-extend 
  (is (= 11 (a/f 10))))

(fugue/defproto SlotHaver () name {})

(deftest slots-test
  (let [a-slot-haver (:new SlotHaver)]
    (fugue/with-slots SlotHaver a-slot-haver
      (set @name "will shortz")
      (is (= "will shortz" @name))
      (is (= "will shortz" (this :name)))
      (is (= "will shortz" (name this))))
    (is (= "will shortz" (a-slot-haver :name)))))

(deftest slots-validation
  (is (thrown? (apply fugue/with-slots ['SlotHaver {} '@other]))))

(run-tests!)