*/ REBDEC Dec64(REBVAL *val)
/*
***********************************************************************/
{
if (IS_DECIMAL(val) || IS_PERCENT(val)) return VAL_DECIMAL(val);
if (IS_INTEGER(val)) return (REBDEC)VAL_INT64(val);
if (IS_MONEY(val)) return deci_to_decimal(VAL_DECI(val));
Trap_Arg(val);
return 0;
}
//
// Dec64: C
//
REBDEC Dec64(const REBVAL *val)
{
if (IS_DECIMAL(val) || IS_PERCENT(val))
return VAL_DECIMAL(val);
if (IS_INTEGER(val))
return cast(REBDEC, VAL_INT64(val));
if (IS_MONEY(val))
return deci_to_decimal(VAL_MONEY_AMOUNT(val));
fail (Error_Invalid_Arg(val));
}
//
// MAKE_Decimal: C
//
void MAKE_Decimal(REBVAL *out, enum Reb_Kind kind, const REBVAL *arg) {
REBDEC d;
switch (VAL_TYPE(arg)) {
case REB_DECIMAL:
d = VAL_DECIMAL(arg);
goto dont_divide_if_percent;
case REB_PERCENT:
d = VAL_DECIMAL(arg);
goto dont_divide_if_percent;
case REB_INTEGER:
d = cast(REBDEC, VAL_INT64(arg));
goto dont_divide_if_percent;
case REB_MONEY:
d = deci_to_decimal(VAL_MONEY_AMOUNT(arg));
goto dont_divide_if_percent;
case REB_LOGIC:
d = VAL_LOGIC(arg) ? 1.0 : 0.0;
goto dont_divide_if_percent;
case REB_CHAR:
d = cast(REBDEC, VAL_CHAR(arg));
goto dont_divide_if_percent;
case REB_TIME:
d = VAL_TIME(arg) * NANO;
break;
case REB_STRING:
{
REBYTE *bp;
REBCNT len;
bp = Temp_Byte_Chars_May_Fail(arg, MAX_SCAN_DECIMAL, &len, FALSE);
VAL_RESET_HEADER(out, kind);
if (!Scan_Decimal(
&d, bp, len, LOGICAL(kind != REB_PERCENT)
)) {
goto bad_make;
}
break;
}
case REB_BINARY:
Binary_To_Decimal(arg, out);
VAL_RESET_HEADER(out, kind);
d = VAL_DECIMAL(out);
break;
#ifdef removed
// case REB_ISSUE:
{
REBYTE *bp;
REBCNT len;
bp = Temp_Byte_Chars_May_Fail(arg, MAX_HEX_LEN, &len, FALSE);
if (Scan_Hex(&VAL_INT64(out), bp, len, len) == 0)
fail (Error_Bad_Make(REB_DECIMAL, val));
d = VAL_DECIMAL(out);
break;
}
#endif
default:
if (ANY_ARRAY(arg) && VAL_ARRAY_LEN_AT(arg) == 2) {
RELVAL *item = VAL_ARRAY_AT(arg);
if (IS_INTEGER(item))
d = cast(REBDEC, VAL_INT64(item));
else if (IS_DECIMAL(item) || IS_PERCENT(item))
d = VAL_DECIMAL(item);
else {
REBVAL specific;
COPY_VALUE(&specific, item, VAL_SPECIFIER(arg));
fail (Error_Invalid_Arg(&specific));
}
++item;
REBDEC exp;
if (IS_INTEGER(item))
exp = cast(REBDEC, VAL_INT64(item));
else if (IS_DECIMAL(item) || IS_PERCENT(item))
exp = VAL_DECIMAL(item);
else {
REBVAL specific;
COPY_VALUE(&specific, item, VAL_SPECIFIER(arg));
fail (Error_Invalid_Arg(&specific));
}
while (exp >= 1) {
//
// !!! Comment here said "funky. There must be a better way"
//
--exp;
d *= 10.0;
if (!FINITE(d))
fail (Error(RE_OVERFLOW));
}
while (exp <= -1) {
++exp;
d /= 10.0;
}
}
else
fail (Error_Bad_Make(kind, arg));
}
if (kind == REB_PERCENT)
d /= 100.0;
dont_divide_if_percent:
if (!FINITE(d))
fail (Error(RE_OVERFLOW));
VAL_RESET_HEADER(out, kind);
VAL_DECIMAL(out) = d;
return;
bad_make:
fail (Error_Bad_Make(kind, arg));
}
//
// Cmp_Value: C
//
// Compare two values and return the difference.
//
// is_case TRUE for case sensitive compare
//
REBINT Cmp_Value(const RELVAL *s, const RELVAL *t, REBOOL is_case)
{
REBDEC d1, d2;
if (VAL_TYPE(t) != VAL_TYPE(s) && !(ANY_NUMBER(s) && ANY_NUMBER(t)))
return VAL_TYPE(s) - VAL_TYPE(t);
assert(NOT_END(s) && NOT_END(t));
switch(VAL_TYPE(s)) {
case REB_INTEGER:
if (IS_DECIMAL(t)) {
d1 = (REBDEC)VAL_INT64(s);
d2 = VAL_DECIMAL(t);
goto chkDecimal;
}
return THE_SIGN(VAL_INT64(s) - VAL_INT64(t));
case REB_LOGIC:
return VAL_LOGIC(s) - VAL_LOGIC(t);
case REB_CHAR:
if (is_case) return THE_SIGN(VAL_CHAR(s) - VAL_CHAR(t));
return THE_SIGN((REBINT)(UP_CASE(VAL_CHAR(s)) - UP_CASE(VAL_CHAR(t))));
case REB_PERCENT:
case REB_DECIMAL:
case REB_MONEY:
if (IS_MONEY(s))
d1 = deci_to_decimal(VAL_MONEY_AMOUNT(s));
else
d1 = VAL_DECIMAL(s);
if (IS_INTEGER(t))
d2 = cast(REBDEC, VAL_INT64(t));
else if (IS_MONEY(t))
d2 = deci_to_decimal(VAL_MONEY_AMOUNT(t));
else
d2 = VAL_DECIMAL(t);
chkDecimal:
if (Eq_Decimal(d1, d2))
return 0;
if (d1 < d2)
return -1;
return 1;
case REB_PAIR:
return Cmp_Pair(s, t);
case REB_EVENT:
return Cmp_Event(s, t);
case REB_GOB:
return Cmp_Gob(s, t);
case REB_TUPLE:
return Cmp_Tuple(s, t);
case REB_TIME:
return Cmp_Time(s, t);
case REB_DATE:
return Cmp_Date(s, t);
case REB_BLOCK:
case REB_GROUP:
case REB_MAP:
case REB_PATH:
case REB_SET_PATH:
case REB_GET_PATH:
case REB_LIT_PATH:
return Cmp_Array(s, t, is_case);
case REB_STRING:
case REB_FILE:
case REB_EMAIL:
case REB_URL:
case REB_TAG:
return Compare_String_Vals(s, t, NOT(is_case));
case REB_BITSET:
case REB_BINARY:
case REB_IMAGE:
return Compare_Binary_Vals(s, t);
case REB_VECTOR:
return Compare_Vector(s, t);
case REB_DATATYPE:
return VAL_TYPE_KIND(s) - VAL_TYPE_KIND(t);
case REB_WORD:
case REB_SET_WORD:
case REB_GET_WORD:
case REB_LIT_WORD:
case REB_REFINEMENT:
case REB_ISSUE:
return Compare_Word(s,t,is_case);
case REB_ERROR:
return VAL_ERR_NUM(s) - VAL_ERR_NUM(t);
case REB_OBJECT:
case REB_MODULE:
case REB_PORT:
return VAL_CONTEXT(s) - VAL_CONTEXT(t);
case REB_FUNCTION:
return VAL_FUNC_PARAMLIST(s) - VAL_FUNC_PARAMLIST(t);
case REB_LIBRARY:
return VAL_LIBRARY(s) - VAL_LIBRARY(t);
case REB_STRUCT:
return Cmp_Struct(s, t);
case REB_BLANK:
case REB_MAX_VOID:
default:
break;
}
return 0;
}
