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;
}
x*/ REBRXT Do_Callback(REBSER *obj, u32 name, RXIARG *rxis, RXIARG *result)
/*
** Given an object and a word id, call a REBOL function.
** The arguments are converted from extension format directly
** to the data stack. The result is passed back in ext format,
** with the datatype returned or zero if there was a problem.
**
***********************************************************************/
{
REBVAL *val;
struct Reb_Call *call;
REBCNT len;
REBCNT n;
REBVAL label;
REBVAL out;
// Find word in object, verify it is a function.
if (!(val = Find_Word_Value(obj, name))) {
SET_EXT_ERROR(result, RXE_NO_WORD);
return 0;
}
if (!ANY_FUNC(val)) {
SET_EXT_ERROR(result, RXE_NOT_FUNC);
return 0;
}
// Create stack frame (use prior stack frame for location info):
SET_TRASH_SAFE(&out); // OUT slot for function eval result
Val_Init_Word_Unbound(&label, REB_WORD, name);
call = Make_Call(
&out,
VAL_SERIES(DSF_WHERE(PRIOR_DSF(DSF))),
VAL_INDEX(DSF_WHERE(PRIOR_DSF(DSF))),
&label,
val
);
obj = VAL_FUNC_PARAMLIST(val); // func words
len = SERIES_TAIL(obj)-1; // number of args (may include locals)
// Push args. Too short or too long arg frames are handled W/O error.
// Note that refinements args can be set to anything.
for (n = 1; n <= len; n++) {
REBVAL *arg = DSF_ARG(call, n);
if (n <= RXI_COUNT(rxis))
RXI_To_Value(arg, rxis[n], RXI_TYPE(rxis, n));
else
SET_NONE(arg);
// Check type for word at the given offset:
if (!TYPE_CHECK(BLK_SKIP(obj, n), VAL_TYPE(arg))) {
result->i2.int32b = n;
SET_EXT_ERROR(result, RXE_BAD_ARGS);
Free_Call(call);
return 0;
}
}
// Evaluate the function:
if (Dispatch_Call_Throws(call)) {
// !!! Does this need handling such that there is a way for the thrown
// value to "bubble up" out of the callback, or is an error sufficient?
fail (Error_No_Catch_For_Throw(DSF_OUT(call)));
}
// Return resulting value from output
*result = Value_To_RXI(&out);
return Reb_To_RXT[VAL_TYPE(&out)];
}
//
// 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;
}
