示例#1
0
文件: c-path.c 项目: kjanz1899/ren-c
//
//  Resolve_Path: C
//
// Given a path, return a context and index for its terminal.
//
REBCTX *Resolve_Path(REBVAL *path, REBCNT *index)
{
    REBVAL *sel; // selector
    const REBVAL *val;
    REBARR *blk;
    REBCNT i;

    if (VAL_LEN_HEAD(path) < 2) return 0;
    blk = VAL_ARRAY(path);
    sel = ARR_HEAD(blk);
    if (!ANY_WORD(sel)) return 0;
    val = GET_OPT_VAR_MAY_FAIL(sel);

    sel = ARR_AT(blk, 1);
    while (TRUE) {
        if (!ANY_CONTEXT(val) || !IS_WORD(sel)) return 0;
        i = Find_Word_In_Context(VAL_CONTEXT(val), VAL_WORD_SYM(sel), FALSE);
        sel++;
        if (IS_END(sel)) {
            *index = i;
            return VAL_CONTEXT(val);
        }
    }

    return 0; // never happens
}
示例#2
0
文件: c-path.c 项目: rgchris/ren-c
//
//  Resolve_Path: C
//
// Given a path, determine if it is ultimately specifying a selection out
// of a context...and if it is, return that context.  So `a/obj/key` would
// return the object assocated with obj, while `a/str/1` would return
// NULL if `str` were a string as it's not an object selection.
//
// !!! This routine overlaps the logic of Do_Path, and should potentially
// be a mode of that instead.  It is not very complete, considering that it
// does not execute GROUP! (and perhaps shouldn't?) and only supports a
// path that picks contexts out of other contexts, via word selection.
//
REBCTX *Resolve_Path(const REBVAL *path, REBCNT *index_out)
{
    RELVAL *selector;
    const REBVAL *var;
    REBARR *array;
    REBCNT i;

    array = VAL_ARRAY(path);
    selector = ARR_HEAD(array);

    if (IS_END(selector) || !ANY_WORD(selector))
        return NULL; // !!! only handles heads of paths that are ANY-WORD!

    var = GET_OPT_VAR_MAY_FAIL(selector, VAL_SPECIFIER(path));

    ++selector;
    if (IS_END(selector))
        return NULL; // !!! does not handle single-element paths

    while (ANY_CONTEXT(var) && IS_WORD(selector)) {
        i = Find_Canon_In_Context(
            VAL_CONTEXT(var), VAL_WORD_CANON(selector), FALSE
        );
        ++selector;
        if (IS_END(selector)) {
            *index_out = i;
            return VAL_CONTEXT(var);
        }

        var = CTX_VAR(VAL_CONTEXT(var), i);
    }

    DEAD_END;
}
示例#3
0
文件: f-stubs.c 项目: kjanz1899/ren-c
//
//  Get_System: C
// 
// Return a second level object field of the system object.
//
REBVAL *Get_System(REBCNT i1, REBCNT i2)
{
    REBVAL *obj;

    obj = CTX_VAR(VAL_CONTEXT(ROOT_SYSTEM), i1);
    if (i2 == 0) return obj;
    assert(IS_OBJECT(obj));
    return Get_Field(VAL_CONTEXT(obj), i2);
}
示例#4
0
文件: f-stubs.c 项目: kjanz1899/ren-c
//
//  Get_Object: C
// 
// Get an instance variable from an ANY-CONTEXT! value.
//
REBVAL *Get_Object(const REBVAL *any_context, REBCNT index)
{
    REBCTX *context = VAL_CONTEXT(any_context);

    assert(GET_ARR_FLAG(CTX_VARLIST(context), ARRAY_FLAG_CONTEXT_VARLIST));
    assert(index <= CTX_LEN(context));
    return CTX_VAR(context, index);
}
示例#5
0
文件: f-stubs.c 项目: kjanz1899/ren-c
//
//  Val_Init_Context: C
//
// Common routine for initializing OBJECT, MODULE!, PORT!, and ERROR!
//
// A fully constructed context can reconstitute the ANY-CONTEXT! REBVAL that
// is its canon form from a single pointer...the REBVAL sitting in the 0 slot
// of the context's varlist.
//
void Val_Init_Context(REBVAL *out, enum Reb_Kind kind, REBCTX *context) {
    //
    // In a debug build we check to make sure the type of the embedded value
    // matches the type of what is intended (so someone who thinks they are
    // initializing a REB_OBJECT from a CONTEXT does not accidentally get a
    // REB_ERROR, for instance.)  It's a point for several other integrity
    // checks as well.
    //
#if !defined(NDEBUG)
    REBVAL *value = CTX_VALUE(context);

    assert(ANY_CONTEXT(value));
    assert(CTX_TYPE(context) == kind);

    assert(VAL_CONTEXT(value) == context);

    if (!CTX_KEYLIST(context)) {
        Debug_Fmt("Context found with no keylist set");
        Panic_Context(context);
    }

    assert(GET_ARR_FLAG(CTX_VARLIST(context), ARRAY_FLAG_CONTEXT_VARLIST));

    // !!! Historically spec is a frame of an object for a "module spec",
    // may want to use another word of that and make a block "spec"
    //
    if (IS_FRAME(CTX_VALUE(context))) {
        assert(IS_FUNCTION(FUNC_VALUE(CTX_FRAME_FUNC(context))));
    }
    else
        assert(
            NOT(CTX_SPEC(context))
            || ANY_CONTEXT(CTX_VALUE(CTX_SPEC(context)))
        );
#endif

    // Some contexts (stack frames in particular) start out unmanaged, and
    // then check to see if an operation like Val_Init_Context set them to
    // managed.  If not, they will free the context.  This avoids the need
    // for the garbage collector to have to deal with the series if there's
    // no reason too.
    //
    // Here is a case of where we mark the context as having an extant usage,
    // so that at minimum this value must become unreachable from the root GC
    // set before they are GC'd.  For another case, see INIT_WORD_CONTEXT(),
    // where an ANY-WORD! can mark a context as in use.
    //
    ENSURE_ARRAY_MANAGED(CTX_VARLIST(context));

    // Keylists are different, because they may-or-may-not-be-reused by some
    // operations.  There needs to be a uniform policy on their management,
    // or certain routines would return "sometimes managed, sometimes not"
    // keylist series...a bad invariant.
    //
    ASSERT_ARRAY_MANAGED(CTX_KEYLIST(context));

    *out = *CTX_VALUE(context);
}
示例#6
0
//
//  Uncolor: C
//
// Clear the recusion markers for series and object trees.
//
void Uncolor(RELVAL *v)
{
    REBARR *array;

    if (ANY_ARRAY_OR_PATH(v))
        array = VAL_ARRAY(v);
    else if (IS_MAP(v))
        array = MAP_PAIRLIST(VAL_MAP(v));
    else if (ANY_CONTEXT(v))
        array = CTX_VARLIST(VAL_CONTEXT(v));
    else {
        // Shouldn't have marked recursively any non-array series (no need)
        //
        assert(
            not ANY_SERIES(v)
            or Is_Series_White(VAL_SERIES(v))
        );
        return;
    }

    Uncolor_Array(array);
}
示例#7
0
文件: f-stubs.c 项目: kjanz1899/ren-c
//
//  In_Object: C
// 
// Get value from nested list of objects. List is null terminated.
// Returns object value, else returns 0 if not found.
//
REBVAL *In_Object(REBCTX *base, ...)
{
    REBVAL *context = NULL;
    REBCNT n;
    va_list va;

    va_start(va, base);
    while ((n = va_arg(va, REBCNT))) {
        if (n > CTX_LEN(base)) {
            va_end(va);
            return NULL;
        }
        context = CTX_VAR(base, n);
        if (!ANY_CONTEXT(context)) {
            va_end(va);
            return NULL;
        }
        base = VAL_CONTEXT(context);
    }
    va_end(va);

    return context;
}
示例#8
0
//
//  Do_Breakpoint_Throws: C
//
// A call to Do_Breakpoint_Throws does delegation to a hook in the host, which
// (if registered) will generally start an interactive session for probing the
// environment at the break.  The `resume` native cooperates by being able to
// give back a value (or give back code to run to produce a value) that the
// call to breakpoint returns.
//
// RESUME has another feature, which is to be able to actually unwind and
// simulate a return /AT a function *further up the stack*.  (This may be
// switched to a feature of a "STEP OUT" command at some point.)
//
REBOOL Do_Breakpoint_Throws(
    REBVAL *out,
    REBOOL interrupted, // Ctrl-C (as opposed to a BREAKPOINT)
    const REBVAL *default_value,
    REBOOL do_default
) {
    REBVAL *target = NONE_VALUE;

    REBVAL temp;
    VAL_INIT_WRITABLE_DEBUG(&temp);

    if (!PG_Breakpoint_Quitting_Hook) {
        //
        // Host did not register any breakpoint handler, so raise an error
        // about this as early as possible.
        //
        fail (Error(RE_HOST_NO_BREAKPOINT));
    }

    // We call the breakpoint hook in a loop, in order to keep running if any
    // inadvertent FAILs or THROWs occur during the interactive session.
    // Only a conscious call of RESUME speaks the protocol to break the loop.
    //
    while (TRUE) {
        struct Reb_State state;
        REBCTX *error;

    push_trap:
        PUSH_TRAP(&error, &state);

        // The host may return a block of code to execute, but cannot
        // while evaluating do a THROW or a FAIL that causes an effective
        // "resumption".  Halt is the exception, hence we PUSH_TRAP and
        // not PUSH_UNHALTABLE_TRAP.  QUIT is also an exception, but a
        // desire to quit is indicated by the return value of the breakpoint
        // hook (which may or may not decide to request a quit based on the
        // QUIT command being run).
        //
        // The core doesn't want to get involved in presenting UI, so if
        // an error makes it here and wasn't trapped by the host first that
        // is a bug in the host.  It should have done its own PUSH_TRAP.
        //
        if (error) {
        #if !defined(NDEBUG)
            REBVAL error_value;
            VAL_INIT_WRITABLE_DEBUG(&error_value);

            Val_Init_Error(&error_value, error);
            PROBE_MSG(&error_value, "Error not trapped during breakpoint:");
            Panic_Array(CTX_VARLIST(error));
        #endif

            // In release builds, if an error managed to leak out of the
            // host's breakpoint hook somehow...just re-push the trap state
            // and try it again.
            //
            goto push_trap;
        }

        // Call the host's breakpoint hook.
        //
        if (PG_Breakpoint_Quitting_Hook(&temp, interrupted)) {
            //
            // If a breakpoint hook returns TRUE that means it wants to quit.
            // The value should be the /WITH value (as in QUIT/WITH)
            //
            assert(!THROWN(&temp));
            *out = *ROOT_QUIT_NATIVE;
            CONVERT_NAME_TO_THROWN(out, &temp, FALSE);
            return TRUE; // TRUE = threw
        }

        // If a breakpoint handler returns FALSE, then it should have passed
        // back a "resume instruction" triggered by a call like:
        //
        //     resume/do [fail "This is how to fail from a breakpoint"]
        //
        // So now that the handler is done, we will allow any code handed back
        // to do whatever FAIL it likes vs. trapping that here in a loop.
        //
        DROP_TRAP_SAME_STACKLEVEL_AS_PUSH(&state);

        // Decode and process the "resume instruction"
        {
            struct Reb_Frame *frame;
            REBVAL *mode;
            REBVAL *payload;

            assert(IS_GROUP(&temp));
            assert(VAL_LEN_HEAD(&temp) == RESUME_INST_MAX);

            mode = VAL_ARRAY_AT_HEAD(&temp, RESUME_INST_MODE);
            payload = VAL_ARRAY_AT_HEAD(&temp, RESUME_INST_PAYLOAD);
            target = VAL_ARRAY_AT_HEAD(&temp, RESUME_INST_TARGET);

            // The first thing we need to do is determine if the target we
            // want to return to has another breakpoint sandbox blocking
            // us.  If so, what we need to do is actually retransmit the
            // resume instruction so it can break that wall, vs. transform
            // it into an EXIT/FROM that would just get intercepted.
            //
            if (!IS_NONE(target)) {
            #if !defined(NDEBUG)
                REBOOL found = FALSE;
            #endif

                for (frame = FS_TOP; frame != NULL; frame = frame->prior) {
                    if (frame->mode != CALL_MODE_FUNCTION)
                        continue;

                    if (
                        frame != FS_TOP
                        && FUNC_CLASS(frame->func) == FUNC_CLASS_NATIVE
                        && (
                            FUNC_CODE(frame->func) == &N_pause
                            || FUNC_CODE(frame->func) == &N_breakpoint
                        )
                    ) {
                        // We hit a breakpoint (that wasn't this call to
                        // breakpoint, at the current FS_TOP) before finding
                        // the sought after target.  Retransmit the resume
                        // instruction so that level will get it instead.
                        //
                        *out = *ROOT_RESUME_NATIVE;
                        CONVERT_NAME_TO_THROWN(out, &temp, FALSE);
                        return TRUE; // TRUE = thrown
                    }

                    if (IS_FRAME(target)) {
                        if (NOT(frame->flags & DO_FLAG_FRAME_CONTEXT))
                            continue;
                        if (
                            VAL_CONTEXT(target)
                            == AS_CONTEXT(frame->data.context)
                        ) {
                            // Found a closure matching the target before we
                            // reached a breakpoint, no need to retransmit.
                            //
                        #if !defined(NDEBUG)
                            found = TRUE;
                        #endif
                            break;
                        }
                    }
                    else {
                        assert(IS_FUNCTION(target));
                        if (frame->flags & DO_FLAG_FRAME_CONTEXT)
                            continue;
                        if (VAL_FUNC(target) == frame->func) {
                            //
                            // Found a function matching the target before we
                            // reached a breakpoint, no need to retransmit.
                            //
                        #if !defined(NDEBUG)
                            found = TRUE;
                        #endif
                            break;
                        }
                    }
                }

                // RESUME should not have been willing to use a target that
                // is not on the stack.
                //
            #if !defined(NDEBUG)
                assert(found);
            #endif
            }

            if (IS_NONE(mode)) {
                //
                // If the resume instruction had no /DO or /WITH of its own,
                // then it doesn't override whatever the breakpoint provided
                // as a default.  (If neither the breakpoint nor the resume
                // provided a /DO or a /WITH, result will be UNSET.)
                //
                goto return_default; // heeds `target`
            }

            assert(IS_LOGIC(mode));

            if (VAL_LOGIC(mode)) {
                if (DO_VAL_ARRAY_AT_THROWS(&temp, payload)) {
                    //
                    // Throwing is not compatible with /AT currently.
                    //
                    if (!IS_NONE(target))
                        fail (Error_No_Catch_For_Throw(&temp));

                    // Just act as if the BREAKPOINT call itself threw
                    //
                    *out = temp;
                    return TRUE; // TRUE = thrown
                }

                // Ordinary evaluation result...
            }
            else
                temp = *payload;
        }

        // The resume instruction will be GC'd.
        //
        goto return_temp;
    }

    DEAD_END;

return_default:

    if (do_default) {
        if (DO_VAL_ARRAY_AT_THROWS(&temp, default_value)) {
            //
            // If the code throws, we're no longer in the sandbox...so we
            // bubble it up.  Note that breakpoint runs this code at its
            // level... so even if you request a higher target, any throws
            // will be processed as if they originated at the BREAKPOINT
            // frame.  To do otherwise would require the EXIT/FROM protocol
            // to add support for DO-ing at the receiving point.
            //
            *out = temp;
            return TRUE; // TRUE = thrown
        }
    }
    else
        temp = *default_value; // generally UNSET! if no /WITH

return_temp:

    // The easy case is that we just want to return from breakpoint
    // directly, signaled by the target being NONE!.
    //
    if (IS_NONE(target)) {
        *out = temp;
        return FALSE; // FALSE = not thrown
    }

    // If the target is a function, then we're looking to simulate a return
    // from something up the stack.  This uses the same mechanic as
    // definitional returns--a throw named by the function or closure frame.
    //
    // !!! There is a weak spot in definitional returns for FUNCTION! that
    // they can only return to the most recent invocation; which is a weak
    // spot of FUNCTION! in general with stack relative variables.  Also,
    // natives do not currently respond to definitional returns...though
    // they can do so just as well as FUNCTION! can.
    //
    *out = *target;
    CONVERT_NAME_TO_THROWN(out, &temp, TRUE);

    return TRUE; // TRUE = thrown
}
示例#9
0
//
//  Frame_For_Stack_Level: C
//
// Level can be an UNSET!, an INTEGER!, an ANY-FUNCTION!, or a FRAME!.  If
// level is UNSET! then it means give whatever the first call found is.
//
// Returns NULL if the given level number does not correspond to a running
// function on the stack.
//
// Can optionally give back the index number of the stack level (counting
// where the most recently pushed stack level is the lowest #)
//
// !!! Unfortunate repetition of logic inside of BACKTRACE; find a way to
// unify the logic for omitting things like breakpoint frames, or either
// considering pending frames or not...
//
struct Reb_Frame *Frame_For_Stack_Level(
    REBCNT *number_out,
    const REBVAL *level,
    REBOOL skip_current
) {
    struct Reb_Frame *frame = FS_TOP;
    REBOOL first = TRUE;
    REBINT num = 0;

    if (IS_INTEGER(level)) {
        if (VAL_INT32(level) < 0) {
            //
            // !!! fail() here, or just return NULL?
            //
            return NULL;
        }
    }

    // We may need to skip some number of frames, if there have been stack
    // levels added since the numeric reference point that "level" was
    // supposed to refer to has changed.  For now that's only allowed to
    // be one level, because it's rather fuzzy which stack levels to
    // omit otherwise (pending? parens?)
    //
    if (skip_current)
        frame = frame->prior;

    for (; frame != NULL; frame = frame->prior) {
        if (frame->mode != CALL_MODE_FUNCTION) {
            //
            // Don't consider pending calls, or GROUP!, or any non-invoked
            // function as a candidate to target.
            //
            // !!! The inability to target a GROUP! by number is an artifact
            // of implementation, in that there's no hook in Do_Core() at
            // the point of group evaluation to process the return.  The
            // matter is different with a pending function call, because its
            // arguments are only partially processed--hence something
            // like a RESUME/AT or an EXIT/FROM would not know which array
            // index to pick up running from.
            //
            continue;
        }

        if (first) {
            if (
                IS_FUNCTION_AND(FUNC_VALUE(frame->func), FUNC_CLASS_NATIVE)
                && (
                    FUNC_CODE(frame->func) == &N_pause
                    || FUNC_CODE(frame->func) == N_breakpoint
                )
            ) {
                // this is considered the "0".  Return it only if 0 was requested
                // specifically (you don't "count down to it");
                //
                if (IS_INTEGER(level) && num == VAL_INT32(level))
                    goto return_maybe_set_number_out;
                else {
                    first = FALSE;
                    continue;
                }
            }
            else {
                ++num; // bump up from 0
            }
        }

        if (IS_INTEGER(level) && num == VAL_INT32(level))
            goto return_maybe_set_number_out;

        first = FALSE;

        if (frame->mode != CALL_MODE_FUNCTION) {
            //
            // Pending frames don't get numbered
            //
            continue;
        }

        if (IS_UNSET(level) || IS_NONE(level)) {
            //
            // Take first actual frame if unset or none
            //
            goto return_maybe_set_number_out;
        }
        else if (IS_INTEGER(level)) {
            ++num;
            if (num == VAL_INT32(level))
                goto return_maybe_set_number_out;
        }
        else if (IS_FRAME(level)) {
            if (
                (frame->flags & DO_FLAG_FRAME_CONTEXT)
                && frame->data.context == VAL_CONTEXT(level)
            ) {
                goto return_maybe_set_number_out;
            }
        }
        else {
            assert(IS_FUNCTION(level));
            if (VAL_FUNC(level) == frame->func)
                goto return_maybe_set_number_out;
        }
    }

    // Didn't find it...
    //
    return NULL;

return_maybe_set_number_out:
    if (number_out)
        *number_out = num;
    return frame;
}
示例#10
0
文件: a-lib.c 项目: kjanz1899/ren-c
//
//  RL_Do_String: C
// 
// Load a string and evaluate the resulting block.
// 
// Returns:
//     The datatype of the result if a positive number (or 0 if the
//     type has no representation in the "RXT" API).  An error code
//     if it's a negative number.  Two negative numbers are reserved
//     for non-error conditions: -1 for halting (e.g. Escape), and
//     -2 is reserved for exiting with exit_status set.
// 
// Arguments:
//     text - A null terminated UTF-8 (or ASCII) string to transcode
//         into a block and evaluate.
//     flags - set to zero for now
//     result - value returned from evaluation, if NULL then result
//         will be returned on the top of the stack
// 
// Notes:
//     This API was from before Rebol's open sourcing and had little
//     vetting and few clients.  The one client it did have was the
//     "sample" console code (which wound up being the "only"
//     console code for quite some time).
//
RL_API int RL_Do_String(
    int *exit_status,
    const REBYTE *text,
    REBCNT flags,
    RXIARG *out
) {
    REBARR *code;

    struct Reb_State state;
    REBCTX *error;

    REBVAL result;
    VAL_INIT_WRITABLE_DEBUG(&result);

    // assumes it can only be run at the topmost level where
    // the data stack is completely empty.
    //
    assert(DSP == 0);

    PUSH_UNHALTABLE_TRAP(&error, &state);

// The first time through the following code 'error' will be NULL, but...
// `fail` can longjmp here, so 'error' won't be NULL *if* that happens!

    if (error) {
        // Save error for WHY?
        REBVAL *last = Get_System(SYS_STATE, STATE_LAST_ERROR);
        Val_Init_Error(last, error);

        if (ERR_NUM(error) == RE_HALT)
            return -1; // !!! Revisit hardcoded #

        if (out)
            Value_To_RXI(out, last);
        else
            DS_PUSH(last);

        return -ERR_NUM(error);
    }

    code = Scan_Source(text, LEN_BYTES(text));
    PUSH_GUARD_ARRAY(code);

    // Bind into lib or user spaces?
    if (flags) {
        // Top words will be added to lib:
        Bind_Values_Set_Midstream_Shallow(ARR_HEAD(code), Lib_Context);
        Bind_Values_Deep(ARR_HEAD(code), Lib_Context);
    }
    else {
        REBCTX *user = VAL_CONTEXT(Get_System(SYS_CONTEXTS, CTX_USER));

        REBVAL vali;
        VAL_INIT_WRITABLE_DEBUG(&vali);
        SET_INTEGER(&vali, CTX_LEN(user) + 1);

        Bind_Values_All_Deep(ARR_HEAD(code), user);
        Resolve_Context(user, Lib_Context, &vali, FALSE, FALSE);
    }

    if (Do_At_Throws(&result, code, 0)) {
        DROP_GUARD_ARRAY(code);

        if (
            IS_FUNCTION_AND(&result, FUNC_CLASS_NATIVE) && (
                VAL_FUNC_CODE(&result) == &N_quit
                || VAL_FUNC_CODE(&result) == &N_exit
            )
        ) {
            CATCH_THROWN(&result, &result);
            DROP_TRAP_SAME_STACKLEVEL_AS_PUSH(&state);

            *exit_status = Exit_Status_From_Value(&result);
            return -2; // Revisit hardcoded #
        }

        fail (Error_No_Catch_For_Throw(&result));
    }

    DROP_GUARD_ARRAY(code);

    DROP_TRAP_SAME_STACKLEVEL_AS_PUSH(&state);

    if (out)
        Value_To_RXI(out, &result);
    else
        DS_PUSH(&result);

    return Reb_To_RXT[VAL_TYPE_0(&result)];
}
示例#11
0
//
//  Do_String()
//
// This is a version of a routine that was offered by the RL_Api, which has
// been expanded here in order to permit the necessary customizations for
// interesting REPL behavior w.r.t. binding, error handling, and response
// to throws.
//
// !!! Now that this code has been moved into the host, the convoluted
// integer-return-scheme can be eliminated and the code integrated more
// clearly into the surrounding calls.
//
int Do_String(
    int *exit_status,
    REBVAL *out,
    const REBYTE *text,
    REBOOL at_breakpoint
) {
    struct Reb_State state;
    REBCTX *error;

    // Breakpoint REPLs are nested, and we may wish to jump out of them to
    // the topmost level via a HALT.  However, all other errors need to be
    // confined, so that if one is doing evaluations during the pause of
    // a breakpoint an error doesn't "accidentally resume" by virtue of
    // jumping the stack out of the REPL.
    //
    // The topmost layer REPL, however, needs to catch halts in order to
    // keep control and not crash out.
    //
    if (at_breakpoint)
        PUSH_TRAP(&error, &state);
    else
        PUSH_UNHALTABLE_TRAP(&error, &state);

// The first time through the following code 'error' will be NULL, but...
// `fail` can longjmp here, so 'error' won't be NULL *if* that happens!

    if (error) {
        // Save error for WHY?
        REBVAL *last = Get_System(SYS_STATE, STATE_LAST_ERROR);

        if (ERR_NUM(error) == RE_HALT) {
            assert(!at_breakpoint);
            return -1; // !!! Revisit hardcoded #
        }

        Val_Init_Error(out, error);
        *last = *out;
        return -cast(REBINT, ERR_NUM(error));
    }

    REBARR *code = Scan_UTF8_Managed(text, LEN_BYTES(text));

    // Where code ends up being bound when loaded at the REPL prompt should
    // be more generally configurable.  (It may be, for instance, that one
    // wants to run something with it not bound at all.)  Such choices
    // must come from this REPL host...not from the interpreter itself.
    {
        // First the scanned code is bound into the user context with a
        // fallback to the lib context.
        //
        // !!! This code is very old, and is how the REPL has bound since
        // R3-Alpha.  It comes from RL_Do_String, but should receive a modern
        // review of why it's written exactly this way.
        //
        REBCTX *user_ctx = VAL_CONTEXT(Get_System(SYS_CONTEXTS, CTX_USER));

        REBVAL vali;
        SET_INTEGER(&vali, CTX_LEN(user_ctx) + 1);

        Bind_Values_All_Deep(ARR_HEAD(code), user_ctx);
        Resolve_Context(user_ctx, Lib_Context, &vali, FALSE, FALSE);

        // If we're stopped at a breakpoint, the REPL should have a concept
        // of what stack level it is inspecting (conveyed by the |#|>> in the
        // prompt).  This does a binding pass using the function for that
        // stack level, just the way a body is bound during Make_Function()
        //
        if (at_breakpoint) {
            REBVAL level;
            SET_INTEGER(&level, HG_Stack_Level);

            REBFRM *frame = Frame_For_Stack_Level(NULL, &level, FALSE);
            assert(frame);

            // Need to manage because it may be no words get bound into it,
            // and we're not putting it into a FRAME! value, so it might leak
            // otherwise if it's reified.
            //
            REBCTX *frame_ctx = Context_For_Frame_May_Reify_Managed(frame);

            Bind_Values_Deep(ARR_HEAD(code), frame_ctx);
        }

        // !!! This was unused code that used to be in Do_String from
        // RL_Api.  It was an alternative path under `flags` which said
        // "Bind into lib or user spaces?" and then "Top words will be
        // added to lib".  Is it relevant in any way?
        //
        /* Bind_Values_Set_Midstream_Shallow(ARR_HEAD(code), Lib_Context);
        Bind_Values_Deep(ARR_HEAD(code), Lib_Context); */
    }

    if (Do_At_Throws(out, code, 0, SPECIFIED)) { // `code` will be GC protected
        if (at_breakpoint) {
            if (
                IS_FUNCTION(out)
                && VAL_FUNC_DISPATCHER(out) == &N_resume
            ) {
                //
                // This means we're done with the embedded REPL.  We want to
                // resume and may be returning a piece of code that will be
                // run by the finishing BREAKPOINT command in the target
                // environment.
                //
                // We'll never return a halt, so we reuse -1 (in this very
                // temporary scheme built on the very clunky historical REPL,
                // which will not last much longer...fingers crossed.)
                //
                DROP_TRAP_SAME_STACKLEVEL_AS_PUSH(&state);
                CATCH_THROWN(out, out);
                *exit_status = -1;
                return -1;
            }

            if (
                IS_FUNCTION(out)
                && VAL_FUNC_DISPATCHER(out) == &N_quit
            ) {
                //
                // It would be frustrating if the system did not respond to
                // a QUIT and forced you to do `resume/with [quit]`.  So
                // this is *not* caught, rather passed back up with the
                // special -2 status code.
                //
                DROP_TRAP_SAME_STACKLEVEL_AS_PUSH(&state);
                CATCH_THROWN(out, out);
                *exit_status = -2;
                return -2;
            }
        }
        else {
            // We are at the top level REPL, where we catch QUIT and for
            // now, also EXIT as meaning you want to leave.
            //
            if (
                IS_FUNCTION(out)
                && (
                    VAL_FUNC_DISPATCHER(out) == &N_quit
                    || VAL_FUNC_DISPATCHER(out) == &N_exit
                )
            ) {
                DROP_TRAP_SAME_STACKLEVEL_AS_PUSH(&state);
                CATCH_THROWN(out, out);
                *exit_status = Exit_Status_From_Value(out);
                return -2; // Revisit hardcoded #
            }
        }

        fail (Error_No_Catch_For_Throw(out));
    }

    DROP_TRAP_SAME_STACKLEVEL_AS_PUSH(&state);

    return 0;
}
示例#12
0
//
//  Clonify: C
//
// Clone the series embedded in a value *if* it's in the given set of types
// (and if "cloning" makes sense for them, e.g. they are not simple scalars).
//
// Note: The resulting clones will be managed.  The model for lists only
// allows the topmost level to contain unmanaged values...and we *assume* the
// values we are operating on here live inside of an array.
//
void Clonify(
    REBVAL *v,
    REBFLGS flags,
    REBU64 types
){
    if (C_STACK_OVERFLOWING(&types))
        Fail_Stack_Overflow();

    // !!! It may be possible to do this faster/better, the impacts on higher
    // quoting levels could be incurring more cost than necessary...but for
    // now err on the side of correctness.  Unescape the value while cloning
    // and then escape it back.
    //
    REBCNT num_quotes = VAL_NUM_QUOTES(v);
    Dequotify(v);

    enum Reb_Kind kind = cast(enum Reb_Kind, KIND_BYTE_UNCHECKED(v));
    assert(kind < REB_MAX_PLUS_MAX); // we dequoted it (pseudotypes ok)

    if (types & FLAGIT_KIND(kind) & TS_SERIES_OBJ) {
        //
        // Objects and series get shallow copied at minimum
        //
        REBSER *series;
        if (ANY_CONTEXT(v)) {
            INIT_VAL_CONTEXT_VARLIST(
                v,
                CTX_VARLIST(Copy_Context_Shallow_Managed(VAL_CONTEXT(v)))
            );
            series = SER(CTX_VARLIST(VAL_CONTEXT(v)));
        }
        else {
            if (IS_SER_ARRAY(VAL_SERIES(v))) {
                series = SER(
                    Copy_Array_At_Extra_Shallow(
                        VAL_ARRAY(v),
                        0, // !!! what if VAL_INDEX() is nonzero?
                        VAL_SPECIFIER(v),
                        0,
                        NODE_FLAG_MANAGED
                    )
                );

                INIT_VAL_NODE(v, series); // copies args

                // If it was relative, then copying with a specifier
                // means it isn't relative any more.
                //
                INIT_BINDING(v, UNBOUND);
            }
            else {
                series = Copy_Sequence_Core(
                    VAL_SERIES(v),
                    NODE_FLAG_MANAGED
                );
                INIT_VAL_NODE(v, series);
            }
        }

        // If we're going to copy deeply, we go back over the shallow
        // copied series and "clonify" the values in it.
        //
        if (types & FLAGIT_KIND(kind) & TS_ARRAYS_OBJ) {
            REBVAL *sub = KNOWN(ARR_HEAD(ARR(series)));
            for (; NOT_END(sub); ++sub)
                Clonify(sub, flags, types);
        }
    }
    else if (types & FLAGIT_KIND(kind) & FLAGIT_KIND(REB_ACTION)) {
        //
        // !!! While Ren-C has abandoned the concept of copying the body
        // of functions (they are black boxes which may not *have* a
        // body), it would still theoretically be possible to do what
        // COPY does and make a function with a new and independently
        // hijackable identity.  Assume for now it's better that the
        // HIJACK of a method for one object will hijack it for all
        // objects, and one must filter in the hijacking's body if one
        // wants to take more specific action.
        //
        assert(false);
    }
    else {
        // We're not copying the value, so inherit the const bit from the
        // original value's point of view, if applicable.
        //
        if (NOT_CELL_FLAG(v, EXPLICITLY_MUTABLE))
            v->header.bits |= (flags & ARRAY_FLAG_CONST_SHALLOW);
    }

    Quotify(v, num_quotes);
}
示例#13
0
//
//  Specialize_Action_Throws: C
//
// Create a new ACTION! value that uses the same implementation as another,
// but just takes fewer arguments or refinements.  It does this by storing a
// heap-based "exemplar" FRAME! in the specialized action; this stores the
// values to preload in the stack frame cells when it is invoked.
//
// The caller may provide information on the order in which refinements are
// to be specialized, using the data stack.  These refinements should be
// pushed in the *reverse* order of their invocation, so append/dup/part
// has /DUP at DS_TOP, and /PART under it.  List stops at lowest_ordered_dsp.
//
bool Specialize_Action_Throws(
    REBVAL *out,
    REBVAL *specializee,
    REBSTR *opt_specializee_name,
    REBVAL *opt_def, // !!! REVIEW: binding modified directly (not copied)
    REBDSP lowest_ordered_dsp
){
    assert(out != specializee);

    struct Reb_Binder binder;
    if (opt_def)
        INIT_BINDER(&binder);

    REBACT *unspecialized = VAL_ACTION(specializee);

    // This produces a context where partially specialized refinement slots
    // will be on the stack (including any we are adding "virtually", from
    // the current DSP down to the lowest_ordered_dsp).
    //
    REBCTX *exemplar = Make_Context_For_Action_Push_Partials(
        specializee,
        lowest_ordered_dsp,
        opt_def ? &binder : nullptr,
        CELL_MASK_NON_STACK
    );
    Manage_Array(CTX_VARLIST(exemplar)); // destined to be managed, guarded

    if (opt_def) { // code that fills the frame...fully or partially
        //
        // Bind all the SET-WORD! in the body that match params in the frame
        // into the frame.  This means `value: value` can very likely have
        // `value:` bound for assignments into the frame while `value` refers
        // to whatever value was in the context the specialization is running
        // in, but this is likely the more useful behavior.
        //
        // !!! This binds the actual arg data, not a copy of it--following
        // OBJECT!'s lead.  However, ordinary functions make a copy of the
        // body they are passed before rebinding.  Rethink.

        // See Bind_Values_Core() for explanations of how the binding works.

        Bind_Values_Inner_Loop(
            &binder,
            VAL_ARRAY_AT(opt_def),
            exemplar,
            FLAGIT_KIND(REB_SET_WORD), // types to bind (just set-word!)
            0, // types to "add midstream" to binding as we go (nothing)
            BIND_DEEP
        );

        // !!! Only one binder can be in effect, and we're calling arbitrary
        // code.  Must clean up now vs. in loop we do at the end.  :-(
        //
        RELVAL *key = CTX_KEYS_HEAD(exemplar);
        REBVAL *var = CTX_VARS_HEAD(exemplar);
        for (; NOT_END(key); ++key, ++var) {
            if (Is_Param_Unbindable(key))
                continue; // !!! is this flag still relevant?
            if (Is_Param_Hidden(key)) {
                assert(GET_CELL_FLAG(var, ARG_MARKED_CHECKED));
                continue;
            }
            if (GET_CELL_FLAG(var, ARG_MARKED_CHECKED))
                continue; // may be refinement from stack, now specialized out
            Remove_Binder_Index(&binder, VAL_KEY_CANON(key));
        }
        SHUTDOWN_BINDER(&binder);

        // Run block and ignore result (unless it is thrown)
        //
        PUSH_GC_GUARD(exemplar);
        bool threw = Do_Any_Array_At_Throws(out, opt_def, SPECIFIED);
        DROP_GC_GUARD(exemplar);

        if (threw) {
            DS_DROP_TO(lowest_ordered_dsp);
            return true;
        }
    }

    REBVAL *rootkey = CTX_ROOTKEY(exemplar);

    // Build up the paramlist for the specialized function on the stack.
    // The same walk used for that is used to link and process REB_X_PARTIAL
    // arguments for whether they become fully specialized or not.

    REBDSP dsp_paramlist = DSP;
    Move_Value(DS_PUSH(), ACT_ARCHETYPE(unspecialized));

    REBVAL *param = rootkey + 1;
    REBVAL *arg = CTX_VARS_HEAD(exemplar);

    REBDSP ordered_dsp = lowest_ordered_dsp;

    for (; NOT_END(param); ++param, ++arg) {
        if (TYPE_CHECK(param, REB_TS_REFINEMENT)) {
            if (IS_NULLED(arg)) {
                //
                // A refinement that is nulled is a candidate for usage at the
                // callsite.  Hence it must be pre-empted by our ordered
                // overrides.  -but- the overrides only apply if their slot
                // wasn't filled by the user code.  Yet these values we are
                // putting in disrupt that detection (!), so use another
                // flag (PUSH_PARTIAL) to reflect this state.
                //
                while (ordered_dsp != dsp_paramlist) {
                    ++ordered_dsp;
                    REBVAL *ordered = DS_AT(ordered_dsp);

                    if (not IS_WORD_BOUND(ordered))  // specialize 'print/asdf
                        fail (Error_Bad_Refine_Raw(ordered));

                    REBVAL *slot = CTX_VAR(exemplar, VAL_WORD_INDEX(ordered));
                    if (
                        IS_NULLED(slot) or GET_CELL_FLAG(slot, PUSH_PARTIAL)
                    ){
                        // It's still partial, so set up the pre-empt.
                        //
                        Init_Any_Word_Bound(
                            arg,
                            REB_SYM_WORD,
                            VAL_STORED_CANON(ordered),
                            exemplar,
                            VAL_WORD_INDEX(ordered)
                        );
                        SET_CELL_FLAG(arg, PUSH_PARTIAL);
                        goto unspecialized_arg;
                    }
                    // Otherwise the user filled it in, so skip to next...
                }

                goto unspecialized_arg;  // ran out...no pre-empt needed
            }

            if (GET_CELL_FLAG(arg, ARG_MARKED_CHECKED)) {
                assert(
                    IS_BLANK(arg)
                    or (
                        IS_REFINEMENT(arg)
                        and (
                            VAL_REFINEMENT_SPELLING(arg)
                            == VAL_PARAM_SPELLING(param)
                        )
                    )
                );
            }
            else
                Typecheck_Refinement_And_Canonize(param, arg);

            goto specialized_arg_no_typecheck;
        }

        switch (VAL_PARAM_CLASS(param)) {
          case REB_P_RETURN:
          case REB_P_LOCAL:
            assert(IS_NULLED(arg)); // no bindings, you can't set these
            goto unspecialized_arg;

          default:
            break;
        }

        // It's an argument, either a normal one or a refinement arg.

        if (not IS_NULLED(arg))
            goto specialized_arg_with_check;

    unspecialized_arg:

        assert(NOT_CELL_FLAG(arg, ARG_MARKED_CHECKED));
        assert(
            IS_NULLED(arg)
            or (IS_SYM_WORD(arg) and TYPE_CHECK(param, REB_TS_REFINEMENT))
        );
        Move_Value(DS_PUSH(), param);
        continue;

    specialized_arg_with_check:

        // !!! If argument was previously specialized, should have been type
        // checked already... don't type check again (?)
        //
        if (Is_Param_Variadic(param))
            fail ("Cannot currently SPECIALIZE variadic arguments.");

        if (TYPE_CHECK(param, REB_TS_DEQUOTE_REQUOTE) and IS_QUOTED(arg)) {
            //
            // Have to leave the quotes on, but still want to type check.

            if (not TYPE_CHECK(param, CELL_KIND(VAL_UNESCAPED(arg))))
                fail (arg); // !!! merge w/Error_Invalid_Arg()
        }
        else if (not TYPE_CHECK(param, VAL_TYPE(arg)))
            fail (arg); // !!! merge w/Error_Invalid_Arg()

       SET_CELL_FLAG(arg, ARG_MARKED_CHECKED);

    specialized_arg_no_typecheck:

        // Specialized-out arguments must still be in the parameter list,
        // for enumeration in the evaluator to line up with the frame values
        // of the underlying function.

        assert(GET_CELL_FLAG(arg, ARG_MARKED_CHECKED));
        Move_Value(DS_PUSH(), param);
        TYPE_SET(DS_TOP, REB_TS_HIDDEN);
        continue;
    }

    REBARR *paramlist = Pop_Stack_Values_Core(
        dsp_paramlist,
        SERIES_MASK_PARAMLIST
            | (SER(unspecialized)->header.bits & PARAMLIST_MASK_INHERIT)
    );
    Manage_Array(paramlist);
    RELVAL *rootparam = ARR_HEAD(paramlist);
    VAL_ACT_PARAMLIST_NODE(rootparam) = NOD(paramlist);

    // Everything should have balanced out for a valid specialization
    //
    while (ordered_dsp != DSP) {
        ++ordered_dsp;
        REBVAL *ordered = DS_AT(ordered_dsp);
        if (not IS_WORD_BOUND(ordered))  // specialize 'print/asdf
            fail (Error_Bad_Refine_Raw(ordered));

        REBVAL *slot = CTX_VAR(exemplar, VAL_WORD_INDEX(ordered));
        assert(not IS_NULLED(slot) and NOT_CELL_FLAG(slot, PUSH_PARTIAL));
        UNUSED(slot);
    }
    DS_DROP_TO(lowest_ordered_dsp);

    // See %sysobj.r for `specialized-meta:` object template

    REBVAL *example = Get_System(SYS_STANDARD, STD_SPECIALIZED_META);

    REBCTX *meta = Copy_Context_Shallow_Managed(VAL_CONTEXT(example));

    Init_Nulled(CTX_VAR(meta, STD_SPECIALIZED_META_DESCRIPTION)); // default
    Move_Value(
        CTX_VAR(meta, STD_SPECIALIZED_META_SPECIALIZEE),
        specializee
    );
    if (not opt_specializee_name)
        Init_Nulled(CTX_VAR(meta, STD_SPECIALIZED_META_SPECIALIZEE_NAME));
    else
        Init_Word(
            CTX_VAR(meta, STD_SPECIALIZED_META_SPECIALIZEE_NAME),
            opt_specializee_name
        );

    MISC_META_NODE(paramlist) = NOD(meta);

    REBACT *specialized = Make_Action(
        paramlist,
        &Specializer_Dispatcher,
        ACT_UNDERLYING(unspecialized), // same underlying action as this
        exemplar, // also provide a context of specialization values
        1 // details array capacity
    );
    assert(CTX_KEYLIST(exemplar) == ACT_PARAMLIST(unspecialized));

    assert(
        GET_ACTION_FLAG(specialized, IS_INVISIBLE)
        == GET_ACTION_FLAG(unspecialized, IS_INVISIBLE)
    );

    // The "body" is the FRAME! value of the specialization.  It takes on the
    // binding we want to use (which we can't put in the exemplar archetype,
    // that binding has to be UNBOUND).  It also remembers the original
    // action in the phase, so Specializer_Dispatcher() knows what to call.
    //
    RELVAL *body = ARR_HEAD(ACT_DETAILS(specialized));
    Move_Value(body, CTX_ARCHETYPE(exemplar));
    INIT_BINDING(body, VAL_BINDING(specializee));
    INIT_VAL_CONTEXT_PHASE(body, unspecialized);

    Init_Action_Unbound(out, specialized);
    return false; // code block did not throw
}
示例#14
0
文件: f-series.c 项目: rgchris/ren-c
//
//  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;
}