Exemplo n.º 1
0
*/  REBSER *Make_Object(REBSER *parent, REBVAL *block)
/*
**      Create an object from a parent object and a spec block.
**		The words within the resultant object are not bound.
**
***********************************************************************/
{
	REBSER *words;
	REBSER *object;

	PG_Reb_Stats->Objects++;

	if (!block || IS_END(block)) {
		object = parent ? Clone_Block(parent) : Make_Frame(0);
	} else {
		words = Collect_Frame(BIND_ONLY, parent, block); // GC safe
		object = Create_Frame(words, 0); // GC safe
		if (parent) {
			if (Reb_Opts->watch_obj_copy)
				Debug_Fmt(BOOT_STR(RS_WATCH, 2), SERIES_TAIL(parent) - 1, FRM_WORD_SERIES(object));
			// Copy parent values and deep copy blocks and strings:
			COPY_VALUES(FRM_VALUES(parent)+1, FRM_VALUES(object)+1, SERIES_TAIL(parent) - 1);
			Copy_Deep_Values(object, 1, SERIES_TAIL(object), TS_CODE);
			//Copy_Block_xDeep(object, 1, 0, COPY_OBJECT | COPY_SAME);
		}
	}

	//Dump_Frame(object);
	return object;
}
Exemplo n.º 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;
}
Exemplo n.º 3
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));
}
Exemplo n.º 4
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);
}
Exemplo n.º 5
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)
}