Ejemplo n.º 1
0
//
//  MAKE_String: C
//
void MAKE_String(REBVAL *out, enum Reb_Kind kind, const REBVAL *def) {
    REBSER *ser; // goto would cross initialization

    if (IS_INTEGER(def)) {
        //
        // !!! R3-Alpha tolerated decimal, e.g. `make string! 3.14`, which
        // is semantically nebulous (round up, down?) and generally bad.
        //
        ser = Make_Binary(Int32s(def, 0));
        Val_Init_Series(out, kind, ser);
        return;
    }
    else if (IS_BLOCK(def)) {
        //
        // The construction syntax for making strings or binaries that are
        // preloaded with an offset into the data is #[binary [#{0001} 2]].
        // In R3-Alpha make definitions didn't have to be a single value
        // (they are for compatibility between construction syntax and MAKE
        // in Ren-C).  So the positional syntax was #[binary! #{0001} 2]...
        // while #[binary [#{0001} 2]] would join the pieces together in order
        // to produce #{000102}.  That behavior is not available in Ren-C.

        if (VAL_ARRAY_LEN_AT(def) != 2)
            goto bad_make;

        RELVAL *any_binstr = VAL_ARRAY_AT(def);
        if (!ANY_BINSTR(any_binstr))
            goto bad_make;
        if (IS_BINARY(any_binstr) != LOGICAL(kind == REB_BINARY))
            goto bad_make;

        RELVAL *index = VAL_ARRAY_AT(def) + 1;
        if (!IS_INTEGER(index))
            goto bad_make;

        REBINT i = Int32(index) - 1 + VAL_INDEX(any_binstr);
        if (i < 0 || i > cast(REBINT, VAL_LEN_AT(any_binstr)))
            goto bad_make;

        Val_Init_Series_Index(out, kind, VAL_SERIES(any_binstr), i);
        return;
    }

    if (kind == REB_BINARY)
        ser = make_binary(def, TRUE);
    else
        ser = MAKE_TO_String_Common(def);

    if (!ser)
        goto bad_make;

    Val_Init_Series_Index(out, kind, ser, 0);
    return;

bad_make:
    fail (Error_Bad_Make(kind, def));
}
Ejemplo n.º 2
0
//
//  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));
}