//
// MAKE_Tuple: C
//
void MAKE_Tuple(REBVAL *out, enum Reb_Kind type, const REBVAL *arg)
{
if (IS_TUPLE(arg)) {
*out = *arg;
return;
}
VAL_RESET_HEADER(out, REB_TUPLE);
REBYTE *vp = VAL_TUPLE(out);
// !!! Net lookup parses IP addresses out of `tcp://93.184.216.34` or
// similar URL!s. In Rebol3 these captures come back the same type
// as the input instead of as STRING!, which was a latent bug in the
// network code of the 12-Dec-2012 release:
//
// https://github.com/rebol/rebol/blob/master/src/mezz/sys-ports.r#L110
//
// All attempts to convert a URL!-flavored IP address failed. Taking
// URL! here fixes it, though there are still open questions.
//
if (IS_STRING(arg) || IS_URL(arg)) {
REBCNT len;
REBYTE *ap = Temp_Byte_Chars_May_Fail(arg, MAX_SCAN_TUPLE, &len, FALSE);
if (Scan_Tuple(ap, len, out))
return;
goto bad_arg;
}
if (ANY_ARRAY(arg)) {
REBCNT len = 0;
REBINT n;
RELVAL *item = VAL_ARRAY_AT(arg);
for (; NOT_END(item); ++item, ++vp, ++len) {
if (len >= MAX_TUPLE) goto bad_make;
if (IS_INTEGER(item)) {
n = Int32(item);
}
else if (IS_CHAR(item)) {
n = VAL_CHAR(item);
}
else
goto bad_make;
if (n > 255 || n < 0) goto bad_make;
*vp = n;
}
VAL_TUPLE_LEN(out) = len;
for (; len < MAX_TUPLE; len++) *vp++ = 0;
return;
}
REBCNT alen;
if (IS_ISSUE(arg)) {
REBUNI c;
const REBYTE *ap = VAL_WORD_HEAD(arg);
REBCNT len = LEN_BYTES(ap); // UTF-8 len
if (len & 1) goto bad_arg; // must have even # of chars
len /= 2;
if (len > MAX_TUPLE) goto bad_arg; // valid even for UTF-8
VAL_TUPLE_LEN(out) = len;
for (alen = 0; alen < len; alen++) {
const REBOOL unicode = FALSE;
if (!Scan_Hex2(ap, &c, unicode)) goto bad_arg;
*vp++ = cast(REBYTE, c);
ap += 2;
}
}
else if (IS_BINARY(arg)) {
REBYTE *ap = VAL_BIN_AT(arg);
REBCNT len = VAL_LEN_AT(arg);
if (len > MAX_TUPLE) len = MAX_TUPLE;
VAL_TUPLE_LEN(out) = len;
for (alen = 0; alen < len; alen++) *vp++ = *ap++;
}
else goto bad_arg;
for (; alen < MAX_TUPLE; alen++) *vp++ = 0;
return;
bad_arg:
fail (Error_Invalid_Arg(arg));
bad_make:
fail (Error_Bad_Make(REB_TUPLE, arg));
}
//
// MAKE_Pair: C
//
void MAKE_Pair(REBVAL *out, enum Reb_Kind type, const REBVAL *arg)
{
if (IS_PAIR(arg)) {
*out = *arg;
return;
}
if (IS_STRING(arg)) {
//
// -1234567890x-1234567890
//
REBCNT len;
REBYTE *bp
= Temp_Byte_Chars_May_Fail(arg, VAL_LEN_AT(arg), &len, FALSE);
if (!Scan_Pair(bp, len, out)) goto bad_make;
return;
}
REBDEC x;
REBDEC y;
if (IS_INTEGER(arg)) {
x = VAL_INT32(arg);
y = VAL_INT32(arg);
}
else if (IS_DECIMAL(arg)) {
x = VAL_DECIMAL(arg);
y = VAL_DECIMAL(arg);
}
else if (IS_BLOCK(arg) && VAL_LEN_AT(arg) == 2) {
RELVAL *item = VAL_ARRAY_AT(arg);
if (IS_INTEGER(item))
x = cast(REBDEC, VAL_INT64(item));
else if (IS_DECIMAL(item))
x = cast(REBDEC, VAL_DECIMAL(item));
else
goto bad_make;
++item;
if (IS_END(item))
goto bad_make;
if (IS_INTEGER(item))
y = cast(REBDEC, VAL_INT64(item));
else if (IS_DECIMAL(item))
y = cast(REBDEC, VAL_DECIMAL(item));
else
goto bad_make;
}
else
goto bad_make;
SET_PAIR(out, x, y);
return;
bad_make:
fail (Error_Bad_Make(REB_PAIR, arg));
}
//
// 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));
}
//
// Make_Time: C
//
// Returns NO_TIME if error.
//
REBI64 Make_Time(REBVAL *val)
{
REBI64 secs = 0;
if (IS_TIME(val)) {
secs = VAL_TIME(val);
}
else if (IS_STRING(val)) {
REBYTE *bp;
REBCNT len;
bp = Temp_Byte_Chars_May_Fail(val, MAX_SCAN_TIME, &len, FALSE);
if (!Scan_Time(bp, len, val)) goto no_time;
secs = VAL_TIME(val);
}
else if (IS_INTEGER(val)) {
if (VAL_INT64(val) < -MAX_SECONDS || VAL_INT64(val) > MAX_SECONDS)
fail (Error_Out_Of_Range(val));
secs = VAL_INT64(val) * SEC_SEC;
}
else if (IS_DECIMAL(val)) {
if (VAL_DECIMAL(val) < (REBDEC)(-MAX_SECONDS) || VAL_DECIMAL(val) > (REBDEC)MAX_SECONDS)
fail (Error_Out_Of_Range(val));
secs = DEC_TO_SECS(VAL_DECIMAL(val));
}
else if (ANY_ARRAY(val) && VAL_BLK_LEN(val) <= 3) {
REBFLG neg = FALSE;
REBI64 i;
val = VAL_BLK_DATA(val);
if (!IS_INTEGER(val)) goto no_time;
i = Int32(val);
if (i < 0) i = -i, neg = TRUE;
secs = i * 3600;
if (secs > MAX_SECONDS) goto no_time;
if (NOT_END(++val)) {
if (!IS_INTEGER(val)) goto no_time;
if ((i = Int32(val)) < 0) goto no_time;
secs += i * 60;
if (secs > MAX_SECONDS) goto no_time;
if (NOT_END(++val)) {
if (IS_INTEGER(val)) {
if ((i = Int32(val)) < 0) goto no_time;
secs += i;
if (secs > MAX_SECONDS) goto no_time;
}
else if (IS_DECIMAL(val)) {
if (secs + (REBI64)VAL_DECIMAL(val) + 1 > MAX_SECONDS) goto no_time;
// added in below
}
else goto no_time;
}
}
secs *= SEC_SEC;
if (IS_DECIMAL(val)) secs += DEC_TO_SECS(VAL_DECIMAL(val));
if (neg) secs = -secs;
}
else
no_time: return NO_TIME;
return secs;
}