Пример #1
0
*/	REBFLG Make_Function(REBCNT type, REBVAL *value, REBVAL *def)
/*
***********************************************************************/
{
	REBVAL *spec;
	REBVAL *body;
	REBCNT len;

	if (
		!IS_BLOCK(def)
		|| (len = VAL_LEN(def)) < 2
		|| !IS_BLOCK(spec = VAL_BLK(def))
	) return FALSE;

	body = VAL_BLK_SKIP(def, 1);

	VAL_FUNC_SPEC(value) = VAL_SERIES(spec);
	VAL_FUNC_ARGS(value) = Check_Func_Spec(VAL_SERIES(spec));

	if (type != REB_COMMAND) {
		if (len != 2 || !IS_BLOCK(body)) return FALSE;
		VAL_FUNC_BODY(value) = VAL_SERIES(body);
	}
	else
		Make_Command(value, def);

	VAL_SET(value, type);

	if (type == REB_FUNCTION || type == REB_CLOSURE)
		Bind_Relative(VAL_FUNC_ARGS(value), VAL_FUNC_ARGS(value), VAL_FUNC_BODY(value));

	return TRUE;
}
Пример #2
0
*/	REBFLG Copy_Function(REBVAL *value, REBVAL *args)
/*
***********************************************************************/
{
	REBVAL *spec = VAL_BLK(args);
	REBVAL *body = VAL_BLK_SKIP(args, 1);

	if (IS_END(spec)) body = 0;
	else {
		// Spec given, must be block or *
		if (IS_BLOCK(spec)) {
			VAL_FUNC_SPEC(value) = VAL_SERIES(spec);
			VAL_FUNC_ARGS(value) = Check_Func_Spec(VAL_SERIES(spec));
		} else
			if (!IS_STAR(spec)) return FALSE;
	}

	if (body && !IS_END(body)) {
		if (!IS_FUNCTION(value) && !IS_CLOSURE(value)) return FALSE;
		// Body must be block:
		if (!IS_BLOCK(body)) return FALSE;
		VAL_FUNC_BODY(value) = VAL_SERIES(body);
	}
	// No body, use protytpe:
	else if (IS_FUNCTION(value) || IS_CLOSURE(value))
		VAL_FUNC_BODY(value) = Clone_Block(VAL_FUNC_BODY(value));

	// Rebind function words:
	if (IS_FUNCTION(value))
		Bind_Relative(VAL_FUNC_ARGS(value), VAL_FUNC_BODY(value), VAL_FUNC_BODY(value));

	return TRUE;
}
Пример #3
0
*/	void Do_Command(REBVAL *value)
/*
**	Evaluates the arguments for a command function and creates
**	a resulting stack frame (struct or object) for command processing.
**
**	A command value consists of:
**		args - same as other funcs
**		spec - same as other funcs
**		body - [ext-obj func-index]
**
***********************************************************************/
{
	REBVAL *val = BLK_HEAD(VAL_FUNC_BODY(value));
	REBEXT *ext;
	REBCNT cmd;
	REBCNT argc;
	REBCNT n;
	RXIFRM frm;	// args stored here

	// All of these were checked above on definition:
	val = BLK_HEAD(VAL_FUNC_BODY(value));
	cmd = (int)VAL_INT64(val+1);
	ext = &Ext_List[VAL_I32(VAL_OBJ_VALUE(val, 1))]; // Handler

	// Copy args to command frame (array of args):
	RXA_COUNT(&frm) = argc = SERIES_TAIL(VAL_FUNC_ARGS(value))-1; // not self
	if (argc > 7) Trap0(RE_BAD_COMMAND);
	val = DS_ARG(1);
	for (n = 1; n <= argc; n++, val++) {
		RXA_TYPE(&frm, n) = Reb_To_RXT[VAL_TYPE(val)];
		frm.args[n] = Value_To_RXI(val);
	}

	// Call the command:
	n = ext->call(cmd, &frm, 0);
	val = DS_RETURN;
	switch (n) {
	case RXR_VALUE:
		RXI_To_Value(val, frm.args[1], RXA_TYPE(&frm, 1));
		break;
	case RXR_BLOCK:
		RXI_To_Block(&frm, val);
		break;
	case RXR_UNSET:
		SET_UNSET(val);
		break;
	case RXR_NONE:
		SET_NONE(val);
		break;
	case RXR_TRUE:
		SET_TRUE(val);
		break;
	case RXR_FALSE:
		SET_FALSE(val);
		break;
	case RXR_ERROR:
	default:
		SET_UNSET(val);
	}
}
Пример #4
0
*/	REBFLG Make_Function(REBCNT type, REBVAL *value, REBVAL *def)
/*
***********************************************************************/
{
	REBVAL *spec;
	REBVAL *body;
	REBCNT len;

	if (
		!IS_BLOCK(def)
////		|| type < REB_CLOSURE // for now
		|| (len = VAL_LEN(def)) < 2
		|| !IS_BLOCK(spec = VAL_BLK(def))
	) return FALSE;

	body = VAL_BLK_SKIP(def, 1);

	//	Print("Make_Func"); //: %s spec %d", Get_Sym_Name(type+1), SERIES_TAIL(spec));
	VAL_FUNC_SPEC(value) = VAL_SERIES(spec);
	VAL_FUNC_ARGS(value) = Check_Func_Spec(VAL_SERIES(spec));

	if (type != REB_COMMAND) {
		if (len != 2 || !IS_BLOCK(body)) return FALSE;
		VAL_FUNC_BODY(value) = VAL_SERIES(body);
	}
	else
		Make_Command(value, def);

	VAL_SET(value, type);

	if (type == REB_FUNCTION)
		Bind_Relative(VAL_FUNC_ARGS(value), VAL_FUNC_BODY(value), VAL_FUNC_BODY(value));

	return TRUE;
}
Пример #5
0
*/	void Clone_Function(REBVAL *value, REBVAL *func)
/*
***********************************************************************/
{
	VAL_FUNC_SPEC(value) = VAL_FUNC_SPEC(func);
	VAL_FUNC_ARGS(value) = VAL_FUNC_ARGS(func);
	VAL_FUNC_BODY(value) = Clone_Block(VAL_FUNC_BODY(func));
}
Пример #6
0
*/	void Do_Function(REBVAL *func)
/*
***********************************************************************/
{
	REBVAL *result;
	REBVAL *ds;

#if !defined(NDEBUG)
	const REBYTE *name = Get_Word_Name(DSF_LABEL(DSF));
#endif

	Eval_Functions++;

	//Dump_Block(VAL_FUNC_BODY(func));
	result = Do_Blk(VAL_FUNC_BODY(func), 0);
	ds = DS_OUT;

	if (IS_ERROR(result) && IS_RETURN(result)) {
		// Value below is kept safe from GC because no-allocation is
		// done between point of SET_THROW and here.
		if (VAL_ERR_VALUE(result))
			*ds = *VAL_ERR_VALUE(result);
		else
			SET_UNSET(ds);
	}
	else *ds = *result; // Set return value (atomic)
}
Пример #7
0
static REBOOL Same_Func(const RELVAL *val, const RELVAL *arg)
{
    assert(IS_FUNCTION(val) && IS_FUNCTION(arg));

    if (VAL_FUNC_PARAMLIST(val) == VAL_FUNC_PARAMLIST(arg)) {
        assert(VAL_FUNC_DISPATCHER(val) == VAL_FUNC_DISPATCHER(arg));
        assert(VAL_FUNC_BODY(val) == VAL_FUNC_BODY(arg));

        // All functions that have the same paramlist are not necessarily the
        // "same function".  For instance, every RETURN shares a common
        // paramlist, but the binding is different in the REBVAL instances
        // in order to know where to "exit from".

        return LOGICAL(VAL_BINDING(val) == VAL_BINDING(arg));
    }

    return FALSE;
}
Пример #8
0
*/  void Bind_Frame(REBSER *obj)
/*
**      Clone a frame, knowing which types of values need to be
**		copied, deep copied, and rebound.
**
***********************************************************************/
{
	REBVAL *val;
	REBOOL funcs = FALSE;

	//DISABLE_GC;
	// Copy functions:
	for (val = BLK_SKIP(obj, 1); NOT_END(val); val++) {
		if (IS_FUNCTION(val)) {
			Clone_Function(val, val); 
			funcs = TRUE;
		}
		else if (IS_CLOSURE(val)) {
			funcs = TRUE;
		}
	}

	// Rebind all values:
	Bind_Block(obj, BLK_SKIP(obj, 1), BIND_DEEP | BIND_FUNC);

	if (funcs) {
		// Rebind functions:
		for (val = BLK_SKIP(obj, 1); NOT_END(val); val++) {
			if (IS_FUNCTION(val)) {
				Bind_Relative(VAL_FUNC_ARGS(val), VAL_FUNC_BODY(val), VAL_FUNC_BODY(val));
			}
			else if (IS_CLOSURE(val)) {
			}
		}
	}

	//ENABLE_GC;
}
Пример #9
0
STOID Mold_Function(REBVAL *value, REB_MOLD *mold)
{
	Pre_Mold(value, mold);

	Append_Byte(mold->series, '[');

	Mold_Block_Series(mold, VAL_FUNC_SPEC(value), 0, 0); //// & ~(1<<MOPT_MOLD_ALL)); // Never literalize it (/all).

	if (IS_FUNCTION(value) || IS_CLOSURE(value))
		Mold_Block_Series(mold, VAL_FUNC_BODY(value), 0, 0);

	Append_Byte(mold->series, ']');
	End_Mold(mold);
}
Пример #10
0
*/  static void Bind_Block_Words(REBSER *frame, REBVAL *value, REBCNT mode)
/*
**      Inner loop of bind block. Modes are:
**
**          BIND_ONLY    Only bind the words found in the frame.
**          BIND_SET     Add set-words to the frame during the bind.
**          BIND_ALL     Add words to the frame during the bind.
**          BIND_DEEP    Recurse into sub-blocks.
**
**      NOTE: BIND_SET must be used carefully, because it does not
**      bind prior instances of the word before the set-word. That is
**      forward references are not allowed.
**
***********************************************************************/
{
	REBINT *binds = WORDS_HEAD(Bind_Table); // GC safe to do here
	REBCNT n;
	REBFLG selfish = !IS_SELFLESS(frame);

	for (; NOT_END(value); value++) {
		if (ANY_WORD(value)) {
			//Print("Word: %s", Get_Sym_Name(VAL_WORD_CANON(value)));
			// Is the word found in this frame?
			if (NZ(n = binds[VAL_WORD_CANON(value)])) {
				if (n == NO_RESULT) n = 0; // SELF word
				ASSERT1(n < SERIES_TAIL(frame), RP_BIND_BOUNDS);
				// Word is in frame, bind it:
				VAL_WORD_INDEX(value) = n;
				VAL_WORD_FRAME(value) = frame;
			}
			else if (selfish && VAL_WORD_CANON(value) == SYM_SELF) {
				VAL_WORD_INDEX(value) = 0;
				VAL_WORD_FRAME(value) = frame;
			}
			else {
				// Word is not in frame. Add it if option is specified:
				if ((mode & BIND_ALL) || ((mode & BIND_SET) && (IS_SET_WORD(value)))) {
					Append_Frame(frame, value, 0);
					binds[VAL_WORD_CANON(value)] = VAL_WORD_INDEX(value);
				}
			}
		}
		else if (ANY_BLOCK(value) && (mode & BIND_DEEP))
			Bind_Block_Words(frame, VAL_BLK_DATA(value), mode);
		else if ((IS_FUNCTION(value) || IS_CLOSURE(value)) && (mode & BIND_FUNC))
			Bind_Block_Words(frame, BLK_HEAD(VAL_FUNC_BODY(value)), mode);
	}
}
Пример #11
0
*/  static void Bind_Values_Inner_Loop(REBINT *binds, REBVAL value[], REBSER *frame, REBCNT mode)
/*
**		Bind_Values_Core() sets up the binding table and then calls
**		this recursive routine to do the actual binding.
**
***********************************************************************/
{
	REBFLG selfish = !IS_SELFLESS(frame);

	for (; NOT_END(value); value++) {
		if (ANY_WORD(value)) {
			//Print("Word: %s", Get_Sym_Name(VAL_WORD_CANON(value)));
			// Is the word found in this frame?
			REBCNT n = binds[VAL_WORD_CANON(value)];
			if (n != 0) {
				if (n == NO_RESULT) n = 0; // SELF word
				assert(n < SERIES_TAIL(frame));
				// Word is in frame, bind it:
				VAL_WORD_INDEX(value) = n;
				VAL_WORD_FRAME(value) = frame;
			}
			else if (selfish && VAL_WORD_CANON(value) == SYM_SELF) {
				VAL_WORD_INDEX(value) = 0;
				VAL_WORD_FRAME(value) = frame;
			}
			else {
				// Word is not in frame. Add it if option is specified:
				if ((mode & BIND_ALL) || ((mode & BIND_SET) && (IS_SET_WORD(value)))) {
					Expand_Frame(frame, 1, 1);
					Append_Frame(frame, value, 0);
					binds[VAL_WORD_CANON(value)] = VAL_WORD_INDEX(value);
				}
			}
		}
		else if (ANY_BLOCK(value) && (mode & BIND_DEEP))
			Bind_Values_Inner_Loop(
				binds, VAL_BLK_DATA(value), frame, mode
			);
		else if ((IS_FUNCTION(value) || IS_CLOSURE(value)) && (mode & BIND_FUNC))
			Bind_Values_Inner_Loop(
				binds, BLK_HEAD(VAL_FUNC_BODY(value)), frame, mode
			);
	}
}
Пример #12
0
*/	void Do_Closure(REBVAL *func)
/*
**		Do a closure by cloning its body and binding it to
**		a new frame of words/values.
**
**		This could be made faster by pre-binding the body,
**		then using Rebind_Block to rebind the words in it.
**
***********************************************************************/
{
	REBSER *body;
	REBSER *frame;
	REBVAL *result;
	REBVAL *ds;

	Eval_Functions++;
	//DISABLE_GC;

	// Clone the body of the function to allow rebinding to it:
	body = Clone_Block(VAL_FUNC_BODY(func));

	// Copy stack frame args as the closure object (one extra at head)
	frame = Copy_Values(BLK_SKIP(DS_Series, DS_ARG_BASE), SERIES_TAIL(VAL_FUNC_ARGS(func)));
	SET_FRAME(BLK_HEAD(frame), 0, VAL_FUNC_ARGS(func));

	// Rebind the body to the new context (deeply):
	//Rebind_Block(VAL_FUNC_ARGS(func), frame, body);
	Bind_Block(frame, BLK_HEAD(body), BIND_DEEP); // | BIND_NO_SELF);

	ds = DS_RETURN;
	SET_OBJECT(ds, body); // keep it GC safe
	result = Do_Blk(body, 0); // GC-OK - also, result returned on DS stack
	ds = DS_RETURN;

	if (IS_ERROR(result) && IS_RETURN(result)) {
		// Value below is kept safe from GC because no-allocation is
		// done between point of SET_THROW and here.
		if (VAL_ERR_VALUE(result))
			*ds = *VAL_ERR_VALUE(result);
		else
			SET_UNSET(ds);
	}
	else *ds = *result; // Set return value (atomic)
}
Пример #13
0
*/	void Clone_Function(REBVAL *value, REBVAL *func)
/*
***********************************************************************/
{
	REBSER *src_frame = VAL_FUNC_ARGS(func);

	VAL_FUNC_SPEC(value) = VAL_FUNC_SPEC(func);
	VAL_FUNC_BODY(value) = Clone_Block(VAL_FUNC_BODY(func));
	VAL_FUNC_ARGS(value) = Copy_Block(src_frame, 0);
	// VAL_FUNC_BODY(value) = Clone_Block(VAL_FUNC_BODY(func));
	VAL_FUNC_BODY(value) = Copy_Block_Values(VAL_FUNC_BODY(func), 0, SERIES_TAIL(VAL_FUNC_BODY(func)), TS_CLONE);
	Rebind_Block(src_frame, VAL_FUNC_ARGS(value), BLK_HEAD(VAL_FUNC_BODY(value)), 0);
}
Пример #14
0
//
//  Rebind_Values_Deep: C
//
// Rebind all words that reference src target to dst target.
// Rebind is always deep.
//
void Rebind_Values_Deep(
    REBCTX *src,
    REBCTX *dst,
    RELVAL *head,
    struct Reb_Binder *opt_binder
) {
    RELVAL *value = head;
    for (; NOT_END(value); value++) {
        if (ANY_ARRAY(value)) {
            Rebind_Values_Deep(src, dst, VAL_ARRAY_AT(value), opt_binder);
        }
        else if (
            ANY_WORD(value)
            && GET_VAL_FLAG(value, WORD_FLAG_BOUND)
            && !GET_VAL_FLAG(value, VALUE_FLAG_RELATIVE)
            && VAL_WORD_CONTEXT(KNOWN(value)) == src
        ) {
            INIT_WORD_CONTEXT(value, dst);

            if (opt_binder != NULL) {
                INIT_WORD_INDEX(
                    value,
                    Try_Get_Binder_Index(opt_binder, VAL_WORD_CANON(value))
                );
            }
        }
        else if (IS_FUNCTION(value) && IS_FUNCTION_INTERPRETED(value)) {
            //
            // !!! Extremely questionable feature--walking into function
            // bodies and changing them.  This R3-Alpha concept was largely
            // broken (didn't work for closures) and created a lot of extra
            // garbage (inheriting an object's methods meant making deep
            // copies of all that object's method bodies...each time).
            // Ren-C has a different idea in the works.
            //
            Rebind_Values_Deep(
                src, dst, VAL_FUNC_BODY(value), opt_binder
            );
        }
    }
}
Пример #15
0
*/	void Make_Command(REBVAL *value, REBVAL *def)
/*
**		Assumes prior function has already stored the spec and args
**		series. This function validates the body.
**
***********************************************************************/
{
	REBVAL *args = BLK_HEAD(VAL_FUNC_ARGS(value));
	REBCNT n;
	REBVAL *val = VAL_BLK_SKIP(def, 1);
	REBEXT *ext;

	if (
		VAL_LEN(def) != 3
		|| !(IS_MODULE(val) || IS_OBJECT(val))
		|| !IS_HANDLE(VAL_OBJ_VALUE(val, 1))
		|| !IS_INTEGER(val+1)
		|| VAL_INT64(val+1) > 0xffff
	) Trap1(RE_BAD_FUNC_DEF, def);

	val = VAL_OBJ_VALUE(val, 1);
	if (
		!(ext = &Ext_List[VAL_I32(val)])
		|| !(ext->call)
	) Trap1(RE_BAD_EXTENSION, def);

	// make command! [[arg-spec] handle cmd-index]
	VAL_FUNC_BODY(value) = Copy_Block_Len(VAL_SERIES(def), 1, 2);

	// Check for valid command arg datatypes:
	args++; // skip self
	n = 1;
	for (; NOT_END(args); args++, n++) {
		// If the typeset contains args that are not valid:
		// (3 is the default when no args given, for not END and UNSET)
		if (3 != ~VAL_TYPESET(args) && (VAL_TYPESET(args) & ~RXT_ALLOWED_TYPES))
			Trap1(RE_BAD_FUNC_ARG, args);
	}

	VAL_SET(value, REB_COMMAND);
}
Пример #16
0
*/  void Rebind_Block(REBSER *src_frame, REBSER *dst_frame, REBVAL *data, REBFLG modes)
/*
**      Rebind all words that reference src frame to dst frame.
**      Rebind is always deep.
**
**		There are two types of frames: relative frames and normal frames.
**		When frame_src type and frame_dst type differ,
**		modes must have REBIND_TYPE.
**
***********************************************************************/
{
	REBINT *binds = WORDS_HEAD(Bind_Table);

	for (; NOT_END(data); data++) {
		if (ANY_BLOCK(data))
			Rebind_Block(src_frame, dst_frame, VAL_BLK_DATA(data), modes);
		else if (ANY_WORD(data) && VAL_WORD_FRAME(data) == src_frame) {
			VAL_WORD_FRAME(data) = dst_frame;
			if (modes & REBIND_TABLE) VAL_WORD_INDEX(data) = binds[VAL_WORD_CANON(data)];
			if (modes & REBIND_TYPE) VAL_WORD_INDEX(data) = - VAL_WORD_INDEX(data);
		} else if ((modes & REBIND_FUNC) && (IS_FUNCTION(data) || IS_CLOSURE(data)))
			Rebind_Block(src_frame, dst_frame, BLK_HEAD(VAL_FUNC_BODY(data)), modes);
	}
}
Пример #17
0
*/	REBINT Cmp_Value(REBVAL *s, REBVAL *t, REBFLG is_case)
/*
**		Compare two values and return the difference.
**
**		is_case TRUE for case sensitive compare
**
***********************************************************************/
{
	REBDEC	d1, d2;

	if (VAL_TYPE(t) != VAL_TYPE(s) && !(IS_NUMBER(s) && IS_NUMBER(t)))
		return VAL_TYPE(s) - VAL_TYPE(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_DECIMAL:
	case REB_MONEY:
			d1 = VAL_DECIMAL(s);
		if (IS_INTEGER(t))
			d2 = (REBDEC)VAL_INT64(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_PAREN:
	case REB_MAP:
	case REB_PATH:
	case REB_SET_PATH:
	case REB_GET_PATH:
	case REB_LIT_PATH:
		return Cmp_Block(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, (REBOOL)!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_DATATYPE(s) - VAL_DATATYPE(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(s);

	case REB_OBJECT:
	case REB_MODULE:
	case REB_PORT:
		return VAL_OBJ_FRAME(s) - VAL_OBJ_FRAME(t);

	case REB_NATIVE:
		return &VAL_FUNC_CODE(s) - &VAL_FUNC_CODE(t);

	case REB_ACTION:
	case REB_COMMAND:
	case REB_OP:
	case REB_FUNCTION:
		return VAL_FUNC_BODY(s) - VAL_FUNC_BODY(t);

	case REB_NONE:
	case REB_UNSET:
	case REB_END:
	default:
		break;

	}
	return 0;
}
Пример #18
0
//
//  Bind_Values_Inner_Loop: C
//
// Bind_Values_Core() sets up the binding table and then calls
// this recursive routine to do the actual binding.
//
static void Bind_Values_Inner_Loop(
    struct Reb_Binder *binder,
    RELVAL *head,
    REBCTX *context,
    REBU64 bind_types, // !!! REVIEW: force word types low enough for 32-bit?
    REBU64 add_midstream_types,
    REBFLGS flags
) {
    RELVAL *value = head;
    for (; NOT_END(value); value++) {
        REBU64 type_bit = FLAGIT_KIND(VAL_TYPE(value));

        if (type_bit & bind_types) {
            REBSTR *canon = VAL_WORD_CANON(value);
            REBCNT n = Try_Get_Binder_Index(binder, canon);
            if (n != 0) {
                assert(n <= CTX_LEN(context));

                // We're overwriting any previous binding, which may have
                // been relative.
                //
                CLEAR_VAL_FLAG(value, VALUE_FLAG_RELATIVE);

                SET_VAL_FLAG(value, WORD_FLAG_BOUND);
                INIT_WORD_CONTEXT(value, context);
                INIT_WORD_INDEX(value, n);
            }
            else if (type_bit & add_midstream_types) {
                //
                // Word is not in context, so add it if option is specified
                //
                Expand_Context(context, 1);
                Append_Context(context, value, 0);
                Add_Binder_Index(binder, canon, VAL_WORD_INDEX(value));
            }
        }
        else if (ANY_ARRAY(value) && (flags & BIND_DEEP)) {
            Bind_Values_Inner_Loop(
                binder,
                VAL_ARRAY_AT(value),
                context,
                bind_types,
                add_midstream_types,
                flags
            );
        }
        else if (
            IS_FUNCTION(value)
            && IS_FUNCTION_INTERPRETED(value)
            && (flags & BIND_FUNC)
        ) {
            // !!! Likely-to-be deprecated functionality--rebinding inside the
            // content of an already formed function.  :-/
            //
            Bind_Values_Inner_Loop(
                binder,
                VAL_FUNC_BODY(value),
                context,
                bind_types,
                add_midstream_types,
                flags
            );
        }
    }
}
Пример #19
0
*/	void Do_Commands(REBSER *cmds, void *context)
/*
**		Evaluate a block of commands as efficiently as possible.
**		The arguments to each command must already be reduced or
**		use only variable lookup.
**
**		Returns the last evaluated value, if provided.
**
***********************************************************************/
{
	REBVAL *blk;
	REBCNT index = 0;
	REBVAL *set_word = 0;
	REBVAL *cmd_word;
	REBSER *words;
	REBVAL *args;
	REBVAL *val;
	REBVAL *func;
	RXIFRM frm;	// args stored here
	REBCNT n;
	REBEXT *ext;
	REBCEC *ctx;

	if ((ctx = context)) ctx->block = cmds;
	blk = BLK_HEAD(cmds);

	while (NOT_END(blk)) {

		// var: command result
		if IS_SET_WORD(blk) {
			set_word = blk++;
			index++;
		};

		// get command function
		if (IS_WORD(cmd_word = blk)) {
			// Optimized var fetch:
			n = VAL_WORD_INDEX(blk);
			if (n > 0) func = FRM_VALUES(VAL_WORD_FRAME(blk)) + n;
			else func = Get_Var(blk); // fallback
		} else func = blk;

		if (!IS_COMMAND(func)) Trap2(RE_EXPECT_VAL, Get_Type_Word(REB_COMMAND), blk);

		// Advance to next value
		blk++;
		if (ctx) ctx->index = index; // position of function
		index++;

		// get command arguments and body
		words = VAL_FUNC_WORDS(func);
		RXA_COUNT(&frm) = SERIES_TAIL(VAL_FUNC_ARGS(func))-1; // not self

		// collect each argument (arg list already validated on MAKE)
		n = 0;
		for (args = BLK_SKIP(words, 1); NOT_END(args); args++) {

			//Debug_Type(args);
			val = blk++;
			index++;
			if (IS_END(val)) Trap2(RE_NO_ARG, cmd_word, args);
			//Debug_Type(val);

			// actual arg is a word, lookup?
			if (VAL_TYPE(val) >= REB_WORD) {
				if (IS_WORD(val)) {
					if (IS_WORD(args)) val = Get_Var(val);
				}
				else if (IS_PATH(val)) {
					if (IS_WORD(args)) val = Get_Any_Var(val); // volatile value!
				}
				else if (IS_PAREN(val)) {
					val = Do_Blk(VAL_SERIES(val), 0); // volatile value!
				}
				// all others fall through
			}

			// check datatype
			if (!TYPE_CHECK(args, VAL_TYPE(val)))
				Trap3(RE_EXPECT_ARG, cmd_word, args, Of_Type(val));

			// put arg into command frame
			n++;
			RXA_TYPE(&frm, n) = Reb_To_RXT[VAL_TYPE(val)];
			frm.args[n] = Value_To_RXI(val);
		}

		// Call the command (also supports different extension modules):
		func  = BLK_HEAD(VAL_FUNC_BODY(func));
		n = (REBCNT)VAL_INT64(func + 1);
		ext = &Ext_List[VAL_I32(VAL_OBJ_VALUE(func, 1))]; // Handler
		n = ext->call(n, &frm, context);
		val = DS_RETURN;
		switch (n) {
		case RXR_VALUE:
			RXI_To_Value(val, frm.args[1], RXA_TYPE(&frm, 1));
			break;
		case RXR_BLOCK:
			RXI_To_Block(&frm, val);
			break;
		case RXR_UNSET:
			SET_UNSET(val);
			break;
		case RXR_NONE:
			SET_NONE(val);
			break;
		case RXR_TRUE:
			SET_TRUE(val);
			break;
		case RXR_FALSE:
			SET_FALSE(val);
			break;
		case RXR_ERROR:
		default:
			SET_UNSET(val);
		}

		if (set_word) {
			Set_Var(set_word, val);
			set_word = 0;
		}
	}
}