C++ IS_WORD函数代码示例

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

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