~subsetpark/fugue

4814bcf2186a3d02f681f98f8458e2d3502b3ce8 — Zach Smith 2 months ago a6b24c6
Minor cleanup
1 files changed, 58 insertions(+), 57 deletions(-)

M fugue.janet
M fugue.janet => fugue.janet +58 -57
@@ 346,7 346,7 @@
  An example usage:

  ```
  repl:43:> (fugue/defproto Dog () name {:allocate-value "Fido"})
  repl:43:> (fugue/defproto Dog nil name {:allocate-value "Fido"})
  repl:44:> (fugue/defproto Pekingese Dog size {:default "Extremely Small"})
  repl:45:> (fugue/defmethod speak Dog [self] (string "My name is " (self :name)))
  repl:46:> (fugue/defmethod speak Pekingese [self] (string (prototype-method self) " and I am " (self :size)))


@@ 431,16 431,24 @@
  evaluate `body`.
  ```
  [name & rest]
  (let [[docstring args body]
        (if (string? (first rest))
          [(rest 0)
           (rest 1)
           (array/slice rest 2)]
          [nil
           (rest 0)
           (array/slice rest 1)])]
  (let [[docstring args body] (if (string? (first rest))
                                [(rest 0)
                                 (rest 1)
                                 (array/slice rest 2)]
                                [nil
                                 (rest 0)
                                 (array/slice rest 1)])]
    (defgeneric* name docstring args ;(if (empty? body) [raise-sentinel] body))))

(defn- generate-method-form
  [name args proto body]
  (let [full-method-name (symbol proto "-" name)]
    ~(fn ,full-method-name
       ,args
       (let [__parent (,table/getproto ,proto)
             __super (__parent ,(keyword name))]
         ,;body))))

(defmacro defmethod
  ```
  Simple single-dispatch method definition. Roughly equivalent to


@@ 458,15 466,8 @@
        (maclintf :strict "Defining generic function for method %s ..." (string name))
        (defgeneric* name nil args raise-sentinel))

      (let [method-name (keyword name)
            full-method-name (symbol proto "-" name)]
        ~(,put ,proto
               ,method-name
               (fn ,full-method-name
                 ,args
                 (let [__parent (table/getproto ,proto)
                       __super (__parent ,method-name)]
                   ,;body))))]))
      (let [method-form (generate-method-form name args proto body)]
        ~(,put ,proto ,(keyword name) ,method-form))]))

#
# Multimethod Helpers


@@ 568,6 569,10 @@
          (break)))
      res)))

(defn- make-case
  [args body]
  (eval ~(fn ,args ,;body)))

(defn- construct-cond
  "Build main function logic of multimethod"
  [name cases args-symbol]


@@ 599,25 604,6 @@
     [& ,args]
     ,cond-form))

(defn- find-root
  [t]
  (if (table/rawget t :ref)
    t
    (when-let [it (table/getproto t)] it)))

(defn- emit-varfn
  "Generate varfn form of multimethod"
  [name fn-name docstring args cond-form]
  ~(let [cell (,find-root (dyn ',name))
         f (fn ,fn-name [& ,args] ,cond-form)]
     (,put-in cell [:ref 0] f)
     (,put-in cell [:doc] ,docstring)
     f))

(defn- make-case
  [args body]
  (eval ~(fn ,args ,;body)))

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


@@ 626,7 612,7 @@
  Example usage :

  ```
  > (defproto Foo ())
  > (defproto Foo nil)
  > (defmulti add [Foo] [f] (put f :value 1))
  > (defmulti add [:number] [x] (+ x 1))
  > (defmulti add [:string] [s] (string s "!"))


@@ 704,13 690,28 @@
  multimethod has been imported.
  ```
  [name]
  (let [f (eval ~(fn ,name [& _] (error "No cases declared for open multimethod")))
  (let [f (eval ~(fn ,name [&] (error "No cases declared for open multimethod")))
        ref @[f]
        cell @{:doc "Open multimethod." :ref ref}]
    (put var-cases ref @{})
    (setdyn name cell)
    f))

(defn- var-cell
  [t]
  (if (table/rawget t :ref)
    t
    (when-let [it (table/getproto t)] it)))

(defn- emit-varfn
  "Generate varfn form of multimethod"
  [name fn-name docstring args cond-form]
  ~(let [cell (,var-cell (dyn ',name))
         f (fn ,fn-name [& ,args] ,cond-form)]
     (,put-in cell [:ref 0] f)
     (,put-in cell [:doc] ,docstring)
     f))

(defmacro extend-multi
  ```
  Extend an open multimethod (see `declare-open-multi`) using the same


@@ 732,29 733,29 @@
            docstring (make-docstring cases "Open ")]
        (emit-varfn multi (symbol fn-name) docstring args cond-form)))))

(defn- field-transformer
  [fields obj-sym as proto-name]
  (fn [sym]
    (cond
      (and (tuple? sym) (= (length sym) 2) (= (sym 0) as) (symbol? (sym 1)))
      (let [field-name (-> sym (1) (keyword))]
        (unless (index-of field-name fields)
          (errorf `Encountered field reference %q for prototype %q;
(defn- do-with-slots-as
  [proto obj as body]
  (defn field-transformer
    [fields obj-sym as proto-name]
    (fn [sym]
      (cond
        (and (tuple? sym) (= (length sym) 2) (= (sym 0) as) (symbol? (sym 1)))
        (let [field-name (-> sym (1) (keyword))]
          (unless (index-of field-name fields)
            (errorf `Encountered field reference %q for prototype %q;

                   Expected one of: %q`
                  sym
                  proto-name
                  fields))
        ~(,obj-sym ,field-name))
                    sym
                    proto-name
                    fields))
          ~(,obj-sym ,field-name))

      (= sym as)
      obj-sym
        (= sym as)
        obj-sym

      true
      sym)))
        true
        sym)))

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