From 8b8ca2e793f90aa58d7430b8f060c467cd41ec1b Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Thu, 29 Mar 2012 21:41:49 -0700 Subject: * arith.c (numeq): New function. (exptmod): Bugfix: was no normalizing the bignum, ouch. Also was reporting "non-integral operands" for other errors. * eval.c (eval_init): Registered = intrinsic function. * lib.c (numeqv): New function. * lib.h (numeq, numeqv): Declared. * txr.1: Documented expt, sqrt, isqrt, exptmod, fixnump, bignump, integerp, floatp, numberp, zerop, evenp, oddp, >, <, >=, <= and =. * txr.vim: Highlight = --- ChangeLog | 18 +++++++++ arith.c | 43 +++++++++++++++++++- eval.c | 1 + lib.c | 14 +++++++ lib.h | 2 + txr.1 | 136 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++--- txr.vim | 2 +- 7 files changed, 208 insertions(+), 8 deletions(-) diff --git a/ChangeLog b/ChangeLog index b71ef931..78c88285 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,21 @@ +2012-03-29 Kaz Kylheku + + * arith.c (numeq): New function. + (exptmod): Bugfix: was no normalizing the bignum, ouch. + Also was reporting "non-integral operands" for other + errors. + + * eval.c (eval_init): Registered = intrinsic function. + + * lib.c (numeqv): New function. + + * lib.h (numeq, numeqv): Declared. + + * txr.1: Documented expt, sqrt, isqrt, exptmod, fixnump, bignump, + integerp, floatp, numberp, zerop, evenp, oddp, >, <, >=, <= and =. + + * txr.vim: Highlight = + 2012-03-29 Kaz Kylheku * arith.c (gcd): Allow zeros. Don't issue "non-integral" diff --git a/arith.c b/arith.c index 208a06a1..d39f1396 100644 --- a/arith.c +++ b/arith.c @@ -1112,6 +1112,42 @@ tail: uw_throwf(error_s, lit("lt: invalid operands ~s ~s"), anum, bnum, nao); } +val numeq(val anum, val bnum) +{ +tail: + switch (TYPE_PAIR(type(anum), type(bnum))) { + case TYPE_PAIR(NUM, NUM): + case TYPE_PAIR(CHR, CHR): + case TYPE_PAIR(NUM, CHR): + case TYPE_PAIR(CHR, NUM): + return c_num(anum) == c_num(bnum) ? t : nil; + case TYPE_PAIR(NUM, BGNUM): + case TYPE_PAIR(CHR, BGNUM): + return mp_cmp_z(mp(bnum)) == MP_EQ ? t : nil; + case TYPE_PAIR(BGNUM, NUM): + case TYPE_PAIR(BGNUM, CHR): + return mp_cmp_z(mp(anum)) == MP_EQ ? t : nil; + case TYPE_PAIR(BGNUM, BGNUM): + return mp_cmp(mp(anum), mp(bnum) == MP_EQ) ? t : nil; + case TYPE_PAIR(NUM, FLNUM): + case TYPE_PAIR(CHR, FLNUM): + return c_num(anum) == c_flo(bnum) ? t : nil; + case TYPE_PAIR(FLNUM, NUM): + case TYPE_PAIR(FLNUM, CHR): + return c_flo(anum) == c_num(bnum) ? t : nil; + case TYPE_PAIR(FLNUM, FLNUM): + return c_flo(anum) == c_flo(bnum) ? t : nil; + case TYPE_PAIR(FLNUM, BGNUM): + bnum = flo_int(bnum); + goto tail; + case TYPE_PAIR(BGNUM, FLNUM): + anum = flo_int(anum); + goto tail; + } + + uw_throwf(error_s, lit("=: invalid operands ~s ~s"), anum, bnum, nao); +} + val expt(val anum, val bnum) { tail: @@ -1228,12 +1264,15 @@ val exptmod(val base, val exp, val mod) n = make_bignum(); if (mp_exptmod(mp(base), mp(exp), mp(mod), mp(n)) != MP_OKAY) - goto inval; + goto bad; - return n; + return normalize(n); inval: uw_throwf(error_s, lit("exptmod: non-integral operands ~s ~s ~s"), base, exp, mod, nao); +bad: + uw_throwf(error_s, lit("exptmod: bad operands ~s ~s ~s"), + base, exp, mod, nao); } static int_ptr_t isqrt_fixnum(int_ptr_t a) diff --git a/eval.c b/eval.c index 3fdee26f..b79b88f1 100644 --- a/eval.c +++ b/eval.c @@ -2211,6 +2211,7 @@ void eval_init(void) reg_fun(intern(lit("<"), user_package), func_n1v(ltv)); reg_fun(intern(lit(">="), user_package), func_n1v(gev)); reg_fun(intern(lit("<="), user_package), func_n1v(lev)); + reg_fun(intern(lit("="), user_package), func_n1v(numeqv)); reg_fun(intern(lit("max"), user_package), func_n1v(maxv)); reg_fun(intern(lit("min"), user_package), func_n1v(minv)); diff --git a/lib.c b/lib.c index 5737d48e..d354ce6e 100644 --- a/lib.c +++ b/lib.c @@ -1269,6 +1269,20 @@ val lev(val first, val rest) return t; } +val numeqv(val first, val rest) +{ + val iter; + + for (iter = rest; iter; iter = cdr(iter)) { + val elem = car(iter); + if (!numeq(first, elem)) + return nil; + first = elem; + } + + return t; +} + val max2(val anum, val bnum) { return if3(gt(anum, bnum), anum, bnum); diff --git a/lib.h b/lib.h index 2167e642..8f4fae65 100644 --- a/lib.h +++ b/lib.h @@ -413,10 +413,12 @@ val gt(val anum, val bnum); val lt(val anum, val bnum); val ge(val anum, val bnum); val le(val anum, val bnum); +val numeq(val anum, val bnum); val gtv(val first, val rest); val ltv(val first, val rest); val gev(val first, val rest); val lev(val first, val rest); +val numeqv(val first, val rest); val max2(val anum, val bnum); val min2(val anum, val bnum); val maxv(val first, val rest); diff --git a/txr.1 b/txr.1 index 6f192f10..d104df86 100644 --- a/txr.1 +++ b/txr.1 @@ -6792,9 +6792,9 @@ The operands of +, - and * can be characters, integers (fixnum and bignum), and floats, in nearly any combination. If two operands have different types, then one of them is converted to the -type of the other, according to this ranking: character -> integer -> float. -For instance if one operand is integer, and the other float, the integer -is converted to a float. +type of the one with the higher rank, according to this ranking: +character < integer < float. For instance if one operand is integer, and the +other float, the integer is converted to a float. .TP Restrictions: @@ -6951,13 +6951,139 @@ Integer arguments are converted to floats. .SS Arithmetic functions expt, sqrt, isqrt +.TP +Syntax: + + (expt *) + (sqrt ) + (isqrt ) + +.TP +Description: + +The expt function raises a base to zero or more exponents. +(expt x) is equivalent to (expt x 1); and yields x for all x. +For three or more arguments, the operation is left associative. +That is to say, (expt x y z) is equivalent to (expt (expt x y) z) and +so forth. Exponentiation is done pairwise using a binary operation. +If both operands to this binary operation are integers, then the +result is an integer. If either operand is a float, then the other +operand is converted to a float, and a floating point exponentation +is performed. Exponentation that would produce a complex number is +not supported. + +The sqrt function produces a floating-point square root. The numeric +oeprand is converted from integer to floating-point if necessary. +Negative operands are not supported. + +The isqrt function computes an integer square root: a value which is the +greatest integer that is no greater than the true square root of the input +value. The input value must be an integer. + .SS Arithmetic function exptmod +.TP +Syntax: + + (exptmod ) + +.TP +Description: + +The exptmod function performs modular exponentiation and accepts only integer +arguments. Furthermore, the exponent must be a non-negative and the modulus +must be positive. + +The return value is the base raised to the exponent, and reduced to the +least positive residue modulo the modulus. + .SS Functions fixnump, bignump, integerp, floatp, numberp -.SS Functions zerop, evenp, oddp +.TP +Syntax: + + (fixnump ) + (bignump ) + (integerp ) + (floatp ) + (numberp ) + +.TP +Description: + +These functions test the type of the object, returning true if it is an object +of the implied type. The fixnump, bignump and floatp functions return true if +the object is of the basic type fixnum, bignum or float. +The function integerp returns true of the object is either a fixnum or +a bignum. The function numberp returns true if the object is either +a fixnum, bignum or float. + +.SS Function zerop + +.TP +Syntax: + + (zerop ) + +.TP +Description: + +The zerop function tests a number for equivalence to zero. The argument must be +a number. It returns t for the integer value 0, and for the floating-point +value 0.0. For other numbers, it returns nil. + +.SS Functions evenp, oddp + +.TP +Syntax: + + (evenp ) + (oddp ) + +.TP +Description: + +The evenp and oddp functions require integer arguments. evenp returns +t if the integer is even (divisible by two), otherwise it returns nil. +oddp returns t if the integer is nto divisible by two (odd), otherwise +it returns nil. + +.SS Relational functions >, <, >=, <= and = + +.TP +Syntax: + + (> *) + (< *) + (>= *) + (<= *) + (= *) + +.TP +Description: -.SS Relational functions >, <, >= and <= +The relational functions compare characters and numbers for numeric equality or +inequality. The arguments must be one or more numbers or characters. + +If a just one argument is given, then these functions all return t. + +If two arguments are given, then, they are compared as follows. +First, if the numbers do not have the same type, then the one +which has the lower ranking type is converted to the type of +the other, according to this ranking: character < integer < float. +For instance if a character and integer is compared, the character +is converted to integer. Then a straightforward numeric comparison +is applied. + +Three or more arguments may be given, in which case the comparison proceeds +pairwise from left to right. For instance in (< a b c), the comparison (< a b) +is performed in isolation. If it yields false, then nil is returned, otherwise +the comparison (< b c) is performed in isolation, and if that yields false, nil +is returned, otherwise t is returned. Note that it is possible for b to +undergo two different conversions. For instance in (< +), the character will convert to a floating-point representation of +its Unicode, and if that comparison suceeds, then in the second comparison, the +character will convert to integer. .SS Functions max and min diff --git a/txr.vim b/txr.vim index 42a086f2..56b4283d 100644 --- a/txr.vim +++ b/txr.vim @@ -47,7 +47,7 @@ syn keyword txl_keyword contained expt exptmod sqrt isqrt gcd syn keyword txl_keyword contained floor ceil sin cos tan asin acos atan log exp syn keyword txl_keyword contained fixnump bignump integerp floatp syn keyword txl_keyword contained numberp zerop evenp oddp > -syn keyword txl_keyword contained zerop evenp oddp > < >= <= max min +syn keyword txl_keyword contained zerop evenp oddp > < >= <= = max min syn keyword txl_keyword contained search-regex match-regex regsub syn keyword txl_keyword contained make-hash hash hash-construct gethash sethash pushhash remhash syn keyword txl_keyword contained hash-count get-hash-userdata set-hash-userdata hashp maphash -- cgit v1.2.3