compiler: use binary versions of common math functions.

* arith.c (arith_init): Register functions in the sys package:
b<, b>, b<=, b=, b+, b-, b*, b/ and neg.

* share/txr/stdlib/compiler.tl (%nary-ops%, %bin-ops%,
%bin-op%): New global variables.
(compiler comp-fun-form): Transform two-argument calls to any
of the variadic functions in %nary-ops% functions into calls
to their binary counterpart. These calls are faster, since
they bypass the wrapper which deals with the variable argument
list. Also, we detect unary - and map it to the new sys:neg
function, and reduce the one-argument cases of certain
functions to noops.

1 files changed, 17 insertions, 0 deletions

diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl
index 2f27365d..417a3c46 100644
--- a/share/txr/stdlib/compiler.tl
+++ b/share/txr/stdlib/compiler.tl
@@ -225,6 +225,12 @@
 (defvarl %block-using-funs% '(sys:capture-cont return* sys:abscond* match-fun
                               eval load compile compile-file compile-toplevel))
 
+(defvarl %nary-ops% '(< > <= => = + - * /))
+
+(defvarl %bin-ops% '(b< b> b<= b=> b= b+ b- b* b/))
+
+(defvarl %bin-op% (relate %nary-ops% %bin-ops%))
+
 (defmeth compiler get-dreg (me atom)
   (condlet
     ((((null atom))) '(t 0))
@@ -999,6 +1005,17 @@
 
 (defmeth compiler comp-fun-form (me oreg env form)
   (tree-bind (sym . args) form
+    (cond
+      ((= (len args) 2)
+       (iflet ((bin [%bin-op% sym]))
+         (set sym bin
+              form (cons sym args))))
+      ((= (len args) 1)
+       (caseq sym
+         (- (set sym 'neg
+                 form (cons sym args)))
+         ((identity + * min max) (return-from comp-fun-form
+                                   me.(compile oreg env (car args)))))))
     (caseql sym
       ((call apply usr:apply)
        (let ((gopcode [%gcall-op% sym])