static REBOOL Same_Func(REBVAL *val, REBVAL *arg)
{
if (VAL_TYPE(val) == VAL_TYPE(arg) &&
VAL_FUNC_SPEC(val) == VAL_FUNC_SPEC(arg) &&
VAL_FUNC_ARGS(val) == VAL_FUNC_ARGS(arg) &&
VAL_FUNC_CODE(val) == VAL_FUNC_CODE(arg)) return TRUE;
return FALSE;
}
*/ 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));
}
*/ 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);
}
*/ 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;
}
*/ 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;
}
*/ 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;
}
*/ void Make_Native(REBVAL *value, REBSER *spec, REBFUN func, REBINT type)
/*
***********************************************************************/
{
//Print("Make_Native: %s spec %d", Get_Sym_Name(type+1), SERIES_TAIL(spec));
VAL_FUNC_SPEC(value) = spec;
VAL_FUNC_ARGS(value) = Check_Func_Spec(spec);
VAL_FUNC_CODE(value) = func;
VAL_SET(value, type);
}
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);
}
*/ void Do_Action(REBVAL *func)
/*
***********************************************************************/
{
REBVAL *ds = DS_OUT;
REBCNT type = VAL_TYPE(D_ARG(1));
Eval_Natives++;
assert(type < REB_MAX);
// Handle special datatype test cases (eg. integer?)
if (VAL_FUNC_ACT(func) == 0) {
VAL_SET(D_OUT, REB_LOGIC);
VAL_LOGIC(D_OUT) = (type == VAL_INT64(BLK_LAST(VAL_FUNC_SPEC(func))));
return;
}
Do_Act(D_OUT, type, VAL_FUNC_ACT(func));
}