From 45fe65bb4305b896ac95bfa70c3273662e8e44f1 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Sat, 7 Feb 2015 19:58:38 -0800 Subject: * arith.c (trunc_rem): New function. * eval.c (eval_init): Register trunc-rem intrinsic. * lib.h (trunc_rem): Declared. * txr.1: Documented trunc-rem. * tl.vim, txr.vim: Updated. --- ChangeLog | 12 ++++++++++++ arith.c | 7 +++++++ eval.c | 1 + lib.h | 1 + tl.vim | 20 ++++++++++---------- txr.1 | 22 +++++++++++++++++++++- txr.vim | 20 ++++++++++---------- 7 files changed, 62 insertions(+), 21 deletions(-) diff --git a/ChangeLog b/ChangeLog index 629da96e..5ed01bd9 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,15 @@ +2015-02-07 Kaz Kylheku + + * arith.c (trunc_rem): New function. + + * eval.c (eval_init): Register trunc-rem intrinsic. + + * lib.h (trunc_rem): Declared. + + * txr.1: Documented trunc-rem. + + * tl.vim, txr.vim: Updated. + 2015-02-07 Kaz Kylheku * Makefile (CFLAGS): Removed puzzling, unnecessary definitions diff --git a/arith.c b/arith.c index 20d1ae3b..9aeb0875 100644 --- a/arith.c +++ b/arith.c @@ -945,6 +945,13 @@ divzero: uw_throw(numeric_error_s, lit("mod: division by zero")); } +val trunc_rem(val anum, val bnum) +{ + val quot = trunc(anum, bnum); + val rem = minus(anum, mul(quot, bnum)); + return list(quot, rem, nao); +} + val wrap_star(val start, val end, val num) { val modulus = minus(end, start); diff --git a/eval.c b/eval.c index 056f4b68..7f8f746f 100644 --- a/eval.c +++ b/eval.c @@ -3846,6 +3846,7 @@ void eval_init(void) reg_fun(intern(lit("abs"), user_package), func_n1(abso)); reg_fun(intern(lit("trunc"), user_package), func_n2(trunc)); reg_fun(intern(lit("mod"), user_package), func_n2(mod)); + reg_fun(intern(lit("trunc-rem"), user_package), func_n2(trunc_rem)); reg_fun(intern(lit("wrap"), user_package), func_n3(wrap)); reg_fun(intern(lit("wrap*"), user_package), func_n3(wrap_star)); reg_fun(intern(lit("/"), user_package), func_n2o(divi, 1)); diff --git a/lib.h b/lib.h index 984dd851..2ce36aaf 100644 --- a/lib.h +++ b/lib.h @@ -544,6 +544,7 @@ val mul(val anum, val bnum); val mulv(val nlist); val trunc(val anum, val bnum); val mod(val anum, val bnum); +val trunc_rem(val anum, val bnum); val wrap_star(val start, val end, val num); val wrap(val start, val end, val num); val divi(val anum, val bnum); diff --git a/tl.vim b/tl.vim index 402fc22b..057dcad2 100644 --- a/tl.vim +++ b/tl.vim @@ -181,16 +181,16 @@ syn keyword txl_keyword contained time-usec tofloat toint tok-str syn keyword txl_keyword contained tok-where tostring tostringp transpose syn keyword txl_keyword contained tree-bind tree-case tree-find trie-add syn keyword txl_keyword contained trie-compress trie-lookup-begin trie-lookup-feed-char trie-value-at -syn keyword txl_keyword contained trim-str true trunc tuples -syn keyword txl_keyword contained txr-case txr-if txr-when typeof -syn keyword txl_keyword contained unget-byte unget-char uniq unique -syn keyword txl_keyword contained unless unquote until upcase-str -syn keyword txl_keyword contained update url-decode url-encode usleep -syn keyword txl_keyword contained uw-protect vec vec-push vec-set-length -syn keyword txl_keyword contained vecref vector vector-list vectorp -syn keyword txl_keyword contained when where while width -syn keyword txl_keyword contained with-saved-vars wrap wrap* zerop -syn keyword txl_keyword contained zip +syn keyword txl_keyword contained trim-str true trunc trunc-rem +syn keyword txl_keyword contained tuples txr-case txr-if txr-when +syn keyword txl_keyword contained typeof unget-byte unget-char uniq +syn keyword txl_keyword contained unique unless unquote until +syn keyword txl_keyword contained upcase-str update url-decode url-encode +syn keyword txl_keyword contained usleep uw-protect vec vec-push +syn keyword txl_keyword contained vec-set-length vecref vector vector-list +syn keyword txl_keyword contained vectorp when where while +syn keyword txl_keyword contained width with-saved-vars wrap wrap* +syn keyword txl_keyword contained zerop zip syn match txr_metanum "@[0-9]\+" syn match txr_nested_error "[^\t `]\+" contained diff --git a/txr.1 b/txr.1 index 2c467d22..b81fc0b1 100644 --- a/txr.1 +++ b/txr.1 @@ -18250,11 +18250,12 @@ A character may not be an operand of multiplication. .PP -.coNP Functions @, / @ trunc and @ mod +.coNP Functions @, / @ trunc, @ mod and @ trunc-rem .synb .mets (/ <> [ dividend ] << divisor ) .mets (trunc < dividend << divisor ) .mets (mod < dividend << divisor ) +.mets (trunc-rem < dividend << divisor ) .syne .desc The arguments to these functions are numbers. Characters are not permitted. @@ -18308,6 +18309,25 @@ then generalized into the floating point domain. For instance the expression yields a residue of 0.25 because 0.5 "goes into" 0.75 only once, with a "remainder" of 0.25. +The +.code trunc-rem +function returns a list of two values: a +.meta quotient +and a +.metn remainder. +The +.meta quotient +is exactly the same value as what +.code trunc +would return for the same inputs. +The +.meta remainder +obeys the following identity: + +.cblk +.mets (eql < remainder (- < dividend >> (* divisor << quotient ))) +.cble + .coNP Functions @ wrap and @ wrap* .synb .mets (wrap < start < end << number ) diff --git a/txr.vim b/txr.vim index 97c0b2e2..82fb22fc 100644 --- a/txr.vim +++ b/txr.vim @@ -181,16 +181,16 @@ syn keyword txl_keyword contained time-usec tofloat toint tok-str syn keyword txl_keyword contained tok-where tostring tostringp transpose syn keyword txl_keyword contained tree-bind tree-case tree-find trie-add syn keyword txl_keyword contained trie-compress trie-lookup-begin trie-lookup-feed-char trie-value-at -syn keyword txl_keyword contained trim-str true trunc tuples -syn keyword txl_keyword contained txr-case txr-if txr-when typeof -syn keyword txl_keyword contained unget-byte unget-char uniq unique -syn keyword txl_keyword contained unless unquote until upcase-str -syn keyword txl_keyword contained update url-decode url-encode usleep -syn keyword txl_keyword contained uw-protect vec vec-push vec-set-length -syn keyword txl_keyword contained vecref vector vector-list vectorp -syn keyword txl_keyword contained when where while width -syn keyword txl_keyword contained with-saved-vars wrap wrap* zerop -syn keyword txl_keyword contained zip +syn keyword txl_keyword contained trim-str true trunc trunc-rem +syn keyword txl_keyword contained tuples txr-case txr-if txr-when +syn keyword txl_keyword contained typeof unget-byte unget-char uniq +syn keyword txl_keyword contained unique unless unquote until +syn keyword txl_keyword contained upcase-str update url-decode url-encode +syn keyword txl_keyword contained usleep uw-protect vec vec-push +syn keyword txl_keyword contained vec-set-length vecref vector vector-list +syn keyword txl_keyword contained vectorp when where while +syn keyword txl_keyword contained width with-saved-vars wrap wrap* +syn keyword txl_keyword contained zerop zip syn keyword txr_keyword contained accept all and assert syn keyword txr_keyword contained bind block cases cat -- cgit v1.2.3