diff options
| -rw-r--r-- | arith.c | 11 | ||||
| -rw-r--r-- | share/txr/stdlib/compiler.tl | 17 |
2 files changed, 28 insertions, 0 deletions
@@ -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]) |