refactor apply to make it clearer and remove redundant code

yrashk · Jan 26, 2012 · 2e58b55 · 2e58b55
1 parent 568e0d7
commit 2e58b55
Show file tree

Hide file tree

Showing 2 changed files with 14,365 additions and 11,568 deletions.
diff --git a/src/joxa/compiler.jxa b/src/joxa/compiler.jxa
@@ -1652,59 +1652,46 @@
     (cerl/set_ann cerl-thing (lists/append old-annots annots))))
 
 (defn make-apply (path0 ctx0 form)
-  (let (annots (annots-from-context [] path0 ctx0)
-        build-apply (fn (path1 ctx1 cerl-target args)
-                        (case (eval-args (incr-path 2 path1) ctx1 args)
-                          ({ctx2 cerl-arg-list}
-                           (case (cerl/is_c_fname cerl-target)
-                             (:true
-                              (case (==  (cerl/fname_arity cerl-target)
-                                         (erlang/length cerl-arg-list))
-                                (:true
-                                        {ctx2 (cerl/ann_c_apply annots cerl-target cerl-arg-list)})
-                                (:false
-                                 (erlang/throw {:invalid-arity (idx-from-context [] path0 ctx0)}))))
-                             (:false
-                              {ctx2 (cerl/ann_c_apply annots cerl-target cerl-arg-list)}))))))
+  (let (annots (annots-from-context [] path0 ctx0))
     (case form
-      ((:apply . ((= ref  {:--fun module function _}) . args))
-       (case (resolve-reference-ctx function (erlang/length args) ctx0)
-         ({:remote {module function arity}}
-          (case (eval-args (incr-path 2 path0) ctx0 args)
-            ({ctx1 arg-list}
+      ((:apply . (target . args))
+       (case (eval-args (incr-path 2 path0) ctx0 args)
+         ({ctx1 arg-list}
+          (case (resolve-reference-ctx target (erlang/length args) ctx0)
+            ({:remote {module function arity}}
+             (case (eval-args (incr-path 2 path0) ctx0 args)
+               ({ctx1 arg-list}
+                {ctx1 (cerl/ann_c_call annots
+                                       (cerl/ann_c_atom annots module)
+                                       (cerl/ann_c_atom annots function)
+                                       arg-list)})))
+            ({:remote-rest module function arity}
              {ctx1 (cerl/ann_c_call annots
                                     (cerl/ann_c_atom annots module)
                                     (cerl/ann_c_atom annots function)
-                                    arg-list)})))
-         (_
-          (erlang/throw {:invalid-reference  ref (erlang/length args)
-                                             (idx-from-context [] path0 ctx0)}))))
-      ((:apply . ((= ref {--fun function arity}) . args))
-       (case (resolve-reference-ctx function (erlang/length args) ctx0)
-         ({:apply {function arity}}
-          (build-apply path0 ctx0 (cerl/ann_c_fname annots function arity) args))
-         (_
-          (erlang/throw {:invalid-reference ref (erlang/length args)
-                                            (idx-from-context [] path0 ctx0)}))))
-      ((:apply . (target . args))
-       (when (erlang/is_atom target))
-       (case (resolve-reference-ctx target (erlang/length args) ctx0)
-         ({:reference {val _}}
-          (build-apply path0 ctx0 (add-to-annots val annots) args))
-         (:not-a-reference
-          (case (comp-expr (traverse-path path0) ctx0 target)
-            ({ctx1 cerl-val}
-             (build-apply path0 ctx0 cerl-val args))
-            (_
-             (erlang/throw {:invalid-reference target (erlang/length args)
-                                               (idx-from-context [] path0 ctx0)}))))))
-      ((:apply . (target . args))
-       (case (comp-expr (traverse-incr-path path0) ctx0 target)
-         ({ctx1 cerl-target}
-          (build-apply path0 ctx0 cerl-target args))
-         (_
-          (erlang/throw {:invalid-reference target (erlang/length args)
-                                            (idx-from-context [] path0 ctx0)})))))))
+                                    (args-to-arity arg-list 1 arity []))})
+            ({:apply {function arity}}
+             {ctx1 (cerl/ann_c_apply annots
+                                     (cerl/ann_c_fname annots function arity)
+                                     arg-list)})
+            ({:apply-rest {function arity}}
+             {ctx1 (cerl/ann_c_apply annots
+                                     (cerl/ann_c_fname annots function arity)
+                                     (args-to-arity arg-list 1 arity []))})
+
+            ({:reference {val _}}
+             {ctx1 (cerl/ann_c_apply annots
+                                     val
+                                     arg-list)})
+            (:not-a-reference
+             (case (comp-expr (traverse-path path0) ctx1 target)
+               ({ctx2 cerl-val}
+                {ctx2 (cerl/ann_c_apply annots
+                                        cerl-val
+                                        arg-list)})))))))
+      (_
+       (erlang/throw {:invalid-reference form
+                                         (idx-from-context [] path0 ctx0)})))))
 
 (defn+ gensym ()
   (let (x (erlang/phash2 {(erlang/node) (erlang/now ) (crypto/rand_bytes 16)})