//
// Is_Type_Of: C
//
// Types can be: word or block. Each element must be either
// a datatype or a typeset.
//
static REBOOL Is_Type_Of(const REBVAL *value, REBVAL *types)
{
const REBVAL *val;
val = IS_WORD(types) ? GET_OPT_VAR_MAY_FAIL(types) : types;
if (IS_DATATYPE(val))
return LOGICAL(VAL_TYPE_KIND(val) == VAL_TYPE(value));
if (IS_TYPESET(val))
return LOGICAL(TYPE_CHECK(val, VAL_TYPE(value)));
if (IS_BLOCK(val)) {
for (types = VAL_ARRAY_AT(val); NOT_END(types); types++) {
val = IS_WORD(types) ? GET_OPT_VAR_MAY_FAIL(types) : types;
if (IS_DATATYPE(val)) {
if (VAL_TYPE_KIND(val) == VAL_TYPE(value)) return TRUE;
}
else if (IS_TYPESET(val)) {
if (TYPE_CHECK(val, VAL_TYPE(value))) return TRUE;
}
else
fail (Error(RE_INVALID_TYPE, Type_Of(val)));
}
return FALSE;
}
fail (Error_Invalid_Arg(types));
}
//
// MAKE_Datatype: C
//
void MAKE_Datatype(REBVAL *out, enum Reb_Kind kind, const REBVAL *arg) {
if (!IS_WORD(arg))
fail (Error_Bad_Make(kind, arg));
REBSYM sym = VAL_WORD_SYM(arg);
if (sym == SYM_0 || sym > SYM_FROM_KIND(REB_MAX))
fail (Error_Bad_Make(kind, arg));
VAL_RESET_HEADER(out, REB_DATATYPE);
VAL_TYPE_KIND(out) = KIND_FROM_SYM(sym);
VAL_TYPE_SPEC(out) = 0;
}
//
// Update_Typeset_Bits_Core: C
//
// This sets the bits in a bitset according to a block of datatypes. There
// is special handling by which BAR! will set the "variadic" bit on the
// typeset, which is heeded by functions only.
//
// !!! R3-Alpha supported fixed word symbols for datatypes and typesets.
// Confusingly, this means that if you have said `word!: integer!` and use
// WORD!, you will get the integer type... but if WORD! is unbound then it
// will act as WORD!. Also, is essentially having "keywords" and should be
// reviewed to see if anything actually used it.
//
REBOOL Update_Typeset_Bits_Core(
REBVAL *typeset,
const REBVAL *head,
REBOOL trap // if TRUE, then return FALSE instead of failing
) {
const REBVAL *item = head;
REBARR *types = VAL_ARRAY(ROOT_TYPESETS);
assert(IS_TYPESET(typeset));
VAL_TYPESET_BITS(typeset) = 0;
for (; NOT_END(item); item++) {
const REBVAL *var = NULL;
if (IS_BAR(item)) {
SET_VAL_FLAG(typeset, TYPESET_FLAG_VARIADIC);
continue;
}
if (IS_WORD(item) && !(var = TRY_GET_OPT_VAR(item))) {
REBSYM sym = VAL_WORD_SYM(item);
// See notes: if a word doesn't look up to a variable, then its
// symbol is checked as a second chance.
//
if (IS_KIND_SYM(sym)) {
TYPE_SET(typeset, KIND_FROM_SYM(sym));
continue;
}
else if (sym >= SYM_ANY_NOTHING_X && sym < SYM_DATATYPES)
var = ARR_AT(types, sym - SYM_ANY_NOTHING_X);
}
if (!var) var = item;
if (IS_DATATYPE(var)) {
TYPE_SET(typeset, VAL_TYPE_KIND(var));
}
else if (IS_TYPESET(var)) {
VAL_TYPESET_BITS(typeset) |= VAL_TYPESET_BITS(var);
}
else {
if (trap) return FALSE;
fail (Error_Invalid_Arg(item));
}
}
return TRUE;
}
//
// CT_Datatype: C
//
REBINT CT_Datatype(const RELVAL *a, const RELVAL *b, REBINT mode)
{
if (mode >= 0) return (VAL_TYPE_KIND(a) == VAL_TYPE_KIND(b));
return -1;
}
//
// 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;
}
