Example #1
0
static REBOOL Equal_Object(REBVAL *val, REBVAL *arg)
{
	REBSER *f1;
	REBSER *f2;
	REBSER *w1;
	REBSER *w2;
	REBINT n;

	if (VAL_TYPE(arg) != VAL_TYPE(val)) return FALSE;

	f1 = VAL_OBJ_FRAME(val);
	f2 = VAL_OBJ_FRAME(arg);
	if (f1 == f2) return TRUE;
	if (f1->tail != f2->tail) return FALSE;

	w1 = FRM_WORD_SERIES(f1);
	w2 = FRM_WORD_SERIES(f2);
	if (w1->tail != w2->tail) return FALSE;

	// Compare each entry:
	for (n = 1; n < (REBINT)(f1->tail); n++) {
		if (Cmp_Value(BLK_SKIP(w1, n), BLK_SKIP(w2, n), FALSE)) return FALSE;
		// Use Compare_Values();
		if (Cmp_Value(BLK_SKIP(f1, n), BLK_SKIP(f2, n), FALSE)) return FALSE;
	}

	return TRUE;
}
Example #2
0
//
//  Find_Key: C
// 
// Returns hash index (either the match or the new one).
// A return of zero is valid (as a hash index);
// 
// Wide: width of record (normally 2, a key and a value).
// 
// Modes:
//     0 - search, return hash if found or not
//     1 - search, return hash, else return -1 if not
//     2 - search, return hash, else append value and return -1
//
REBINT Find_Key(REBSER *series, REBSER *hser, const REBVAL *key, REBINT wide, REBCNT cased, REBYTE mode)
{
    REBCNT *hashes;
    REBCNT skip;
    REBCNT hash;
    REBCNT len;
    REBCNT n;
    REBVAL *val;

    // Compute hash for value:
    len = hser->tail;
    hash = Hash_Value(key, len);
    if (!hash) fail (Error_Has_Bad_Type(key));

    // Determine skip and first index:
    skip  = (len == 0) ? 0 : (hash & 0x0000FFFF) % len;
    if (skip == 0) skip = 1;
    hash = (len == 0) ? 0 : (hash & 0x00FFFF00) % len;

    // Scan hash table for match:
    hashes = (REBCNT*)hser->data;
    if (ANY_WORD(key)) {
        while ((n = hashes[hash])) {
            val = BLK_SKIP(series, (n-1) * wide);
            if (
                ANY_WORD(val) &&
                (VAL_WORD_SYM(key) == VAL_WORD_SYM(val) ||
                (!cased && VAL_WORD_CANON(key) == VAL_WORD_CANON(val)))
            ) return hash;
            hash += skip;
            if (hash >= len) hash -= len;
        }
    }
    else if (ANY_BINSTR(key)) {
        while ((n = hashes[hash])) {
            val = BLK_SKIP(series, (n-1) * wide);
            if (
                VAL_TYPE(val) == VAL_TYPE(key)
                && 0 == Compare_String_Vals(key, val, (REBOOL)(!IS_BINARY(key) && !cased))
            ) return hash;
            hash += skip;
            if (hash >= len) hash -= len;
        }
    } else {
        while ((n = hashes[hash])) {
            val = BLK_SKIP(series, (n-1) * wide);
            if (VAL_TYPE(val) == VAL_TYPE(key) && 0 == Cmp_Value(key, val, !cased)) return hash;
            hash += skip;
            if (hash >= len) hash -= len;
        }
    }

    // Append new value the target series:
    if (mode > 1) {
        hashes[hash] = SERIES_TAIL(series) + 1;
        Append_Values_Len(series, key, wide);
    }

    return (mode > 0) ? NOT_FOUND : hash;
}
Example #3
0
*/	REBINT Cmp_Block(REBVAL *sval, REBVAL *tval, REBFLG is_case)
/*
**		Compare two blocks and return the difference of the first
**		non-matching value.
**
***********************************************************************/
{
	REBVAL	*s = VAL_BLK_DATA(sval);
	REBVAL	*t = VAL_BLK_DATA(tval);
	REBINT	diff;

	CHECK_STACK(&s);

	if ((VAL_SERIES(sval)==VAL_SERIES(tval))&&
	 (VAL_INDEX(sval)==VAL_INDEX(tval)))
		 return 0;

	while (!IS_END(s) && (VAL_TYPE(s) == VAL_TYPE(t) ||
					(IS_NUMBER(s) && IS_NUMBER(t)))) {
		if ((diff = Cmp_Value(s, t, is_case)) != 0)
			return diff;
		s++, t++;
	}
	return VAL_TYPE(s) - VAL_TYPE(t);
}
Example #4
0
*/	static int Compare_Val(const void *v1, const void *v2)
/*
***********************************************************************/
{
	// !!!! BE SURE that 64 bit large difference comparisons work

	if (sort_flags.reverse)
		return Cmp_Value((REBVAL*)v2+sort_flags.offset, (REBVAL*)v1+sort_flags.offset, sort_flags.cased);
	else
		return Cmp_Value((REBVAL*)v1+sort_flags.offset, (REBVAL*)v2+sort_flags.offset, sort_flags.cased);

/*
	REBI64 n = VAL_INT64((REBVAL*)v1) - VAL_INT64((REBVAL*)v2);
	if (n > 0) return 1;
	if (n < 0) return -1;
	return 0;
*/
}
Example #5
0
//
//  Find_In_Array_Simple: C
// 
// Simple search for a value in an array. Return the index of
// the value or the TAIL index if not found.
//
REBCNT Find_In_Array_Simple(REBARR *array, REBCNT index, const RELVAL *target)
{
    RELVAL *value = ARR_HEAD(array);

    for (; index < ARR_LEN(array); index++) {
        if (0 == Cmp_Value(value + index, target, FALSE))
            return index;
    }

    return ARR_LEN(array);
}
Example #6
0
*/	REBCNT Find_Block_Simple(REBSER *series, REBCNT index, REBVAL *target)
/*
**		Simple search for a value in a block. Return the index of
**		the value or the TAIL index if not found.
**
***********************************************************************/
{
	REBVAL *value = BLK_HEAD(series);

	for (; index < SERIES_TAIL(series); index++) {
		if (0 == Cmp_Value(value+index, target, FALSE)) return index;
	}

	return SERIES_TAIL(series);
}
Example #7
0
//
//  Cmp_Array: C
// 
// Compare two arrays and return the difference of the first
// non-matching value.
//
REBINT Cmp_Array(const RELVAL *sval, const RELVAL *tval, REBOOL is_case)
{
    RELVAL *s = VAL_ARRAY_AT(sval);
    RELVAL *t = VAL_ARRAY_AT(tval);
    REBINT diff;

    if (C_STACK_OVERFLOWING(&s)) Trap_Stack_Overflow();

    if ((VAL_SERIES(sval)==VAL_SERIES(tval))&&
     (VAL_INDEX(sval)==VAL_INDEX(tval)))
         return 0;

    if (IS_END(s) || IS_END(t)) goto diff_of_ends;

    while (
        (VAL_TYPE(s) == VAL_TYPE(t) ||
        (ANY_NUMBER(s) && ANY_NUMBER(t)))
    ) {
        if ((diff = Cmp_Value(s, t, is_case)) != 0)
            return diff;

        s++;
        t++;

        if (IS_END(s) || IS_END(t)) goto diff_of_ends;
    }

    return VAL_TYPE(s) - VAL_TYPE(t);

diff_of_ends:
    // Treat end as if it were a REB_xxx type of 0, so all other types would
    // compare larger than it.
    //
    if (IS_END(s)) {
        if (IS_END(t)) return 0;
        return -1;
    }
    return 1;
}
Example #8
0
*/	REBCNT Find_Block(REBSER *series, REBCNT index, REBCNT end, REBVAL *target, REBCNT len, REBCNT flags, REBINT skip)
/*
**		Flags are set according to: ALL_FIND_REFS
**
**	Main Parameters:
**		start - index to start search
**		end   - ending position
**		len   - length of target
**		skip  - skip factor
**		dir   - direction
**
**	Comparison Parameters:
**		case  - case sensitivity
**		wild  - wild cards/keys
**
**	Final Parmameters:
**		tail  - tail position
**		match - sequence
**		SELECT - (value that follows)
**
***********************************************************************/
{
	REBVAL *value;
	REBVAL *val;
	REBCNT cnt;
	REBCNT start = index;

	if (flags & (AM_FIND_REVERSE | AM_FIND_LAST)) {
		skip = -1;
		start = 0;
		if (flags & AM_FIND_LAST) index = end - len;
		else index--;
	}

	// Optimized find word in block:
	if (ANY_WORD(target)) {
		for (; index >= start && index < end; index += skip) {
			value = BLK_SKIP(series, index);
			if (ANY_WORD(value)) {
				cnt = (VAL_WORD_SYM(value) == VAL_WORD_SYM(target));
				if (flags & AM_FIND_CASE) {
					// Must be same type and spelling:
					if (cnt && VAL_TYPE(value) == VAL_TYPE(target)) return index;
				}
				else {
					// Can be different type or alias:
					if (cnt || VAL_WORD_CANON(value) == VAL_WORD_CANON(target)) return index;
				}
			}
			if (flags & AM_FIND_MATCH) break;
		}
		return NOT_FOUND;
	}
	// Match a block against a block:
	else if (ANY_BLOCK(target) && !(flags & AM_FIND_ONLY)) {
		for (; index >= start && index < end; index += skip) {
			cnt = 0;
			value = BLK_SKIP(series, index);
			for (val = VAL_BLK_DATA(target); NOT_END(val); val++, value++) {
				if (0 != Cmp_Value(value, val, (REBOOL)(flags & AM_FIND_CASE))) break;
				if (++cnt >= len) {
					return index;
				}
			}
			if (flags & AM_FIND_MATCH) break;
		}
		return NOT_FOUND;
	}
	// Find a datatype in block:
	else if (IS_DATATYPE(target) || IS_TYPESET(target)) {
		for (; index >= start && index < end; index += skip) {
			value = BLK_SKIP(series, index);
			// Used if's so we can trace it...
			if (IS_DATATYPE(target)) {
				if ((REBINT)VAL_TYPE(value) == VAL_DATATYPE(target)) return index;
				if (IS_DATATYPE(value) && VAL_DATATYPE(value) == VAL_DATATYPE(target)) return index;
			}
			if (IS_TYPESET(target)) {
				if (TYPE_CHECK(target, VAL_TYPE(value))) return index;
				if (IS_DATATYPE(value) && TYPE_CHECK(target, VAL_DATATYPE(value))) return index;
				if (IS_TYPESET(value) && EQUAL_TYPESET(value, target)) return index;
			}
			if (flags & AM_FIND_MATCH) break;
		}
		return NOT_FOUND;
	}
	// All other cases:
	else {
		for (; index >= start && index < end; index += skip) {
			value = BLK_SKIP(series, index);
			if (0 == Cmp_Value(value, target, (REBOOL)(flags & AM_FIND_CASE))) return index;
			if (flags & AM_FIND_MATCH) break;
		}
		return NOT_FOUND;
	}
}
Example #9
0
*/	REBINT Find_Key(REBSER *series, REBSER *hser, REBVAL *key, REBINT wide, REBCNT cased, REBYTE mode)
/*
**		Returns hash index (either the match or the new one).
**		A return of zero is valid (as a hash index);
**
**		Wide: width of record (normally 2, a key and a value).
**
**		Modes:
**			0 - search, return hash if found or not
**			1 - search, return hash, else return -1 if not
**			2 - search, return hash, else append value and return -1
**
***********************************************************************/
{
	REBCNT *hashes;
	REBCNT skip;
	REBCNT hash;
	REBCNT len;
	REBCNT n;
	REBVAL *val;

	// Compute hash for value:
	len = hser->tail;
	hash = Hash_Value(key, len);
	if (!hash) Trap_Type_DEAD_END(key);

	// Determine skip and first index:
	skip  = (len == 0) ? 0 : (hash & 0x0000FFFF) % len;
	if (skip == 0) skip = 1;
	hash = (len == 0) ? 0 : (hash & 0x00FFFF00) % len;

	// Scan hash table for match:
	hashes = (REBCNT*)hser->data;
	if (ANY_WORD(key)) {
		while ((n = hashes[hash])) {
			val = BLK_SKIP(series, (n-1) * wide);
			if (
				ANY_WORD(val) &&
				(VAL_WORD_SYM(key) == VAL_BIND_SYM(val) ||
				(!cased && VAL_WORD_CANON(key) == VAL_BIND_CANON(val)))
			) return hash;
			hash += skip;
			if (hash >= len) hash -= len;
		}
	}
	else if (ANY_BINSTR(key)) {
		while ((n = hashes[hash])) {
			val = BLK_SKIP(series, (n-1) * wide);
			if (
				VAL_TYPE(val) == VAL_TYPE(key)
				&& 0 == Compare_String_Vals(key, val, (REBOOL)(!IS_BINARY(key) && !cased))
			) return hash;
			hash += skip;
			if (hash >= len) hash -= len;
		}
	} else {
		while ((n = hashes[hash])) {
			val = BLK_SKIP(series, (n-1) * wide);
			if (VAL_TYPE(val) == VAL_TYPE(key) && 0 == Cmp_Value(key, val, !cased)) return hash;
			hash += skip;
			if (hash >= len) hash -= len;
		}
	}

	// Append new value the target series:
	if (mode > 1) {
		hashes[hash] = SERIES_TAIL(series)+1;
		//Debug_Num("hash:", hashes[hash]);
		Append_Series(series, (REBYTE*)key, wide);
		//Dump_Series(series, "hash");
	}

	return (mode > 0) ? NOT_FOUND : hash;
}
Example #10
0
*/	static REBCNT Parse_Rules_Loop(REBPARSE *parse, REBCNT index, REBVAL *rules, REBCNT depth)
/*
***********************************************************************/
{
	REBSER *series = parse->series;
	REBVAL *item;		// current rule item
	REBVAL *word;		// active word to be set
	REBCNT start;		// recovery restart point
	REBCNT i;			// temp index point
	REBCNT begin;		// point at beginning of match
	REBINT count;		// iterated pattern counter
	REBINT mincount;	// min pattern count
	REBINT maxcount;	// max pattern count
	REBVAL *item_hold;
	REBVAL *val;		// spare
	REBCNT rulen;
	REBSER *ser;
	REBFLG flags;
	REBCNT cmd;
	REBVAL *rule_head = rules;

	CHECK_STACK(&flags);
	//if (depth > MAX_PARSE_DEPTH) Trap_Word(RE_LIMIT_HIT, SYM_PARSE, 0);
	flags = 0;
	word = 0;
	mincount = maxcount = 1;
	start = begin = index;

	// For each rule in the rule block:
	while (NOT_END(rules)) {

		//Print_Parse_Index(parse->type, rules, series, index);

		if (--Eval_Count <= 0 || Eval_Signals) Do_Signals();

		//--------------------------------------------------------------------
		// Pre-Rule Processing Section
		//
		// For non-iterated rules, including setup for iterated rules.
		// The input index is not advanced here, but may be changed by
		// a GET-WORD variable.
		//--------------------------------------------------------------------

		item = rules++;

		// If word, set-word, or get-word, process it:
		if (VAL_TYPE(item) >= REB_WORD && VAL_TYPE(item) <= REB_GET_WORD) {

			// Is it a command word?
			if (cmd = VAL_CMD(item)) {

				if (!IS_WORD(item)) Trap1(RE_PARSE_COMMAND, item); // SET or GET not allowed

				if (cmd <= SYM_BREAK) { // optimization

					switch (cmd) {

					case SYM_OR_BAR:
						return index;	// reached it successfully

					// Note: mincount = maxcount = 1 on entry
					case SYM_WHILE:
						SET_FLAG(flags, PF_WHILE);
					case SYM_ANY:
						mincount = 0;
					case SYM_SOME:
						maxcount = MAX_I32;
						continue;

					case SYM_OPT:
						mincount = 0;
						continue;

					case SYM_COPY:
						SET_FLAG(flags, PF_COPY);
					case SYM_SET:
						SET_FLAG(flags, PF_SET);
						item = rules++;
						if (!IS_WORD(item)) Trap1(RE_PARSE_VARIABLE, item);
						if (VAL_CMD(item)) Trap1(RE_PARSE_COMMAND, item);
						word = item;
						continue;

					case SYM_NOT:
						SET_FLAG(flags, PF_NOT);
						flags ^= (1<<PF_NOT2);
						continue;
	
					case SYM_AND:
						SET_FLAG(flags, PF_AND);
						continue;

					case SYM_THEN:
						SET_FLAG(flags, PF_THEN);
						continue;

					case SYM_REMOVE:
						SET_FLAG(flags, PF_REMOVE);
						continue;
					
					case SYM_INSERT:
						SET_FLAG(flags, PF_INSERT);
						goto post;
					
					case SYM_CHANGE:
						SET_FLAG(flags, PF_CHANGE);
						continue;

					case SYM_RETURN:
						if (IS_PAREN(rules)) {
							item = Do_Block_Value_Throw(rules); // might GC
							Throw_Return_Value(item);
						}
						SET_FLAG(flags, PF_RETURN);
						continue;

					case SYM_ACCEPT:
					case SYM_BREAK:
						parse->result = 1;
						return index;

					case SYM_REJECT:
						parse->result = -1;
						return index;

					case SYM_FAIL:
						index = NOT_FOUND;
						goto post;

					case SYM_IF:
						item = rules++;
						if (IS_END(item)) goto bad_end;
						if (!IS_PAREN(item)) Trap1(RE_PARSE_RULE, item);
						item = Do_Block_Value_Throw(item); // might GC
						if (IS_TRUE(item)) continue;
						else {
							index = NOT_FOUND;
							goto post;
						}

					case SYM_LIMIT:
						Trap0(RE_NOT_DONE);
						//val = Get_Parse_Value(rules++);
					//	if (IS_INTEGER(val)) limit = index + Int32(val);
					//	else if (ANY_SERIES(val)) limit = VAL_INDEX(val);
					//	else goto
						//goto bad_rule;
					//	goto post;

					case SYM_QQ:
						Print_Parse_Index(parse->type, rules, series, index);
						continue;
					}
				}
				// Any other cmd must be a match command, so proceed...

			} else { // It's not a PARSE command, get or set it:

				// word: - set a variable to the series at current index
				if (IS_SET_WORD(item)) {
					Set_Var_Series(item, parse->type, series, index);
					continue;
				}

				// :word - change the index for the series to a new position
				if (IS_GET_WORD(item)) {
					item = Get_Var(item);
					// CureCode #1263 change
					//if (parse->type != VAL_TYPE(item) || VAL_SERIES(item) != series)
					//	Trap1(RE_PARSE_SERIES, rules-1);
					if (!ANY_SERIES(item)) Trap1(RE_PARSE_SERIES, rules-1);
					index = Set_Parse_Series(parse, item);
					series = parse->series;
					continue;
				}

				// word - some other variable
				if (IS_WORD(item)) {
					item = Get_Var(item);
				}

				// item can still be 'word or /word
			}
		}
		else if (ANY_PATH(item)) {
			item = Do_Parse_Path(item, parse, &index); // index can be modified
			if (index > series->tail) index = series->tail;
			if (item == 0) continue; // for SET and GET cases
		}

		if (IS_PAREN(item)) {
			Do_Block_Value_Throw(item); // might GC
			if (index > series->tail) index = series->tail;
			continue;
		}

		// Counter? 123
		if (IS_INTEGER(item)) {	// Specify count or range count
			SET_FLAG(flags, PF_WHILE);
			mincount = maxcount = Int32s(item, 0);
			item = Get_Parse_Value(rules++);
			if (IS_END(item)) Trap1(RE_PARSE_END, rules-2);
			if (IS_INTEGER(item)) {
				maxcount = Int32s(item, 0);
				item = Get_Parse_Value(rules++);
				if (IS_END(item)) Trap1(RE_PARSE_END, rules-2);
			}
		}
		// else fall through on other values and words

		//--------------------------------------------------------------------
		// Iterated Rule Matching Section:
		//
		// Repeats the same rule N times or until the rule fails.
		// The index is advanced and stored in a temp variable i until
		// the entire rule has been satisfied.
		//--------------------------------------------------------------------

		item_hold = item;	// a command or literal match value
		if (VAL_TYPE(item) <= REB_UNSET || VAL_TYPE(item) >= REB_NATIVE) goto bad_rule;
		begin = index;		// input at beginning of match section
		rulen = 0;			// rules consumed (do not use rule++ below)
		i = index;

		//note: rules var already advanced

		for (count = 0; count < maxcount;) {

			item = item_hold;

			if (IS_WORD(item)) {

				switch (cmd = VAL_WORD_CANON(item)) {

				case SYM_SKIP:
					i = (index < series->tail) ? index+1 : NOT_FOUND;
					break;

				case SYM_END:
					i = (index < series->tail) ? NOT_FOUND : series->tail;
					break;

				case SYM_TO:
				case SYM_THRU:
					if (IS_END(rules)) goto bad_end;
					item = Get_Parse_Value(rules);
					rulen = 1;
					i = Parse_To(parse, index, item, cmd == SYM_THRU);
					break;
					
				case SYM_QUOTE:
					if (IS_END(rules)) goto bad_end;
					rulen = 1;
					if (IS_PAREN(rules)) {
						item = Do_Block_Value_Throw(rules); // might GC
					}
					else item = rules;
					i = (0 == Cmp_Value(BLK_SKIP(series, index), item, parse->flags & AM_FIND_CASE)) ? index+1 : NOT_FOUND;
					break;

				case SYM_INTO:
					if (IS_END(rules)) goto bad_end;
					rulen = 1;
					item = Get_Parse_Value(rules); // sub-rules
					if (!IS_BLOCK(item)) goto bad_rule;
					val = BLK_SKIP(series, index);
					i = (
						(ANY_BINSTR(val) || ANY_BLOCK(val))
						&& (Parse_Series(val, VAL_BLK_DATA(item), parse->flags, depth+1) == VAL_TAIL(val))
					) ? index+1 : NOT_FOUND;
					break;

				case SYM_DO:
					if (!IS_BLOCK_INPUT(parse)) goto bad_rule;
					i = Do_Eval_Rule(parse, index, &rules);
					rulen = 1;
					break;

				default:
					goto bad_rule;
				}
			}
			else if (IS_BLOCK(item)) {
				item = VAL_BLK_DATA(item);
				//if (IS_END(rules) && item == rule_head) {
				//	rules = item;
				//	goto top;
				//}
				i = Parse_Rules_Loop(parse, index, item, depth+1);
				if (parse->result) {
					index = (parse->result > 0) ? i : NOT_FOUND;
					parse->result = 0;
					break;
				}
			}
			// Parse according to datatype:
			else {
				if (IS_BLOCK_INPUT(parse))
					i = Parse_Next_Block(parse, index, item, depth+1);
				else
					i = Parse_Next_String(parse, index, item, depth+1);
			}

			// Necessary for special cases like: some [to end]
			// i: indicates new index or failure of the match, but
			// that does not mean failure of the rule, because optional
			// matches can still succeed, if if the last match failed.
			if (i != NOT_FOUND) {
				count++; // may overflow to negative
				if (count < 0) count = MAX_I32; // the forever case
				// If input did not advance:
				if (i == index && !GET_FLAG(flags, PF_WHILE)) {
					if (count < mincount) index = NOT_FOUND; // was not enough
					break;
				}
			}
			//if (i >= series->tail) {     // OLD check: no more input
			else {
				if (count < mincount) index = NOT_FOUND; // was not enough
				else if (i != NOT_FOUND) index = i;
				// else keep index as is.
				break;
			}
			index = i;

			// A BREAK word stopped us:
			//if (parse->result) {parse->result = 0; break;}
		}

		rules += rulen;

		//if (index > series->tail && index != NOT_FOUND) index = series->tail;
		if (index > series->tail) index = NOT_FOUND;

		//--------------------------------------------------------------------
		// Post Match Processing:
		//--------------------------------------------------------------------
post:
		// Process special flags:
		if (flags) {
			// NOT before all others:
			if (GET_FLAG(flags, PF_NOT)) {
				if (GET_FLAG(flags, PF_NOT2) && index != NOT_FOUND) index = NOT_FOUND;
				else index = begin;
			}
			if (index == NOT_FOUND) { // Failure actions:
				// not decided: if (word) Set_Var_Basic(word, REB_NONE);
				if (GET_FLAG(flags, PF_THEN)) {
					SKIP_TO_BAR(rules);
					if (!IS_END(rules)) rules++;
				}
			}
			else {  // Success actions:
				count = (begin > index) ? 0 : index - begin; // how much we advanced the input
				if (GET_FLAG(flags, PF_COPY)) {
					ser = (IS_BLOCK_INPUT(parse))
						? Copy_Block_Len(series, begin, count)
						: Copy_String(series, begin, count); // condenses
					Set_Var_Series(word, parse->type, ser, 0);
				}
				else if (GET_FLAG(flags, PF_SET)) {
					if (IS_BLOCK_INPUT(parse)) {
						item = Get_Var_Safe(word);
						if (count == 0) SET_NONE(item);
						else *item = *BLK_SKIP(series, begin);
					}
					else {
						item = Get_Var_Safe(word);
						if (count == 0) SET_NONE(item);
						else {
							i = GET_ANY_CHAR(series, begin);
							if (parse->type == REB_BINARY) {
								SET_INTEGER(item, i);
							} else {
								SET_CHAR(item, i);
							}
						}
					}
				}
				if (GET_FLAG(flags, PF_RETURN)) {
					ser = (IS_BLOCK_INPUT(parse))
						? Copy_Block_Len(series, begin, count)
						: Copy_String(series, begin, count); // condenses
					Throw_Return_Series(parse->type, ser);
				}
				if (GET_FLAG(flags, PF_REMOVE)) {
					if (count) Remove_Series(series, begin, count);
					index = begin;
				}
				if (flags & (1<<PF_INSERT | 1<<PF_CHANGE)) {
					count = GET_FLAG(flags, PF_INSERT) ? 0 : count;
					cmd = GET_FLAG(flags, PF_INSERT) ? 0 : (1<<AN_PART);
					item = rules++;
					if (IS_END(item)) goto bad_end;
					// Check for ONLY flag:
					if (IS_WORD(item) && NZ(cmd = VAL_CMD(item))) {
						if (cmd != SYM_ONLY) goto bad_rule;
						cmd |= (1<<AN_ONLY);
						item = rules++;
					}
					// CHECK FOR QUOTE!!
					item = Get_Parse_Value(item); // new value
					if (IS_UNSET(item)) Trap1(RE_NO_VALUE, rules-1);
					if (IS_END(item)) goto bad_end;
					if (IS_BLOCK_INPUT(parse)) {
						index = Modify_Block(GET_FLAG(flags, PF_CHANGE) ? A_CHANGE : A_INSERT,
								series, begin, item, cmd, count, 1);
						if (IS_LIT_WORD(item)) SET_TYPE(BLK_SKIP(series, index-1), REB_WORD);
					}
					else {
						if (parse->type == REB_BINARY) cmd |= (1<<AN_SERIES); // special flag
						index = Modify_String(GET_FLAG(flags, PF_CHANGE) ? A_CHANGE : A_INSERT,
								series, begin, item, cmd, count, 1);
					}
				}
				if (GET_FLAG(flags, PF_AND)) index = begin;
			}

			flags = 0;
			word = 0;
		}

		// Goto alternate rule and reset input:
		if (index == NOT_FOUND) {
			SKIP_TO_BAR(rules);
			if (IS_END(rules)) break;
			rules++;
			index = begin = start;
		}

		begin = index;
		mincount = maxcount = 1;

	}
	return index;

bad_rule:
	Trap1(RE_PARSE_RULE, rules-1);
bad_end:
	Trap1(RE_PARSE_END, rules-1);
	return 0;
}
Example #11
0
*/	static REBCNT Parse_Next_Block(REBPARSE *parse, REBCNT index, REBVAL *item, REBCNT depth)
/*
**		Used for parsing blocks to match the next item in the ruleset.
**		If it matches, return the index just past it. Otherwise, return zero.
**
***********************************************************************/
{
	// !!! THIS CODE NEEDS CLEANUP AND REWRITE BASED ON OTHER CHANGES
	REBSER *series = parse->series;
	REBVAL *blk = BLK_SKIP(series, index);

	if (Trace_Level) {
		Trace_Value(7, item);
		Trace_Value(8, blk);
	}

	switch (VAL_TYPE(item)) {

	// Look for specific datattype:
	case REB_DATATYPE:
		index++;
		if (VAL_TYPE(blk) == (REBYTE)VAL_DATATYPE(item)) break;
		goto no_result;

	// Look for a set of datatypes:
	case REB_TYPESET:
		index++;
		if (TYPE_CHECK(item, VAL_TYPE(blk))) break;
		goto no_result;

	// 'word
	case REB_LIT_WORD:
		index++;
		if (IS_WORD(blk) && (VAL_WORD_CANON(blk) == VAL_WORD_CANON(item))) break;
		goto no_result;

	case REB_LIT_PATH:
		index++;
		if (IS_PATH(blk) && !Cmp_Block(blk, item, 0)) break;
		goto no_result;

	case REB_NONE:
		break;

	// Parse a sub-rule block:
	case REB_BLOCK:
		index = Parse_Rules_Loop(parse, index, VAL_BLK_DATA(item), depth);
		break;

	// Do an expression:
	case REB_PAREN:
		item = Do_Block_Value_Throw(item); // might GC
		// old: if (IS_ERROR(item)) Throw_Error(VAL_ERR_OBJECT(item));
        index = MIN(index, series->tail); // may affect tail
		break;

	// Match with some other value:
	default:
		index++;
		if (Cmp_Value(blk, item, (REBOOL)HAS_CASE(parse))) goto no_result;
	}

	return index;

no_result:
	return NOT_FOUND;
}