diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2012-03-29 21:41:49 -0700 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2012-03-29 21:41:49 -0700 |
commit | 8b8ca2e793f90aa58d7430b8f060c467cd41ec1b (patch) | |
tree | 322203f975cfb3b66c67252791bb0ba987253923 | |
parent | 2b1e05769d01cb036cf0a82231eb87b698a33426 (diff) | |
download | txr-8b8ca2e793f90aa58d7430b8f060c467cd41ec1b.tar.gz txr-8b8ca2e793f90aa58d7430b8f060c467cd41ec1b.tar.bz2 txr-8b8ca2e793f90aa58d7430b8f060c467cd41ec1b.zip |
* 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 =
-rw-r--r-- | ChangeLog | 18 | ||||
-rw-r--r-- | arith.c | 43 | ||||
-rw-r--r-- | eval.c | 1 | ||||
-rw-r--r-- | lib.c | 14 | ||||
-rw-r--r-- | lib.h | 2 | ||||
-rw-r--r-- | txr.1 | 136 | ||||
-rw-r--r-- | txr.vim | 2 |
7 files changed, 208 insertions, 8 deletions
@@ -1,5 +1,23 @@ 2012-03-29 Kaz Kylheku <kaz@kylheku.com> + * 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 <kaz@kylheku.com> + * arith.c (gcd): Allow zeros. Don't issue "non-integral" exception if MPI fails. (floorf, ceili): Map integer argument to itself. @@ -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) @@ -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)); @@ -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); @@ -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); @@ -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 <base> <exponent>*) + (sqrt <number>) + (isqrt <integer>) + +.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 <base> <exponent> <modulus>) + +.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 <object>) + (bignump <object>) + (integerp <object>) + (floatp <object>) + (numberp <object>) + +.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 <number>) + +.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 <integer>) + (oddp <integer>) + +.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: + + (> <number> <number>*) + (< <number> <number>*) + (>= <number> <number>*) + (<= <number> <number>*) + (= <number> <number>*) + +.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 (< <float> <character> +<integer>), 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 @@ -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 |