*/ REBVAL *Find_Error_Info(ERROR_OBJ *error, REBINT *num)
/*
** Return the error message needed to print an error.
** Must scan the error catalog and its error lists.
** Note that the error type and id words no longer need
** to be bound to the error catalog context.
** If the message is not found, return null.
**
***********************************************************************/
{
REBSER *frame;
REBVAL *obj1;
REBVAL *obj2;
if (!IS_WORD(&error->type) || !IS_WORD(&error->id)) return 0;
// Find the correct error type object in the catalog:
frame = VAL_OBJ_FRAME(Get_System(SYS_CATALOG, CAT_ERRORS));
obj1 = Find_Word_Value(frame, VAL_WORD_SYM(&error->type));
if (!obj1) return 0;
// Now find the correct error message for that type:
frame = VAL_OBJ_FRAME(obj1);
obj2 = Find_Word_Value(frame, VAL_WORD_SYM(&error->id));
if (!obj2) return 0;
if (num) {
obj1 = Find_Word_Value(frame, SYM_CODE);
*num = VAL_INT32(obj1)
+ Find_Word_Index(frame, VAL_WORD_SYM(&error->id), FALSE)
- Find_Word_Index(frame, SYM_TYPE, FALSE) - 1;
}
return obj2;
}
//
// 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));
}
//
// Resolve_Path: C
//
// Given a path, return a context and index for its terminal.
//
REBCTX *Resolve_Path(REBVAL *path, REBCNT *index)
{
REBVAL *sel; // selector
const REBVAL *val;
REBARR *blk;
REBCNT i;
if (VAL_LEN_HEAD(path) < 2) return 0;
blk = VAL_ARRAY(path);
sel = ARR_HEAD(blk);
if (!ANY_WORD(sel)) return 0;
val = GET_OPT_VAR_MAY_FAIL(sel);
sel = ARR_AT(blk, 1);
while (TRUE) {
if (!ANY_CONTEXT(val) || !IS_WORD(sel)) return 0;
i = Find_Word_In_Context(VAL_CONTEXT(val), VAL_WORD_SYM(sel), FALSE);
sel++;
if (IS_END(sel)) {
*index = i;
return VAL_CONTEXT(val);
}
}
return 0; // never happens
}
/* reads a possibly quoted word. word characters are those passing IS_WORD() */
static void readQuotedWord(vString *const name)
{
unsigned int depth = 0;
int openQuote = 0, closeQuote = 0;
int c = getcFromInputFile();
closeQuote = getCloseQuote(c);
if (closeQuote != 0)
{
openQuote = c;
depth ++;
c = getcFromInputFile();
}
for (; c != EOF; c = getcFromInputFile())
{
/* don't allow embedded NULs, and prevents to match when quote == 0 (aka none) */
if (c == 0)
break;
/* close before open to support open and close characters to be the same */
else if (c == closeQuote)
depth --;
else if (c == openQuote)
depth ++;
else if (IS_WORD(c) || depth > 0)
vStringPut(name, c);
else
{
ungetcToInputFile(c);
break;
}
}
}
*/ REBINT PD_Block(REBPVS *pvs)
/*
***********************************************************************/
{
REBINT n = 0;
/* Issues!!!
a/1.3
a/not-found: 10 error or append?
a/not-followed: 10 error or append?
*/
if (IS_INTEGER(pvs->select)) {
n = Int32(pvs->select) + VAL_INDEX(pvs->value) - 1;
}
else if (IS_WORD(pvs->select)) {
n = Find_Word(VAL_SERIES(pvs->value), VAL_INDEX(pvs->value), VAL_WORD_CANON(pvs->select));
if (n != NOT_FOUND) n++;
}
else {
// other values:
n = Find_Block_Simple(VAL_SERIES(pvs->value), VAL_INDEX(pvs->value), pvs->select) + 1;
}
if (n < 0 || (REBCNT)n >= VAL_TAIL(pvs->value)) {
if (pvs->setval) return PE_BAD_SELECT;
return PE_NONE;
}
if (pvs->setval) TRAP_PROTECT(VAL_SERIES(pvs->value));
pvs->value = VAL_BLK_SKIP(pvs->value, n);
// if valset - check PROTECT on block
//if (NOT_END(pvs->path+1)) Next_Path(pvs); return PE_OK;
return PE_SET;
}
*/ REBINT PD_Pair(REBPVS *pvs)
/*
***********************************************************************/
{
REBVAL *sel;
REBVAL *val;
REBINT n = 0;
REBD32 dec;
if (IS_WORD(sel = pvs->select)) {
if (VAL_WORD_CANON(sel) == SYM_X) n = 1;
else if (VAL_WORD_CANON(sel) == SYM_Y) n = 2;
else return PE_BAD_SELECT;
}
else if (IS_INTEGER(sel)) {
n = Int32(sel);
if (n != 1 && n !=2) return PE_BAD_SELECT;
}
else
return PE_BAD_SELECT;
if (NZ(val = pvs->setval)) {
if (IS_INTEGER(val)) dec = (REBD32)VAL_INT64(val);
else if (IS_DECIMAL(val)) dec = (REBD32)VAL_DECIMAL(val);
else return PE_BAD_SET;
if (n == 1) VAL_PAIR_X(pvs->value) = dec;
else VAL_PAIR_Y(pvs->value) = dec;
} else {
dec = (n == 1 ? VAL_PAIR_X(pvs->value) : VAL_PAIR_Y(pvs->value));
SET_DECIMAL(pvs->store, dec);
return PE_USE;
}
return PE_OK;
}
*/ REBINT PD_Object(REBPVS *pvs)
/*
***********************************************************************/
{
REBINT n = 0;
if (!VAL_OBJ_FRAME(pvs->value)) {
return PE_NONE; // Error objects may not have a frame.
}
if (IS_WORD(pvs->select)) {
n = Find_Word_Index(VAL_OBJ_FRAME(pvs->value), VAL_WORD_SYM(pvs->select), FALSE);
}
// else if (IS_INTEGER(pvs->select)) {
// n = Int32s(pvs->select, 1);
// }
else return PE_BAD_SELECT;
if (n <= 0 || (REBCNT)n >= SERIES_TAIL(VAL_OBJ_FRAME(pvs->value)))
return PE_BAD_SELECT;
if (pvs->setval && IS_END(pvs->path+1) && VAL_PROTECTED(VAL_FRM_WORD(pvs->value, n)))
Trap1(RE_LOCKED_WORD, pvs->select);
pvs->value = VAL_OBJ_VALUES(pvs->value) + n;
return PE_SET;
// if setval, check PROTECT mode!!!
// VAL_FLAGS((VAL_OBJ_VALUES(value) + n)) &= ~FLAGS_CLEAN;
}
*/ static REBFLG Get_Index_Var(REBVAL *item, REBSER *series, REBINT *index)
/*
** Get the series index from a word or path or integer.
**
** Returns: TRUE if value was a series. FALSE if integer.
**
***********************************************************************/
{
REBVAL *hold = item;
if (IS_END(item)) Trap1(RE_PARSE_END, item);
if (IS_WORD(item)) {
if (!VAL_CMD(item)) item = Get_Var(item);
}
else if (IS_PATH(item)) {
REBVAL *path = item;
Do_Path(&path, 0); //!!! function!
item = DS_TOP;
}
else if (!IS_INTEGER(item))
Trap1(RE_PARSE_VARIABLE, hold);
if (IS_INTEGER(item)) {
*index = Int32(item);
return FALSE;
}
if (!ANY_SERIES(item) || VAL_SERIES(item) != series)
Trap1(RE_PARSE_SERIES, hold);
*index = VAL_INDEX(item);
return TRUE;
}
*/ REBINT PD_Frame(REBPVS *pvs)
/*
** pvs->value points to the first value in frame (SELF).
**
***********************************************************************/
{
REBCNT sym;
REBCNT s;
REBVAL *word;
REBVAL *val;
if (IS_WORD(pvs->select)) {
sym = VAL_WORD_SYM(pvs->select);
s = SYMBOL_TO_CANON(sym);
word = BLK_SKIP(VAL_FRM_WORDS(pvs->value), 1);
for (val = pvs->value + 1; NOT_END(val); val++, word++) {
if (sym == VAL_BIND_SYM(word) || s == VAL_BIND_CANON(word)) {
if (VAL_GET_OPT(word, OPTS_HIDE)) break;
if (VAL_PROTECTED(word)) Trap1(RE_LOCKED_WORD, word);
pvs->value = val;
return PE_SET;
}
}
}
return PE_BAD_SELECT;
}
STOID Form_Block_Series(REBSER *blk, REBCNT index, REB_MOLD *mold, REBSER *frame)
{
// Form a series (part_mold means mold non-string values):
REBINT n;
REBINT len = SERIES_TAIL(blk) - index;
REBVAL *val;
REBVAL *wval;
if (len < 0) len = 0;
for (n = 0; n < len;) {
val = BLK_SKIP(blk, index+n);
wval = 0;
if (frame && (IS_WORD(val) || IS_GET_WORD(val))) {
wval = Find_Word_Value(frame, VAL_WORD_SYM(val));
if (wval) val = wval;
}
Mold_Value(mold, val, wval != 0);
n++;
if (GET_MOPT(mold, MOPT_LINES)) {
Append_Byte(mold->series, LF);
}
else {
// Add a space if needed:
if (n < len && mold->series->tail
&& *UNI_LAST(mold->series) != LF
&& !GET_MOPT(mold, MOPT_TIGHT)
)
Append_Byte(mold->series, ' ');
}
}
}
//
// Resolve_Path: C
//
// Given a path, determine if it is ultimately specifying a selection out
// of a context...and if it is, return that context. So `a/obj/key` would
// return the object assocated with obj, while `a/str/1` would return
// NULL if `str` were a string as it's not an object selection.
//
// !!! This routine overlaps the logic of Do_Path, and should potentially
// be a mode of that instead. It is not very complete, considering that it
// does not execute GROUP! (and perhaps shouldn't?) and only supports a
// path that picks contexts out of other contexts, via word selection.
//
REBCTX *Resolve_Path(const REBVAL *path, REBCNT *index_out)
{
RELVAL *selector;
const REBVAL *var;
REBARR *array;
REBCNT i;
array = VAL_ARRAY(path);
selector = ARR_HEAD(array);
if (IS_END(selector) || !ANY_WORD(selector))
return NULL; // !!! only handles heads of paths that are ANY-WORD!
var = GET_OPT_VAR_MAY_FAIL(selector, VAL_SPECIFIER(path));
++selector;
if (IS_END(selector))
return NULL; // !!! does not handle single-element paths
while (ANY_CONTEXT(var) && IS_WORD(selector)) {
i = Find_Canon_In_Context(
VAL_CONTEXT(var), VAL_WORD_CANON(selector), FALSE
);
++selector;
if (IS_END(selector)) {
*index_out = i;
return VAL_CONTEXT(var);
}
var = CTX_VAR(VAL_CONTEXT(var), i);
}
DEAD_END;
}
*/ REBVAL *Find_In_Contexts(REBCNT sym, REBVAL *where)
/*
** Search a block of objects for a given word symbol and
** return the value for the word. NULL if not found.
**
***********************************************************************/
{
REBVAL *val;
for (; NOT_END(where); where++) {
if (IS_WORD(where)) {
val = Get_Var(where);
}
else if (IS_PATH(where)) {
Do_Path(&where, 0);
val = DS_TOP; // only safe for short time!
}
else
val = where;
if (IS_OBJECT(val)) {
val = Find_Word_Value(VAL_OBJ_FRAME(val), sym);
if (val) return val;
}
}
return 0;
}
*/ static REBINT Do_Dia(REBDIA *dia)
/*
** Process the next command in the dialect.
** Returns the length of command processed.
** Zero indicates end of block.
** Negative indicate error.
** The args holds resulting args.
**
***********************************************************************/
{
REBVAL *next = BLK_SKIP(dia->args, dia->argi);
REBVAL *head;
REBINT err;
if (IS_END(next)) return 0;
// Find the command if a word is provided:
if (IS_WORD(next) || IS_LIT_WORD(next)) {
if (IS_LIT_WORD(next)) SET_FLAG(dia->flags, RDIA_LIT_CMD);
dia->cmd = Find_Command(dia->dialect, next);
}
// Handle defaults - process values before a command is reached:
if (dia->cmd <= 1) {
dia->cmd = 1;
dia->len = 1;
err = Do_Cmd(dia); // DEFAULT cmd
// It must be processed, else it is not in the dialect.
// Check for noop result:
if (err > 0) err = -REB_DIALECT_BAD_ARG;
return err;
}
// Delimit the command - search for next command or end:
for (head = ++next; NOT_END(next); next++) {
if ((IS_WORD(next) || IS_LIT_WORD(next)) && Find_Command(dia->dialect, next) > 1) break;
}
// Note: command may be shorter than length provided here (defaults):
dia->len = next - head; // length of args, not including command
err = Do_Cmd(dia);
if (GET_FLAG(dia->flags, RDIA_LIT_CMD)) dia->cmd += DIALECT_LIT_CMD;
return err;
}
*/ static REBSER *Init_Loop(REBVAL *spec, REBVAL *body_blk, REBSER **fram)
/*
** Initialize standard for loops (copy block, make frame, bind).
** Spec: WORD or [WORD ...]
**
***********************************************************************/
{
REBSER *frame;
REBINT len;
REBVAL *word;
REBVAL *vals;
REBSER *body;
// For :WORD format, get the var's value:
if (IS_GET_WORD(spec)) spec = Get_Var(spec);
// Hand-make a FRAME (done for for speed):
len = IS_BLOCK(spec) ? VAL_LEN(spec) : 1;
if (len == 0) Trap_Arg(spec);
frame = Make_Frame(len);
SET_SELFLESS(frame);
SERIES_TAIL(frame) = len+1;
SERIES_TAIL(FRM_WORD_SERIES(frame)) = len+1;
// Setup for loop:
word = FRM_WORD(frame, 1); // skip SELF
vals = BLK_SKIP(frame, 1);
if (IS_BLOCK(spec)) spec = VAL_BLK_DATA(spec);
// Optimally create the FOREACH frame:
while (len-- > 0) {
if (!IS_WORD(spec) && !IS_SET_WORD(spec)) {
// Prevent inconsistent GC state:
Free_Series(FRM_WORD_SERIES(frame));
Free_Series(frame);
Trap_Arg(spec);
}
VAL_SET(word, VAL_TYPE(spec));
VAL_BIND_SYM(word) = VAL_WORD_SYM(spec);
VAL_BIND_TYPESET(word) = ALL_64;
word++;
SET_NONE(vals);
vals++;
spec++;
}
SET_END(word);
SET_END(vals);
body = Clone_Block_Value(body_blk);
Bind_Block(frame, BLK_HEAD(body), BIND_DEEP);
*fram = frame;
return body;
}
*/ static REBSER *Init_Loop(const REBVAL *spec, REBVAL *body_blk, REBSER **fram)
/*
** Initialize standard for loops (copy block, make frame, bind).
** Spec: WORD or [WORD ...]
**
***********************************************************************/
{
REBSER *frame;
REBINT len;
REBVAL *word;
REBVAL *vals;
REBSER *body;
// For :WORD format, get the var's value:
if (IS_GET_WORD(spec)) spec = GET_VAR(spec);
// Hand-make a FRAME (done for for speed):
len = IS_BLOCK(spec) ? VAL_LEN(spec) : 1;
if (len == 0) raise Error_Invalid_Arg(spec);
frame = Make_Frame(len, FALSE);
SERIES_TAIL(frame) = len+1;
SERIES_TAIL(FRM_WORD_SERIES(frame)) = len+1;
// Setup for loop:
word = FRM_WORD(frame, 1); // skip SELF
vals = BLK_SKIP(frame, 1);
if (IS_BLOCK(spec)) spec = VAL_BLK_DATA(spec);
// Optimally create the FOREACH frame:
while (len-- > 0) {
if (!IS_WORD(spec) && !IS_SET_WORD(spec)) {
// Prevent inconsistent GC state:
Free_Series(FRM_WORD_SERIES(frame));
Free_Series(frame);
raise Error_Invalid_Arg(spec);
}
Val_Init_Word_Typed(word, VAL_TYPE(spec), VAL_WORD_SYM(spec), ALL_64);
word++;
SET_NONE(vals);
vals++;
spec++;
}
SET_END(word);
SET_END(vals);
body = Copy_Array_At_Deep_Managed(
VAL_SERIES(body_blk), VAL_INDEX(body_blk)
);
Bind_Values_Deep(BLK_HEAD(body), frame);
*fram = frame;
return body;
}
*/ static REBCNT Get_Mode_Id(REBVAL *word)
/*
***********************************************************************/
{
REBCNT id = 0;
if (IS_WORD(word)) {
id = Find_Int(&Mode_Syms[0], VAL_WORD_CANON(word));
if (id == NOT_FOUND) Trap_Arg_DEAD_END(word);
}
return id;
}
//
// 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;
}
STOID Mold_Object(REBVAL *value, REB_MOLD *mold)
{
REBSER *wser;
REBVAL *words;
REBVAL *vals; // first value is context
REBCNT n;
REBOOL indented = !GET_MOPT(mold, MOPT_INDENT);
ASSERT(VAL_OBJ_FRAME(value), RP_NO_OBJECT_FRAME);
wser = VAL_OBJ_WORDS(value);
// if (wser < 1000)
// Dump_Block_Raw(VAL_OBJ_FRAME(value), 0, 1);
words = BLK_HEAD(wser);
vals = VAL_OBJ_VALUES(value); // first value is context
Pre_Mold(value, mold);
Append_Byte(mold->series, '[');
// Prevent infinite looping:
if (Find_Same_Block(MOLD_LOOP, value) > 0) {
Append_Bytes(mold->series, "...]");
return;
}
Append_Val(MOLD_LOOP, value);
mold->indent++;
for (n = 1; n < SERIES_TAIL(wser); n++) {
if (
!VAL_GET_OPT(words+n, OPTS_HIDE) &&
((VAL_TYPE(vals+n) > REB_NONE) || !GET_MOPT(mold, MOPT_NO_NONE))
){
if(indented)
New_Indented_Line(mold);
else if (n > 1)
Append_Byte(mold->series, ' ');
Append_UTF8(mold->series, Get_Sym_Name(VAL_WORD_SYM(words+n)), -1);
//Print("Slot: %s", Get_Sym_Name(VAL_WORD_SYM(words+n)));
Append_Bytes(mold->series, ": ");
if (IS_WORD(vals+n) && !GET_MOPT(mold, MOPT_MOLD_ALL)) Append_Byte(mold->series, '\'');
Mold_Value(mold, vals+n, TRUE);
}
}
mold->indent--;
if (indented) New_Indented_Line(mold);
Append_Byte(mold->series, ']');
End_Mold(mold);
Remove_Last(MOLD_LOOP);
}
*/ REBFLG MT_Datatype(REBVAL *out, REBVAL *data, REBCNT type)
/*
***********************************************************************/
{
if (!IS_WORD(data)) return FALSE;
type = VAL_WORD_CANON(data);
if (type > REB_MAX) return FALSE;
VAL_SET(out, REB_DATATYPE);
VAL_DATATYPE(out) = type-1;
VAL_TYPE_SPEC(out) = 0;
return TRUE;
}
//
// 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;
}
//
// Get_Simple_Value_Into: C
//
// Does easy lookup, else just returns the value as is.
//
void Get_Simple_Value_Into(REBVAL *out, const RELVAL *val, REBCTX *specifier)
{
if (IS_WORD(val) || IS_GET_WORD(val)) {
*out = *GET_OPT_VAR_MAY_FAIL(val, specifier);
}
else if (IS_PATH(val) || IS_GET_PATH(val)) {
if (Do_Path_Throws_Core(out, NULL, val, specifier, NULL))
fail (Error_No_Catch_For_Throw(out));
}
else {
COPY_VALUE(out, val, specifier);
}
}
//
// What_Reflector: C
//
REBINT What_Reflector(REBVAL *word)
{
if (IS_WORD(word)) {
switch (VAL_WORD_SYM(word)) {
case SYM_SPEC: return OF_SPEC;
case SYM_BODY: return OF_BODY;
case SYM_WORDS: return OF_WORDS;
case SYM_VALUES: return OF_VALUES;
case SYM_TYPES: return OF_TYPES;
}
}
return 0;
}
//
// Get_Simple_Value_Into: C
//
// Does easy lookup, else just returns the value as is.
//
void Get_Simple_Value_Into(REBVAL *out, const REBVAL *val)
{
if (IS_WORD(val) || IS_GET_WORD(val)) {
*out = *GET_OPT_VAR_MAY_FAIL(val);
}
else if (IS_PATH(val) || IS_GET_PATH(val)) {
if (Do_Path_Throws(out, NULL, val, NULL))
fail (Error_No_Catch_For_Throw(out));
}
else {
*out = *val;
}
}
*/ REBVAL *Get_Any_Var(REBVAL *item)
/*
** Works for words and paths. For paths, return value is
** volatile on top of stack.
**
***********************************************************************/
{
if (IS_WORD(item)) return Get_Var(item);
if (IS_PATH(item)) {
REBVAL *path = item;
if (Do_Path(&path, 0)) return item; // found a function
item = DS_TOP;
}
return item;
}
*/ static REBOOL Is_Of_Type(REBVAL *value, REBVAL *types)
/*
** Types can be: word or block. Each element must be either
** a datatype or a typeset.
**
***********************************************************************/
{
REBVAL *val;
val = IS_WORD(types) ? Get_Var(types) : types;
if (IS_DATATYPE(val)) {
return (VAL_DATATYPE(val) == (REBINT)VAL_TYPE(value));
}
if (IS_TYPESET(val)) {
return (TYPE_CHECK(val, VAL_TYPE(value)));
}
if (IS_BLOCK(val)) {
for (types = VAL_BLK_DATA(val); NOT_END(types); types++) {
val = IS_WORD(types) ? Get_Var(types) : types;
if (IS_DATATYPE(val))
if (VAL_DATATYPE(val) == (REBINT)VAL_TYPE(value)) return TRUE;
else if (IS_TYPESET(val))
if (TYPE_CHECK(val, VAL_TYPE(value))) return TRUE;
else
Trap1(RE_INVALID_TYPE, Of_Type(val));
}
return FALSE;
}
Trap_Arg(types);
return 0; // for compiler
}
*/ static REBVAL *Get_Parse_Value(REBVAL *item)
/*
** Get the value of a word (when not a command) or path.
** Returns all other values as-is.
**
***********************************************************************/
{
if (IS_WORD(item)) {
if (!VAL_CMD(item)) item = Get_Var(item);
}
else if (IS_PATH(item)) {
REBVAL *path = item;
if (Do_Path(&path, 0)) return item; // found a function
item = DS_TOP;
}
return item;
}
//
// PD_Pair: C
//
REBINT PD_Pair(REBPVS *pvs)
{
const REBVAL *sel = pvs->selector;
REBINT n = 0;
REBDEC dec;
if (IS_WORD(sel)) {
if (VAL_WORD_SYM(sel) == SYM_X)
n = 1;
else if (VAL_WORD_SYM(sel) == SYM_Y)
n = 2;
else
fail (Error_Bad_Path_Select(pvs));
}
else if (IS_INTEGER(sel)) {
n = Int32(sel);
if (n != 1 && n != 2)
fail (Error_Bad_Path_Select(pvs));
}
else fail (Error_Bad_Path_Select(pvs));
if (pvs->opt_setval) {
const REBVAL *setval = pvs->opt_setval;
if (IS_INTEGER(setval))
dec = cast(REBDEC, VAL_INT64(setval));
else if (IS_DECIMAL(setval))
dec = VAL_DECIMAL(setval);
else
fail (Error_Bad_Path_Set(pvs));
if (n == 1)
VAL_PAIR_X(pvs->value) = dec;
else
VAL_PAIR_Y(pvs->value) = dec;
}
else {
dec = (n == 1 ? VAL_PAIR_X(pvs->value) : VAL_PAIR_Y(pvs->value));
SET_DECIMAL(pvs->store, dec);
return PE_USE_STORE;
}
return PE_OK;
}
*/ static int Count_Dia_Args(REBVAL *args)
/*
** Return number of formal args provided to the function.
** This is just a guess, because * repeats count as zero.
**
***********************************************************************/
{
REBINT n = 0;
for (; NOT_END(args); args++) {
if (IS_WORD(args)) {
if (VAL_WORD_SYM(args) == SYM__P) { // skip: * type
if (NOT_END(args+1)) args++;
} else n++;
}
else if (IS_DATATYPE(args) || IS_TYPESET(args)) n++;
}
return n;
}
*/ REBFLG Make_Typeset(REBVAL *block, REBVAL *value, REBFLG load)
/*
** block - block of datatypes (datatype words ok too)
** value - value to hold result (can be word-spec type too)
**
***********************************************************************/
{
const REBVAL *val;
REBCNT sym;
REBSER *types = VAL_SERIES(ROOT_TYPESETS);
VAL_TYPESET(value) = 0;
for (; NOT_END(block); block++) {
val = NULL;
if (IS_WORD(block)) {
//Print("word: %s", Get_Word_Name(block));
sym = VAL_WORD_SYM(block);
if (VAL_WORD_FRAME(block)) { // Get word value
val = GET_VAR(block);
} else if (sym < REB_MAX) { // Accept datatype word
TYPE_SET(value, VAL_WORD_SYM(block)-1);
continue;
} // Special typeset symbols:
else if (sym >= SYM_ANY_TYPEX && sym <= SYM_ANY_BLOCKX)
val = BLK_SKIP(types, sym - SYM_ANY_TYPEX + 1);
}
if (!val) val = block;
if (IS_DATATYPE(val)) {
TYPE_SET(value, VAL_DATATYPE(val));
} else if (IS_TYPESET(val)) {
VAL_TYPESET(value) |= VAL_TYPESET(val);
} else {
if (load) return FALSE;
Trap_Arg_DEAD_END(block);
}
}
return TRUE;
}
*/ REBINT PD_Gob(REBPVS *pvs)
/*
***********************************************************************/
{
REBGOB *gob = VAL_GOB(pvs->value);
REBCNT index;
REBCNT tail;
if (IS_WORD(pvs->select)) {
if (pvs->setval == 0 || NOT_END(pvs->path+1)) {
if (!Get_GOB_Var(gob, pvs->select, pvs->store)) return PE_BAD_SELECT;
// Check for SIZE/X: types of cases:
if (pvs->setval && IS_PAIR(pvs->store)) {
REBVAL *sel = pvs->select;
pvs->value = pvs->store;
Next_Path(pvs); // sets value in pvs->store
Set_GOB_Var(gob, sel, pvs->store); // write it back to gob
}
return PE_USE;
} else {
if (!Set_GOB_Var(gob, pvs->select, pvs->setval)) return PE_BAD_SET;
return PE_OK;
}
}
if (IS_INTEGER(pvs->select)) {
if (!GOB_PANE(gob)) return PE_NONE;
tail = GOB_PANE(gob) ? GOB_TAIL(gob) : 0;
index = VAL_GOB_INDEX(pvs->value);
index += Int32(pvs->select) - 1;
if (index >= tail) return PE_NONE;
gob = *GOB_SKIP(gob, index);
index = 0;
VAL_SET(pvs->store, REB_GOB);
VAL_GOB(pvs->store) = gob;
VAL_GOB_INDEX(pvs->store) = 0;
return PE_USE;
}
return PE_BAD_SELECT;
}