diff --git a/moo/kernel/Collect.moo b/moo/kernel/Collect.moo index abe2615..b57218e 100644 --- a/moo/kernel/Collect.moo +++ b/moo/kernel/Collect.moo @@ -92,6 +92,24 @@ class SequenceableCollection(Collection) { (self size - 1) to: 0 by: -1 do: [:i | aBlock value: (self at: i)]. } + + method doWithIndex: aBlock + { + + 0 to: (self size - 1) do: [:i | aBlock value: (self at: i) value: i]. + } + + method from: startIndex to: stopIndex do: aBlock + { + + startIndex to: stopIndex do: [:i | aBlock value: (self at: i)]. + } + + method from: startIndex to: stopIndex doWithIndex: aBlock + { + + startIndex to: stopIndex do: [:i | aBlock value: (self at: i) value: i]. + } } ## ------------------------------------------------------------------------------- diff --git a/moo/kernel/Magnitu.moo b/moo/kernel/Magnitu.moo index 75088cc..37c8011 100644 --- a/moo/kernel/Magnitu.moo +++ b/moo/kernel/Magnitu.moo @@ -148,7 +148,7 @@ class(#limited) Number(Magnitude) method rem: aNumber { ## integer remainder rounded toward zero - + self primitiveFailed. } @@ -162,7 +162,7 @@ class(#limited) Number(Magnitude) method mod: aNumber { ## integer division remainder - + self primitiveFailed. } @@ -215,31 +215,31 @@ class(#limited) Number(Magnitude) method bitAt: index { - + ^(self bitShift: index negated) bitAnd: 1. } method bitAnd: aNumber { - + self primitiveFailed. } method bitOr: aNumber { - + self primitiveFailed. } method bitXor: aNumber { - + self primitiveFailed. } method bitInvert { - + ^-1 - self. } @@ -248,7 +248,7 @@ class(#limited) Number(Magnitude) (* positive number for left shift. * negative number for right shift *) - + self primitiveFailed. } @@ -374,6 +374,12 @@ class(#limited) Integer(Number) } method asInteger { ^self } + + ## integer has the scale of 0. + method scale { ^0 } + + ## non-zero positive scale converts integer to fixed-point decimal + method(#primitive) scale: ndigits. } class(#limited) SmallInteger(Integer) @@ -400,5 +406,8 @@ class(#limited,#immutable,#liword) LargeNegativeInteger(LargeInteger) class(#limited,#immutable) FixedPointDecimal(Number) { - var value, scale. + var value. + var(#get) scale. + + method(#primitive) scale: ndigits. } diff --git a/moo/kernel/test-001.moo b/moo/kernel/test-001.moo index 832d97b..6879601 100644 --- a/moo/kernel/test-001.moo +++ b/moo/kernel/test-001.moo @@ -220,6 +220,19 @@ extend MyObject [ (10.12 mlt: 20.345) = 205.89 ], [ (-123897128378912738912738917.112323131233 div: 123.1) = -1006475453931053931053931.089458352000 ], [ (-1006475453931053931053931.089458352000 * 123.1) = -123897128378912738912738917.112323131200 ], + [ 10 scale = 0 ], + + ## 70-74 + [ 10.0 scale = 1 ], + [ 10.00 scale = 2 ], + [ (10 scale: 1) = 10.0 ], + [ (10 scale: 1) scale = (10.1 scale) ], + [ (10 scale: 2) scale = (10.11 scale) ], + + ## 75-79 + [ ((10.19 scale: 3) scale) = (10.199 scale) ], + [ ((10.19 scale: 0) scale) = (10 scale) ], + [ | b | diff --git a/moo/kernel/test-003.moo b/moo/kernel/test-003.moo index 28fb155..89ebce2 100644 --- a/moo/kernel/test-003.moo +++ b/moo/kernel/test-003.moo @@ -21,6 +21,35 @@ class MyObject(Object) t1 := t1 + 1. ^self xxxx. } + method(#class) test1 + { + #### TODO: add this to the test case list. + | rec results | + + ##rec := [ :y :z | (108.0000000000000000000000 - (815.000000000000000000 - (1500.0000000000000000 div: z) div: y)) truncate: 18. ]. + ##rec := [ :y :z | (108.0000000000000000000000 - (815.000000000000000000 - (1500.0000000000000000 div: z) div: y)) truncate: 16. ]. + ##rec := [ :y :z | 108.0000000000000000000000 - (815.000000000000000000 - (1500.0000000000000000 div: z) div: y) ]. + rec := [ :y :z | (108.0 scale: 22) - ((815 scale: 18) - ((1500 scale: 16) div: z) div: y) ]. + ##rec := [ :y :z | 108.000000000000000000000000000000 - (815.00000000000000000000000000 - (1500.0000000000000000 div: z) div: y) ]. + + + ## results := %( 4.0, 425 div: 100.0 ) asOrderedCollection. + results := OrderedCollection new. + results add: 4.0; add: (425.00 div: 100.00). + + + 3 to: 100 do: [ :i | +##(results at: i - 2) dump. +##(results at: i - 3) dump. +##'----------' dump. + results add: (rec value: (results at: i - 2) value: (results at: i - 3)). + ]. + + results doWithIndex: [ :each :i | + System log: (i asString); log: "\t"; + log: each; logNl: "". + ]. + } method(#class) main { diff --git a/moo/lib/bigint.c b/moo/lib/bigint.c index 0a7a1d8..da06375 100644 --- a/moo/lib/bigint.c +++ b/moo/lib/bigint.c @@ -2027,7 +2027,7 @@ moo_oop_t moo_divints (moo_t* moo, moo_oop_t x, moo_oop_t y, int modulo, moo_oop } moo_pushvolat (moo, &y); - x = make_bigint_with_ooi (moo, v); + x = make_bigint_with_ooi(moo, v); moo_popvolat (moo); if (!x) return MOO_NULL; } @@ -2045,14 +2045,14 @@ moo_oop_t moo_divints (moo_t* moo, moo_oop_t x, moo_oop_t y, int modulo, moo_oop return MOO_NULL; case 1: - z = clone_bigint (moo, x, MOO_OBJ_GET_SIZE(x)); + z = clone_bigint(moo, x, MOO_OBJ_GET_SIZE(x)); if (!z) return MOO_NULL; if (rem) *rem = MOO_SMOOI_TO_OOP(0); return z; case -1: - z = clone_bigint_negated (moo, x, MOO_OBJ_GET_SIZE(x)); + z = clone_bigint_negated(moo, x, MOO_OBJ_GET_SIZE(x)); if (!z) return MOO_NULL; if (rem) *rem = MOO_SMOOI_TO_OOP(0); return z; @@ -2072,7 +2072,7 @@ moo_oop_t moo_divints (moo_t* moo, moo_oop_t x, moo_oop_t y, int modulo, moo_oop } moo_pushvolat (moo, &x); - y = make_bigint_with_ooi (moo, v); + y = make_bigint_with_ooi(moo, v); moo_popvolat (moo); if (!y) return MOO_NULL; } @@ -2088,7 +2088,7 @@ moo_oop_t moo_divints (moo_t* moo, moo_oop_t x, moo_oop_t y, int modulo, moo_oop moo_pushvolat (moo, &x); moo_pushvolat (moo, &y); - z = divide_unsigned_integers (moo, x, y, &r); + z = divide_unsigned_integers(moo, x, y, &r); moo_popvolats (moo, 2); if (!z) return MOO_NULL; @@ -2115,17 +2115,17 @@ moo_oop_t moo_divints (moo_t* moo, moo_oop_t x, moo_oop_t y, int modulo, moo_oop { moo_pushvolat (moo, &z); moo_pushvolat (moo, &y); - r = moo_addints (moo, r, y); + r = moo_addints(moo, r, y); moo_popvolats (moo, 2); if (!r) return MOO_NULL; moo_pushvolat (moo, &r); - z = normalize_bigint (moo, z); + z = normalize_bigint(moo, z); moo_popvolat (moo); if (!z) return MOO_NULL; moo_pushvolat (moo, &r); - z = moo_subints (moo, z, MOO_SMOOI_TO_OOP(1)); + z = moo_subints(moo, z, MOO_SMOOI_TO_OOP(1)); moo_popvolat (moo); if (!z) return MOO_NULL; @@ -2138,20 +2138,20 @@ moo_oop_t moo_divints (moo_t* moo, moo_oop_t x, moo_oop_t y, int modulo, moo_oop /* TODO: subtract 1 without normalization??? */ z = normalize_bigint (moo, z); if (!z) return MOO_NULL; - return moo_subints (moo, z, MOO_SMOOI_TO_OOP(1)); + return moo_subints(moo, z, MOO_SMOOI_TO_OOP(1)); } } } else { moo_pushvolat (moo, &z); - r = normalize_bigint (moo, r); + r = normalize_bigint(moo, r); moo_popvolat (moo); if (!r) return MOO_NULL; } if (rem) *rem = r; - return normalize_bigint (moo, z); + return normalize_bigint(moo, z); oops_einval: moo_seterrbfmt (moo, MOO_EINVAL, "invalid parameters - %O, %O", x, y); diff --git a/moo/lib/exec.c b/moo/lib/exec.c index 973b808..3036d11 100644 --- a/moo/lib/exec.c +++ b/moo/lib/exec.c @@ -2820,6 +2820,27 @@ static moo_pfrc_t pf_system_return_value_to_context (moo_t* moo, moo_mod_t* mod, return MOO_PF_SUCCESS; } +/* ------------------------------------------------------------------ */ +static moo_pfrc_t pf_number_scale (moo_t* moo, moo_mod_t* mod, moo_ooi_t nargs) +{ + moo_oop_t rcv, arg, res; + + rcv = MOO_STACK_GETRCV(moo, nargs); + arg = MOO_STACK_GETARG(moo, nargs, 0); + + if (!MOO_OOP_IS_SMOOI(arg)) + { + moo_seterrbfmt (moo, MOO_EINVAL, "invalid scale - %O", arg); + return MOO_PF_FAILURE; + } + + res = moo_truncfpdec(moo, rcv, MOO_OOP_TO_SMOOI(arg)); + if (!res) return (moo->errnum == MOO_EINVAL? MOO_PF_FAILURE: MOO_PF_HARD_FAILURE); + + MOO_STACK_SETRET (moo, nargs, res); + return MOO_PF_SUCCESS; +} + /* ------------------------------------------------------------------ */ static moo_pfrc_t pf_number_add (moo_t* moo, moo_mod_t* mod, moo_ooi_t nargs) @@ -3779,7 +3800,32 @@ static pf_t pftab[] = { "Error_asInteger", { pf_error_as_integer, 0, 0 } }, { "Error_asString", { pf_error_as_string, 0, 0 } }, - { "MethodContext_goto:", { pf_context_goto, 1, 1 } }, + { "FixedPointDecimal_scale:", { pf_number_scale, 1, 1 } }, + + { "Integer_add", { pf_integer_add, 1, 1 } }, + { "Integer_bitand", { pf_integer_bitand, 1, 1 } }, + { "Integer_bitat", { pf_integer_bitat, 1, 1 } }, + { "Integer_bitinv", { pf_integer_bitinv, 0, 0 } }, + { "Integer_bitor", { pf_integer_bitor, 1, 1 } }, + { "Integer_bitshift", { pf_integer_bitshift, 1, 1 } }, + { "Integer_bitxor", { pf_integer_bitxor, 1, 1 } }, + { "Integer_div", { pf_integer_div, 1, 1 } }, + { "Integer_eq", { pf_integer_eq, 1, 1 } }, + { "Integer_ge", { pf_integer_ge, 1, 1 } }, + { "Integer_gt", { pf_integer_gt, 1, 1 } }, + { "Integer_inttostr", { pf_integer_inttostr, 1, 1 } }, + { "Integer_le", { pf_integer_le, 1, 1 } }, + { "Integer_lt", { pf_integer_lt, 1, 1 } }, + { "Integer_mdiv", { pf_integer_mdiv, 1, 1 } }, + { "Integer_mod", { pf_integer_mod, 1, 1 } }, + { "Integer_mul", { pf_integer_mul, 1, 1 } }, + { "Integer_ne", { pf_integer_ne, 1, 1 } }, + { "Integer_negated", { pf_integer_negated, 0, 0 } }, + { "Integer_rem", { pf_integer_rem, 1, 1 } }, + { "Integer_scale:", { pf_number_scale, 1, 1 } }, + { "Integer_sub", { pf_integer_sub, 1, 1 } }, + + { "MethodContext_goto:", { pf_context_goto, 1, 1 } }, { "Process_resume", { pf_process_resume, 0, 0 } }, { "Process_sp", { pf_process_sp, 0, 0 } }, @@ -3859,28 +3905,6 @@ static pf_t pftab[] = { "_dump", { pf_dump, 0, MA } }, - { "_integer_add", { pf_integer_add, 1, 1 } }, - { "_integer_bitand", { pf_integer_bitand, 1, 1 } }, - { "_integer_bitat", { pf_integer_bitat, 1, 1 } }, - { "_integer_bitinv", { pf_integer_bitinv, 0, 0 } }, - { "_integer_bitor", { pf_integer_bitor, 1, 1 } }, - { "_integer_bitshift", { pf_integer_bitshift, 1, 1 } }, - { "_integer_bitxor", { pf_integer_bitxor, 1, 1 } }, - { "_integer_div", { pf_integer_div, 1, 1 } }, - { "_integer_eq", { pf_integer_eq, 1, 1 } }, - { "_integer_ge", { pf_integer_ge, 1, 1 } }, - { "_integer_gt", { pf_integer_gt, 1, 1 } }, - { "_integer_inttostr", { pf_integer_inttostr, 1, 1 } }, - { "_integer_le", { pf_integer_le, 1, 1 } }, - { "_integer_lt", { pf_integer_lt, 1, 1 } }, - { "_integer_mdiv", { pf_integer_mdiv, 1, 1 } }, - { "_integer_mod", { pf_integer_mod, 1, 1 } }, - { "_integer_mul", { pf_integer_mul, 1, 1 } }, - { "_integer_ne", { pf_integer_ne, 1, 1 } }, - { "_integer_negated", { pf_integer_negated, 0, 0 } }, - { "_integer_rem", { pf_integer_rem, 1, 1 } }, - { "_integer_sub", { pf_integer_sub, 1, 1 } }, - { "_number_add", { pf_number_add, 1, 1 } }, { "_number_div", { pf_number_div, 1, 1 } }, { "_number_eq", { pf_number_eq, 1, 1 } }, @@ -3894,6 +3918,7 @@ static pf_t pftab[] = { "_number_ne", { pf_number_ne, 1, 1 } }, { "_number_negated", { pf_number_negated, 0, 0 } }, { "_number_numtostr", { pf_number_numtostr, 1, 1 } }, + { "_number_scale:", { pf_number_scale, 1, 1 } }, { "_number_sub", { pf_number_sub, 1, 1 } }, { "_utf8_seqlen", { moo_pf_utf8_seqlen, 0, 0 } }, diff --git a/moo/lib/moo-prv.h b/moo/lib/moo-prv.h index 443f5ed..36cc427 100644 --- a/moo/lib/moo-prv.h +++ b/moo/lib/moo-prv.h @@ -1372,6 +1372,12 @@ moo_oop_t moo_truncfpdecval ( moo_ooi_t ns /* new scale */ ); +moo_oop_t moo_truncfpdec ( + moo_t* moo, + moo_oop_t iv, /* integer */ + moo_ooi_t ns /* new scale */ +); + moo_oop_t moo_addnums ( moo_t* moo, moo_oop_t x, diff --git a/moo/lib/number.c b/moo/lib/number.c index 4ed438b..fba82c9 100644 --- a/moo/lib/number.c +++ b/moo/lib/number.c @@ -121,8 +121,9 @@ static moo_ooi_t equalize_scale (moo_t* moo, moo_oop_t* x, moo_oop_t* y) moo_oop_t moo_truncfpdecval (moo_t* moo, moo_oop_t iv, moo_ooi_t cs, moo_ooi_t ns) { - /* this function truncates an existing fixed-point decimal. - * it doesn't create a new object */ + /* this function truncates an existing fixed-point decimal value only if + * the existing scale is greater than the new scale given. + * [NOTE] this doesn't work on the fpdec object. */ if (cs > ns) { @@ -139,6 +140,60 @@ moo_oop_t moo_truncfpdecval (moo_t* moo, moo_oop_t iv, moo_ooi_t cs, moo_ooi_t n return iv; } +moo_oop_t moo_truncfpdec (moo_t* moo, moo_oop_t x, moo_ooi_t ns) +{ + moo_oop_t xv; + moo_ooi_t cs; + + if (MOO_OOP_IS_FPDEC(moo, x)) + { + xv = ((moo_oop_fpdec_t)x)->value; + cs = MOO_OOP_TO_SMOOI(((moo_oop_fpdec_t)x)->scale); + } + else if (moo_isint(moo, x)) + { + /* this accepts an integer unlike the function name implies */ + xv = x; + cs = 0; + } + else + { + moo_seterrbfmt (moo, MOO_EINVAL, "parameter not fpdec - %O", x); + return MOO_NULL; + } + + if (ns < 0) ns = 0; + if (cs == ns) return x; /* no change needed */ + + if (cs > ns) + { + /* same as moo_truncfpdecval() */ + do + { + /* TODO: optimization... less divisions */ + xv = moo_divints(moo, xv, MOO_SMOOI_TO_OOP(10), 0, MOO_NULL); + if (!xv) return MOO_NULL; + cs--; + } + while (cs > ns); + } + else /*if (cs < ns)*/ + { + do + { + xv = moo_mulints(moo, xv, MOO_SMOOI_TO_OOP(10)); + if (!xv) return MOO_NULL; + cs++; + } + while (cs < ns); + } + + /* moo_makefpdec returns xv if ns <= 0. so it's safe to call it + * without checks against the 'ns <= 0' condition. + * setting ns to 0 or less will converts a decimal to an integer */ + return moo_makefpdec(moo, xv, ns); +} + moo_oop_t moo_addnums (moo_t* moo, moo_oop_t x, moo_oop_t y) { if (!MOO_OOP_IS_FPDEC(moo, x) && !MOO_OOP_IS_FPDEC(moo, y))