// // 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; }