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.

2 files changed, 28 insertions, 0 deletions

diff --git a/arith.c b/arith.c
index ceb8d96e..90575fc5 100644
--- a/arith.c
+++ b/arith.c
@@ -3288,6 +3288,17 @@ void arith_init(void)
   reg_fun(intern(lit("poly"), user_package), func_n2(poly));
   reg_fun(intern(lit("rpoly"), user_package), func_n2(rpoly));
 
+  reg_fun(intern(lit("b<"), system_package), func_n2(lt));
+  reg_fun(intern(lit("b>"), system_package), func_n2(gt));
+  reg_fun(intern(lit("b<="), system_package), func_n2(le));
+  reg_fun(intern(lit("b=>"), system_package), func_n2(ge));
+  reg_fun(intern(lit("b="), system_package), func_n2(numeq));
+  reg_fun(intern(lit("b+"), system_package), func_n2(plus));
+  reg_fun(intern(lit("b-"), system_package), func_n2(minus));
+  reg_fun(intern(lit("b*"), system_package), func_n2(mul));
+  reg_fun(intern(lit("b/"), system_package), func_n2(divi));
+  reg_fun(intern(lit("neg"), system_package), func_n1(neg));
+
 #if HAVE_ROUNDING_CTL_H
   reg_varl(intern(lit("flo-near"), user_package), num(FE_TONEAREST));
   reg_varl(intern(lit("flo-down"), user_package), num(FE_DOWNWARD));
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])