1 files changed, 58 insertions(+), 57 deletions(-)

M fugue.janet

@@ 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]