//
// Int32s: C
//
// Get integer as positive, negative 32 bit value.
// Sign field can be
// 0: >= 0
// 1: > 0
// -1: < 0
//
REBINT Int32s(const REBVAL *val, REBINT sign)
{
REBINT n = 0;
if (IS_DECIMAL(val)) {
if (VAL_DECIMAL(val) > MAX_I32 || VAL_DECIMAL(val) < MIN_I32)
fail (Error_Out_Of_Range(val));
n = (REBINT)VAL_DECIMAL(val);
} else {
if (VAL_INT64(val) > (i64)MAX_I32 || VAL_INT64(val) < (i64)MIN_I32)
fail (Error_Out_Of_Range(val));
n = VAL_INT32(val);
}
// More efficient to use positive sense:
if (
(sign == 0 && n >= 0) ||
(sign > 0 && n > 0) ||
(sign < 0 && n < 0)
)
return n;
fail (Error_Out_Of_Range(val));
}
*/ REBI64 Int64s(REBVAL *val, REBINT sign)
/*
** Get integer as positive, negative 64 bit value.
** Sign field can be
** 0: >= 0
** 1: > 0
** -1: < 0
**
***********************************************************************/
{
REBI64 n;
if (IS_DECIMAL(val)) {
if (VAL_DECIMAL(val) > MAX_I64 || VAL_DECIMAL(val) < MIN_I64)
Trap_Range(val);
n = (REBI64)VAL_DECIMAL(val);
} else {
n = VAL_INT64(val);
}
// More efficient to use positive sense:
if (
(sign == 0 && n >= 0) ||
(sign > 0 && n > 0) ||
(sign < 0 && n < 0)
)
return n;
Trap_Range(val);
DEAD_END;
}
//
// Partial1: C
//
// Process the /part (or /skip) and other length modifying
// arguments.
//
REBINT Partial1(REBVAL *sval, REBVAL *lval)
{
REBI64 len;
REBINT maxlen;
REBINT is_ser = ANY_SERIES(sval);
// If lval is not set or is BAR!, use the current len of the target value:
if (IS_UNSET(lval) || IS_BAR(lval)) {
if (!is_ser) return 1;
if (VAL_INDEX(sval) >= VAL_LEN_HEAD(sval)) return 0;
return (VAL_LEN_HEAD(sval) - VAL_INDEX(sval));
}
if (IS_INTEGER(lval) || IS_DECIMAL(lval)) len = Int32(lval);
else {
if (is_ser && VAL_TYPE(sval) == VAL_TYPE(lval) && VAL_SERIES(sval) == VAL_SERIES(lval))
len = (REBINT)VAL_INDEX(lval) - (REBINT)VAL_INDEX(sval);
else
fail (Error(RE_INVALID_PART, lval));
}
if (is_ser) {
// Restrict length to the size available:
if (len >= 0) {
maxlen = (REBINT)VAL_LEN_AT(sval);
if (len > maxlen) len = maxlen;
} else {
len = -len;
if (len > (REBINT)VAL_INDEX(sval)) len = (REBINT)VAL_INDEX(sval);
VAL_INDEX(sval) -= (REBCNT)len;
}
}
return (REBINT)len;
}
*/ REBINT Int32s(REBVAL *val, REBINT sign)
/*
** Get integer as positive, negative 32 bit value.
** Sign field can be
** 0: >= 0
** 1: > 0
** -1: < 0
**
***********************************************************************/
{
REBINT n = 0;
if (IS_DECIMAL(val)) {
if (VAL_DECIMAL(val) > MAX_I32 || VAL_DECIMAL(val) < MIN_I32)
Trap_Range(val);
n = (REBINT)VAL_DECIMAL(val);
} else {
if (VAL_INT64(val) > (i64)MAX_I32 || VAL_INT64(val) < (i64)MIN_I32)
Trap_Range(val);
n = VAL_INT32(val);
}
// More efficient to use positive sense:
if (
(sign == 0 && n >= 0) ||
(sign > 0 && n > 0) ||
(sign < 0 && n < 0)
)
return n;
Trap_Range(val);
return 0;
}
*/ static int Compare_Call(const void *v1, const void *v2)
/*
***********************************************************************/
{
REBVAL *val;
if (sort_flags.reverse)
val = Apply_Func(0, sort_flags.compare, v1, v2, 0);
else
val = Apply_Func(0, sort_flags.compare, v2, v1, 0);
if (IS_LOGIC(val)) {
if (IS_TRUE(val)) return 1;
return -1;
}
if (IS_INTEGER(val)) {
if (VAL_INT64(val) > 0) return 1;
if (VAL_INT64(val) == 0) return 0;
return -1;
}
if (IS_DECIMAL(val)) {
if (VAL_DECIMAL(val) > 0) return 1;
if (VAL_DECIMAL(val) == 0) return 0;
return -1;
}
if (IS_TRUE(val)) return 1;
return -1;
}
*/ REBINT PD_Pair(REBPVS *pvs)
/*
***********************************************************************/
{
REBVAL *sel;
REBVAL *val;
REBINT n = 0;
REBD32 dec;
if (IS_WORD(sel = pvs->select)) {
if (VAL_WORD_CANON(sel) == SYM_X) n = 1;
else if (VAL_WORD_CANON(sel) == SYM_Y) n = 2;
else return PE_BAD_SELECT;
}
else if (IS_INTEGER(sel)) {
n = Int32(sel);
if (n != 1 && n !=2) return PE_BAD_SELECT;
}
else
return PE_BAD_SELECT;
if (NZ(val = pvs->setval)) {
if (IS_INTEGER(val)) dec = (REBD32)VAL_INT64(val);
else if (IS_DECIMAL(val)) dec = (REBD32)VAL_DECIMAL(val);
else return PE_BAD_SET;
if (n == 1) VAL_PAIR_X(pvs->value) = dec;
else VAL_PAIR_Y(pvs->value) = dec;
} else {
dec = (n == 1 ? VAL_PAIR_X(pvs->value) : VAL_PAIR_Y(pvs->value));
SET_DECIMAL(pvs->store, dec);
return PE_USE;
}
return PE_OK;
}
//
// Pick_Vector: C
//
void Pick_Vector(REBVAL *out, const REBVAL *value, const REBVAL *picker) {
REBSER *vect = VAL_SERIES(value);
REBINT n;
if (IS_INTEGER(picker) || IS_DECIMAL(picker))
n = Int32(picker);
else
fail (Error_Invalid_Arg(picker));
n += VAL_INDEX(value);
if (n <= 0 || cast(REBCNT, n) > SER_LEN(vect)) {
SET_VOID(out); // out of range of vector data
return;
}
REBYTE *vp = SER_DATA_RAW(vect);
REBINT bits = VECT_TYPE(vect);
if (bits < VTSF08)
SET_INTEGER(out, get_vect(bits, vp, n - 1)); // 64-bit
else {
VAL_RESET_HEADER(out, REB_DECIMAL);
INIT_DECIMAL_BITS(out, get_vect(bits, vp, n - 1)); // 64-bit
}
}
*/ REBINT Get_Num_Arg(REBVAL *val)
/*
** Get the amount to skip or pick.
** Allow multiple types. Throw error if not valid.
** Note that the result is one-based.
**
***********************************************************************/
{
REBINT n;
if (IS_INTEGER(val)) {
if (VAL_INT64(val) > (i64)MAX_I32 || VAL_INT64(val) < (i64)MIN_I32)
Trap_Range(val);
n = VAL_INT32(val);
}
else if (IS_DECIMAL(val) || IS_PERCENT(val)) {
if (VAL_DECIMAL(val) > MAX_I32 || VAL_DECIMAL(val) < MIN_I32)
Trap_Range(val);
n = (REBINT)VAL_DECIMAL(val);
}
else if (IS_LOGIC(val)) n = (VAL_LOGIC(val) ? 1 : 2);
else Trap_Arg(val);
return n;
}
//
// Poke_Vector_Fail_If_Locked: C
//
void Poke_Vector_Fail_If_Locked(
REBVAL *value,
const REBVAL *picker,
const REBVAL *poke
) {
REBSER *vect = VAL_SERIES(value);
FAIL_IF_LOCKED_SERIES(vect);
REBINT n;
if (IS_INTEGER(picker) || IS_DECIMAL(picker))
n = Int32(picker);
else
fail (Error_Invalid_Arg(picker));
n += VAL_INDEX(value);
if (n <= 0 || cast(REBCNT, n) > SER_LEN(vect))
fail (Error_Out_Of_Range(picker));
REBYTE *vp = SER_DATA_RAW(vect);
REBINT bits = VECT_TYPE(vect);
REBI64 i;
REBDEC f;
if (IS_INTEGER(poke)) {
i = VAL_INT64(poke);
if (bits > VTUI64)
f = cast(REBDEC, i);
else {
// !!! REVIEW: f was not set in this case; compiler caught the
// unused parameter. So fill with distinctive garbage to make it
// easier to search for if it ever is.
f = -646.699;
}
}
else if (IS_DECIMAL(poke)) {
f = VAL_DECIMAL(poke);
if (bits <= VTUI64)
i = cast(REBINT, f);
}
else fail (Error_Invalid_Arg(poke));
set_vect(bits, vp, n - 1, i, f);
}
*/ static void Loop_Number(REBVAL *out, REBVAL *var, REBSER* body, REBVAL *start, REBVAL *end, REBVAL *incr)
/*
***********************************************************************/
{
REBDEC s;
REBDEC e;
REBDEC i;
if (IS_INTEGER(start))
s = cast(REBDEC, VAL_INT64(start));
else if (IS_DECIMAL(start) || IS_PERCENT(start))
s = VAL_DECIMAL(start);
else
raise Error_Invalid_Arg(start);
if (IS_INTEGER(end))
e = cast(REBDEC, VAL_INT64(end));
else if (IS_DECIMAL(end) || IS_PERCENT(end))
e = VAL_DECIMAL(end);
else
raise Error_Invalid_Arg(end);
if (IS_INTEGER(incr))
i = cast(REBDEC, VAL_INT64(incr));
else if (IS_DECIMAL(incr) || IS_PERCENT(incr))
i = VAL_DECIMAL(incr);
else
raise Error_Invalid_Arg(incr);
VAL_SET(var, REB_DECIMAL);
SET_NONE(out); // Default result to NONE if the loop does not run
for (; (i > 0.0) ? s <= e : s >= e; s += i) {
VAL_DECIMAL(var) = s;
if (Do_Block_Throws(out, body, 0)) {
if (Loop_Throw_Should_Return(out)) break;
}
if (!IS_DECIMAL(var)) raise Error_Has_Bad_Type(var);
s = VAL_DECIMAL(var);
}
}
*/ 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;
}
*/ REBI64 Int64(REBVAL *val)
/*
***********************************************************************/
{
if (IS_INTEGER(val)) return VAL_INT64(val);
if (IS_DECIMAL(val) || IS_PERCENT(val)) return (REBI64)VAL_DECIMAL(val);
if (IS_MONEY(val)) return deci_to_int(VAL_DECI(val));
Trap_Arg(val);
return 0;
}
//
// Partial: C
//
// Args:
// aval: target value
// bval: argument to modify target (optional)
// lval: length value (or none)
//
// Determine the length of a /PART value. It can be:
// 1. integer or decimal
// 2. relative to A value (bval is null)
// 3. relative to B value
//
// NOTE: Can modify the value's index!
// The result can be negative. ???
//
REBINT Partial(REBVAL *aval, REBVAL *bval, REBVAL *lval)
{
REBVAL *val;
REBINT len;
REBINT maxlen;
// If lval is unset, use the current len of the target value:
if (IS_UNSET(lval)) {
val = (bval && ANY_SERIES(bval)) ? bval : aval;
if (VAL_INDEX(val) >= VAL_LEN_HEAD(val)) return 0;
return (VAL_LEN_HEAD(val) - VAL_INDEX(val));
}
if (IS_INTEGER(lval) || IS_DECIMAL(lval)) {
len = Int32(lval);
val = bval;
}
else {
// So, lval must be relative to aval or bval series:
if (
VAL_TYPE(aval) == VAL_TYPE(lval)
&& VAL_SERIES(aval) == VAL_SERIES(lval)
) {
val = aval;
}
else if (
bval
&& VAL_TYPE(bval) == VAL_TYPE(lval)
&& VAL_SERIES(bval) == VAL_SERIES(lval)
) {
val = bval;
}
else
fail (Error(RE_INVALID_PART, lval));
len = cast(REBINT, VAL_INDEX(lval)) - cast(REBINT, VAL_INDEX(val));
}
if (!val) val = aval;
// Restrict length to the size available
//
if (len >= 0) {
maxlen = (REBINT)VAL_LEN_AT(val);
if (len > maxlen) len = maxlen;
}
else {
len = -len;
if (len > cast(REBINT, VAL_INDEX(val)))
len = cast(REBINT, VAL_INDEX(val));
VAL_INDEX(val) -= (REBCNT)len;
}
return len;
}
*/ REBFLG Get_Logic_Arg(REBVAL *arg)
/*
***********************************************************************/
{
if (IS_NONE(arg)) return 0;
if (IS_INTEGER(arg)) return (VAL_INT64(arg) != 0);
if (IS_LOGIC(arg)) return (VAL_LOGIC(arg) != 0);
if (IS_DECIMAL(arg) || IS_PERCENT(arg)) return (VAL_DECIMAL(arg) != 0.0);
Trap_Arg(arg);
DEAD_END;
}
//
// 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));
}
//
// PD_Tuple: C
//
// Implements PATH and SET_PATH for tuple.
// Sets DS_TOP if found. Always returns 0.
//
REBINT PD_Tuple(REBPVS *pvs)
{
const REBVAL *setval;
REBINT n;
REBINT i;
REBYTE *dat;
REBINT len;
dat = VAL_TUPLE(pvs->value);
len = VAL_TUPLE_LEN(pvs->value);
if (len < 3) {
len = 3;
}
n = Get_Num_From_Arg(pvs->selector);
if ((setval = pvs->opt_setval)) {
if (n <= 0 || n > cast(REBINT, MAX_TUPLE))
fail (Error_Bad_Path_Select(pvs));
if (IS_INTEGER(setval) || IS_DECIMAL(setval))
i = Int32(setval);
else if (IS_BLANK(setval)) {
n--;
CLEAR(dat + n, MAX_TUPLE - n);
VAL_TUPLE_LEN(pvs->value) = n;
return PE_OK;
}
else
fail (Error_Bad_Path_Set(pvs));
if (i < 0) i = 0;
else if (i > 255) i = 255;
dat[n - 1] = i;
if (n > len)
VAL_TUPLE_LEN(pvs->value) = n;
return PE_OK;
}
else {
if (n > 0 && n <= len) {
SET_INTEGER(pvs->store, dat[n - 1]);
return PE_USE_STORE;
}
else return PE_NONE;
}
}
*/ REBFLG MT_Decimal(REBVAL *out, REBVAL *data, REBCNT type)
/*
***********************************************************************/
{
if (!IS_END(data+1)) return FALSE;
if (IS_DECIMAL(data))
*out = *data;
else if (IS_INTEGER(data)) {
SET_DECIMAL(out, (REBDEC)VAL_INT64(data));
}
else return FALSE;
SET_TYPE(out, type);
return TRUE;
}
//
// Int32: C
//
REBINT Int32(const REBVAL *val)
{
REBINT n = 0;
if (IS_DECIMAL(val)) {
if (VAL_DECIMAL(val) > MAX_I32 || VAL_DECIMAL(val) < MIN_I32)
fail (Error_Out_Of_Range(val));
n = (REBINT)VAL_DECIMAL(val);
} else {
if (VAL_INT64(val) > (i64)MAX_I32 || VAL_INT64(val) < (i64)MIN_I32)
fail (Error_Out_Of_Range(val));
n = VAL_INT32(val);
}
return n;
}
static REBSER *make_string(REBVAL *arg, REBOOL make)
{
REBSER *ser = 0;
// MAKE <type> 123
if (make && (IS_INTEGER(arg) || IS_DECIMAL(arg))) {
ser = Make_Binary(Int32s(arg, 0));
}
// MAKE/TO <type> <binary!>
else if (IS_BINARY(arg)) {
REBYTE *bp = VAL_BIN_DATA(arg);
REBCNT len = VAL_LEN(arg);
switch (What_UTF(bp, len)) {
case 0:
break;
case 8: // UTF-8 encoded
bp += 3;
len -= 3;
break;
default:
Trap0(RE_BAD_DECODE);
}
ser = Decode_UTF_String(bp, len, 8); // UTF-8
}
// MAKE/TO <type> <any-string>
else if (ANY_BINSTR(arg)) {
ser = Copy_String(VAL_SERIES(arg), VAL_INDEX(arg), VAL_LEN(arg));
}
// MAKE/TO <type> <any-word>
else if (ANY_WORD(arg)) {
ser = Copy_Mold_Value(arg, TRUE);
//ser = Append_UTF8(0, Get_Word_Name(arg), -1);
}
// MAKE/TO <type> #"A"
else if (IS_CHAR(arg)) {
ser = (VAL_CHAR(arg) > 0xff) ? Make_Unicode(2) : Make_Binary(2);
Append_Byte(ser, VAL_CHAR(arg));
}
// MAKE/TO <type> <any-value>
// else if (IS_NONE(arg)) {
// ser = Make_Binary(0);
// }
else
ser = Copy_Form_Value(arg, 1<<MOPT_TIGHT);
return ser;
}
//
// MAKE_Vector: C
//
void MAKE_Vector(REBVAL *out, enum Reb_Kind kind, const REBVAL *arg)
{
// CASE: make vector! 100
if (IS_INTEGER(arg) || IS_DECIMAL(arg)) {
REBINT size = Int32s(arg, 0);
if (size < 0) goto bad_make;
REBSER *ser = Make_Vector(0, 0, 1, 32, size);
Val_Init_Vector(out, ser);
return;
}
TO_Vector(out, kind, arg); // may fail()
return;
bad_make:
fail (Error_Bad_Make(kind, arg));
}
*/ REBINT Int32(REBVAL *val)
/*
***********************************************************************/
{
REBINT n = 0;
if (IS_DECIMAL(val)) {
if (VAL_DECIMAL(val) > MAX_I32 || VAL_DECIMAL(val) < MIN_I32)
Trap_Range(val);
n = (REBINT)VAL_DECIMAL(val);
} else {
if (VAL_INT64(val) > (i64)MAX_I32 || VAL_INT64(val) < (i64)MIN_I32)
Trap_Range(val);
n = VAL_INT32(val);
}
return n;
}
//
// PD_Pair: C
//
REBINT PD_Pair(REBPVS *pvs)
{
const REBVAL *sel = pvs->selector;
REBINT n = 0;
REBDEC dec;
if (IS_WORD(sel)) {
if (VAL_WORD_SYM(sel) == SYM_X)
n = 1;
else if (VAL_WORD_SYM(sel) == SYM_Y)
n = 2;
else
fail (Error_Bad_Path_Select(pvs));
}
else if (IS_INTEGER(sel)) {
n = Int32(sel);
if (n != 1 && n != 2)
fail (Error_Bad_Path_Select(pvs));
}
else fail (Error_Bad_Path_Select(pvs));
if (pvs->opt_setval) {
const REBVAL *setval = pvs->opt_setval;
if (IS_INTEGER(setval))
dec = cast(REBDEC, VAL_INT64(setval));
else if (IS_DECIMAL(setval))
dec = VAL_DECIMAL(setval);
else
fail (Error_Bad_Path_Set(pvs));
if (n == 1)
VAL_PAIR_X(pvs->value) = dec;
else
VAL_PAIR_Y(pvs->value) = dec;
}
else {
dec = (n == 1 ? VAL_PAIR_X(pvs->value) : VAL_PAIR_Y(pvs->value));
SET_DECIMAL(pvs->store, dec);
return PE_USE_STORE;
}
return PE_OK;
}
*/ static REBFLG Set_Pair(REBXYF *pair, REBVAL *val)
/*
***********************************************************************/
{
if (IS_PAIR(val)) {
pair->x = VAL_PAIR_X(val);
pair->y = VAL_PAIR_Y(val);
}
else if (IS_INTEGER(val)) {
pair->x = pair->y = (REBD32)VAL_INT64(val);
}
else if (IS_DECIMAL(val)) {
pair->x = pair->y = (REBD32)VAL_DECIMAL(val);
}
else
return FALSE;
return TRUE;
}
*/ REBINT PD_Tuple(REBPVS *pvs)
/*
** Implements PATH and SET_PATH for tuple.
** Sets DS_TOP if found. Always returns 0.
**
***********************************************************************/
{
REBVAL *val;
REBINT n;
REBINT i;
REBYTE *dat;
REBINT len;
dat = VAL_TUPLE(pvs->value);
len = VAL_TUPLE_LEN(pvs->value);
if (len < 3) len = 3;
n = Get_Num_Arg(pvs->select);
if (NZ(val = pvs->setval)) {
if (n <= 0 || n > MAX_TUPLE) return PE_BAD_SELECT;
if (IS_INTEGER(val) || IS_DECIMAL(val)) i = Int32(val);
else if (IS_NONE(val)) {
n--;
CLEAR(dat+n, MAX_TUPLE-n);
VAL_TUPLE_LEN(pvs->value) = n;
return PE_OK;
}
else return PE_BAD_SET;
if (i < 0) i = 0;
else if (i > 255) i = 255;
dat[n-1] = i;
if (n > len) VAL_TUPLE_LEN(pvs->value) = n;
return PE_OK;
} else {
if (n > 0 && n <= len) {
SET_INTEGER(pvs->store, dat[n-1]);
return PE_USE;
}
else return PE_NONE;
}
}
//
// Get_Num_From_Arg: C
//
// Get the amount to skip or pick.
// Allow multiple types. Throw error if not valid.
// Note that the result is one-based.
//
REBINT Get_Num_From_Arg(const REBVAL *val)
{
REBINT n;
if (IS_INTEGER(val)) {
if (VAL_INT64(val) > (i64)MAX_I32 || VAL_INT64(val) < (i64)MIN_I32)
fail (Error_Out_Of_Range(val));
n = VAL_INT32(val);
}
else if (IS_DECIMAL(val) || IS_PERCENT(val)) {
if (VAL_DECIMAL(val) > MAX_I32 || VAL_DECIMAL(val) < MIN_I32)
fail (Error_Out_Of_Range(val));
n = (REBINT)VAL_DECIMAL(val);
}
else if (IS_LOGIC(val))
n = (VAL_LOGIC(val) ? 1 : 2);
else
fail (Error_Invalid_Arg(val));
return n;
}
*/ REBINT Partial1(REBVAL *sval, REBVAL *lval)
/*
** Process the /part (or /skip) and other length modifying
** arguments.
**
***********************************************************************/
{
REBI64 len;
REBINT maxlen;
REBINT is_ser = ANY_SERIES(sval);
// If lval = NONE, use the current len of the target value:
if (IS_NONE(lval)) {
if (!is_ser) return 1;
if (VAL_INDEX(sval) >= VAL_TAIL(sval)) return 0;
return (VAL_TAIL(sval) - VAL_INDEX(sval));
}
if (IS_INTEGER(lval) || IS_DECIMAL(lval)) len = Int32(lval);
else {
if (is_ser && VAL_TYPE(sval) == VAL_TYPE(lval) && VAL_SERIES(sval) == VAL_SERIES(lval))
len = (REBINT)VAL_INDEX(lval) - (REBINT)VAL_INDEX(sval);
else
Trap1(RE_INVALID_PART, lval);
}
if (is_ser) {
// Restrict length to the size available:
if (len >= 0) {
maxlen = (REBINT)VAL_LEN(sval);
if (len > maxlen) len = maxlen;
} else {
len = -len;
if (len > (REBINT)VAL_INDEX(sval)) len = (REBINT)VAL_INDEX(sval);
VAL_INDEX(sval) -= (REBCNT)len;
}
}
return (REBINT)len;
}
//
// Int64s: C
//
// Get integer as positive, negative 64 bit value.
// Sign field can be
// 0: >= 0
// 1: > 0
// -1: < 0
//
REBI64 Int64s(const REBVAL *val, REBINT sign)
{
REBI64 n;
if (IS_DECIMAL(val)) {
if (VAL_DECIMAL(val) > MAX_I64 || VAL_DECIMAL(val) < MIN_I64)
fail (Error_Out_Of_Range(val));
n = (REBI64)VAL_DECIMAL(val);
} else {
n = VAL_INT64(val);
}
// More efficient to use positive sense:
if (
(sign == 0 && n >= 0) ||
(sign > 0 && n > 0) ||
(sign < 0 && n < 0)
)
return n;
fail (Error_Out_Of_Range(val));
}
static MPC_Object *
GMPy_MPC_From_Decimal(PyObject *obj, mpfr_prec_t rprec, mpfr_prec_t iprec,
CTXT_Object *context)
{
MPC_Object *result = NULL;
MPFR_Object *tempf;
mpfr_prec_t oldmpfr, oldreal;
int oldmpfr_round, oldreal_round;
assert(IS_DECIMAL(obj));
CHECK_CONTEXT(context);
oldmpfr = GET_MPFR_PREC(context);
oldreal = GET_REAL_PREC(context);
oldmpfr_round = GET_MPFR_ROUND(context);
oldreal_round = GET_REAL_ROUND(context);
context->ctx.mpfr_prec = oldreal;
context->ctx.mpfr_round = oldreal_round;
tempf = GMPy_MPFR_From_Decimal(obj, rprec, context);
context->ctx.mpfr_prec = oldmpfr;
context->ctx.mpfr_round = oldmpfr_round;
result = GMPy_MPC_New(0, 0, context);
if (!tempf || !result) {
Py_XDECREF((PyObject*)tempf);
Py_XDECREF((PyObject*)result);
return NULL;
}
result->rc = MPC_INEX(tempf->rc, 0);
mpfr_swap(mpc_realref(result->c), tempf->f);
Py_DECREF(tempf);
return result;
}
//
// Poke_Tuple_Immediate: C
//
// !!! Note: In the current implementation, tuples are immediate values.
// So a POKE only changes the `value` in your hand.
//
void Poke_Tuple_Immediate(
REBVAL *value,
const REBVAL *picker,
const REBVAL *poke
) {
REBYTE *dat = VAL_TUPLE(value);
REBINT len = VAL_TUPLE_LEN(value);
if (len < 3)
len = 3;
REBINT n = Get_Num_From_Arg(picker);
if (n <= 0 || n > cast(REBINT, MAX_TUPLE))
fail (Error_Out_Of_Range(picker));
REBINT i;
if (IS_INTEGER(poke) || IS_DECIMAL(poke))
i = Int32(poke);
else if (IS_BLANK(poke)) {
n--;
CLEAR(dat + n, MAX_TUPLE - n);
VAL_TUPLE_LEN(value) = n;
return;
}
else
fail (poke);
if (i < 0)
i = 0;
else if (i > 255)
i = 255;
dat[n - 1] = i;
if (n > len)
VAL_TUPLE_LEN(value) = n;
}
static MPC_Object *
GMPy_MPC_From_Complex(PyObject* obj, mp_prec_t rprec, mp_prec_t iprec,
CTXT_Object *context)
{
CHECK_CONTEXT(context);
if (MPC_Check(obj))
return GMPy_MPC_From_MPC((MPC_Object*)obj, rprec, iprec, context);
if (MPFR_Check(obj))
return GMPy_MPC_From_MPFR((MPFR_Object*)obj, rprec, iprec, context);
if (PyFloat_Check(obj))
return GMPy_MPC_From_PyFloat(obj, rprec, iprec, context);
if (PyComplex_Check(obj))
return GMPy_MPC_From_PyComplex(obj, rprec, iprec, context);
if (MPQ_Check(obj))
return GMPy_MPC_From_MPQ((MPQ_Object*)obj, rprec, iprec, context);
if (MPZ_Check(obj) || XMPZ_Check(obj))
return GMPy_MPC_From_MPZ((MPZ_Object*)obj, rprec, iprec, context);
if (PyIntOrLong_Check(obj))
return GMPy_MPC_From_PyIntOrLong(obj, rprec, iprec, context);
if (IS_DECIMAL(obj))
return GMPy_MPC_From_Decimal(obj, rprec, iprec, context);
if (IS_FRACTION(obj))
return GMPy_MPC_From_Fraction(obj, rprec, iprec, context);
TYPE_ERROR("object could not be converted to 'mpc'");
return NULL;
}
