예제 #1
1
파일: c-function.c 프로젝트: draegtun/ren-c
*/	REBSER *List_Func_Types(REBVAL *func)
/*
**		Return a block of function arg types.
**		Note: skips 0th entry.
**
***********************************************************************/
{
	REBSER *block;
	REBSER *words = VAL_FUNC_WORDS(func);
	REBCNT n;
	REBVAL *value;
	REBVAL *word;

	block = Make_Block(SERIES_TAIL(words));
	word = BLK_SKIP(words, 1);

	for (n = 1; n < SERIES_TAIL(words); word++, n++) {
		value = Alloc_Tail_Blk(block);
		VAL_SET(value, VAL_TYPE(word));
		VAL_WORD_SYM(value) = VAL_BIND_SYM(word);
		UNBIND(value);
	}

	return block;
}
예제 #2
0
파일: t-object.c 프로젝트: 51weekend/r3
*/	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;
}
예제 #3
0
파일: c-port.c 프로젝트: kealist/ren-c
*/	REBCNT Find_Action(REBVAL *object, REBCNT action)
/*
**		Given an action number, return the action's index in
**		the specified object. If not found, a zero is returned.
**
***********************************************************************/
{
	return Find_Word_Index(VAL_OBJ_FRAME(object), VAL_BIND_SYM(Get_Action_Word(action)), FALSE);
}
예제 #4
0
*/	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;
}
예제 #5
0
*/	void Init_Frame_Word(REBVAL *value, REBCNT sym)
/*
**		Initialize as a word list word.
**
***********************************************************************/
{
	VAL_SET(value, REB_WORD);
	VAL_SET_OPT(value, OPTS_UNWORD);
	VAL_BIND_SYM(value) = sym;
	VAL_BIND_TYPESET(value) = ALL_64;
}
예제 #6
0
파일: c-frame.c 프로젝트: dailybarid/rebol
*/ void Collect_Words(REBVAL *block, REBFLG modes)
/*
**		The inner recursive loop used for Collect_Words function below.
**
***********************************************************************/
{
	REBINT *binds = WORDS_HEAD(Bind_Table);
	REBVAL *word;
	REBVAL *value;

	for (; NOT_END(block); block++) {
		value = block;
		//if (modes & BIND_GET && IS_GET_WORD(block)) value = Get_Var(block);
		if (ANY_WORD(value)) {
			if (!binds[VAL_WORD_CANON(value)]) {  // only once per word
				if (IS_SET_WORD(value) || modes & BIND_ALL) {
					binds[VAL_WORD_CANON(value)] = SERIES_TAIL(BUF_WORDS);
					EXPAND_SERIES_TAIL(BUF_WORDS, 1);
					word = BLK_LAST(BUF_WORDS);
					VAL_SET(word, VAL_TYPE(value));
					VAL_SET_OPT(word, OPTS_UNWORD);
					VAL_BIND_SYM(word) = VAL_WORD_SYM(value);
					// Allow all datatypes (to start):
					VAL_BIND_TYPESET(word) = ~((TYPESET(REB_END) | TYPESET(REB_UNSET))); // not END or UNSET
				}
			} else {
				// If word duplicated:
				if (modes & BIND_NO_DUP) {
					// Reset binding table (note BUF_WORDS may have expanded):
					for (word = BLK_HEAD(BUF_WORDS); NOT_END(word); word++)
						binds[VAL_WORD_CANON(word)] = 0;
					RESET_TAIL(BUF_WORDS);  // allow reuse
					Trap1(RE_DUP_VARS, value);
				}
			}
			continue;
		}
		// Recurse into sub-blocks:
		if (ANY_EVAL_BLOCK(value) && (modes & BIND_DEEP))
			Collect_Words(VAL_BLK_DATA(value), modes);
		// In this mode (foreach native), do not allow non-words:
		//else if (modes & BIND_GET) Trap_Arg(value);
	}
	BLK_TERM(BUF_WORDS);
}
예제 #7
0
파일: c-frame.c 프로젝트: dailybarid/rebol
*/  REBSER *Make_Object_Block(REBSER *frame, REBINT mode)
/*
**      Return a block containing words, values, or set-word: value
**      pairs for the given object. Note: words are bound to original
**      object.
**
**      Modes:
**          1 for word
**          2 for value
**          3 for words and values
**
***********************************************************************/
{
	REBVAL *words  = FRM_WORDS(frame);
	REBVAL *values = FRM_VALUES(frame);
	REBSER *block;
	REBVAL *value;
	REBCNT n;

	n = (mode & 4) ? 0 : 1;
	block = Make_Block(SERIES_TAIL(frame) * (n + 1));

	for (; n < SERIES_TAIL(frame); n++) {
		if (!VAL_GET_OPT(words+n, OPTS_HIDE)) {
			if (mode & 1) {
				value = Append_Value(block);
				if (mode & 2) {
					VAL_SET(value, REB_SET_WORD);
					VAL_SET_LINE(value);
				}
				else VAL_SET(value, REB_WORD); //VAL_TYPE(words+n));
				VAL_WORD_SYM(value) = VAL_BIND_SYM(words+n);
				VAL_WORD_INDEX(value) = n;
				VAL_WORD_FRAME(value) = frame;
			}
			if (mode & 2) {
				Append_Val(block, values+n);
			}
		}
	}

	return block;
}
예제 #8
0
파일: c-frame.c 프로젝트: MannyZhong/r3
*/  REBSER *Merge_Frames(REBSER *parent, REBSER *child)
/*
**      Create a frame from two frames. Merge common fields.
**      Values from the second frame take precedence. No rebinding.
**
***********************************************************************/
{
	REBSER *wrds;
	REBSER *frame;
	REBVAL *words;
	REBVAL *value;
	REBCNT n;

	// Merge parent and child words. This trick works because the
	// word list is itself a valid block.
	wrds = Collect_Frame(BIND_ALL, parent, BLK_SKIP(FRM_WORD_SERIES(child),1));

	// Allocate frame (now that we know the correct size):
	frame = Make_Block(SERIES_TAIL(wrds));  // GC!!!
	value = Append_Value(frame);
	VAL_SET(value, REB_FRAME);
	VAL_FRM_WORDS(value) = wrds;
	VAL_FRM_SPEC(value) = 0;

	// Copy parent values:
	COPY_VALUES(FRM_VALUES(parent)+1, FRM_VALUES(frame)+1, SERIES_TAIL(parent)-1);

	// Copy new words and values:
	words = FRM_WORDS(child)+1;
	value = FRM_VALUES(child)+1;
	for (; NOT_END(words); words++, value++) {
		n = Find_Word_Index(frame, VAL_BIND_SYM(words), FALSE);
		if (n) BLK_HEAD(frame)[n] = *value;
	}

	// Terminate the new frame:
	SERIES_TAIL(frame) = SERIES_TAIL(wrds);
	BLK_TERM(frame);

	return frame;
}
예제 #9
0
파일: c-frame.c 프로젝트: dailybarid/rebol
*/  REBCNT Find_Word_Index(REBSER *frame, REBCNT sym, REBFLG always)
/*
**      Search a frame looking for the given word symbol.
**      Return the frame index for a word. Locate it by matching
**      the canon word identifiers. Return 0 if not found.
**
***********************************************************************/
{
	REBCNT len = SERIES_TAIL(FRM_WORD_SERIES(frame));
	REBVAL *word = FRM_WORDS(frame) + 1;
	REBCNT n;
	REBCNT s;

	s = SYMBOL_TO_CANON(sym); // always compare to CANON sym

	for (n = 1; n < len; n++, word++)
		if (sym == VAL_BIND_SYM(word) || s == VAL_BIND_CANON(word))
			return (!always && VAL_GET_OPT(word, OPTS_HIDE)) ? 0 : n;

	return 0;
}
예제 #10
0
파일: c-frame.c 프로젝트: dailybarid/rebol
*/  REBCNT Find_Arg_Index(REBSER *args, REBCNT sym)
/*
**		Find function arg word in function arg "frame".
**
***********************************************************************/
{
	REBCNT n;
	REBCNT s;
	REBVAL *word;
	REBCNT len;

	s = SYMBOL_TO_CANON(sym); // always compare to CANON sym

	word = BLK_SKIP(args, 1);
	len = SERIES_TAIL(args);

	for (n = 1; n < len; n++, word++)
		if (sym == VAL_BIND_SYM(word) || s == VAL_BIND_CANON(word)) return n;

	return 0;
}
예제 #11
0
xx*/  void Dump_Frame(REBSER *frame, REBINT limit)
/*
***********************************************************************/
{
	REBINT n;
	REBVAL *values = FRM_VALUES(frame);
	REBVAL *words  = FRM_WORDS(frame);

	if (limit == -1 || limit > (REBINT)SERIES_TAIL(frame))
		limit = SERIES_TAIL(frame);

	Debug_Fmt("Frame: %x len = %d", frame, SERIES_TAIL(frame));
	for (n = 0; n < limit; n++, values++, words++) {
		Debug_Fmt("  %02d: %s (%s) [%s]",
			n,
			Get_Sym_Name(VAL_BIND_SYM(words)),
			Get_Sym_Name(VAL_BIND_CANON(words)),
			Get_Type_Name(values)
		);
	}

	if (limit >= (REBINT)SERIES_TAIL(frame) && NOT_END(words))
		Debug_Fmt("** Word list not terminated! Type: %d, Tail: %d", VAL_TYPE(words), SERIES_TAIL(frame));
}
예제 #12
0
파일: c-frame.c 프로젝트: dailybarid/rebol
*/	void Resolve_Context(REBSER *target, REBSER *source, REBVAL *only_words, REBFLG all, REBFLG expand)
/*
**		Only_words can be a block of words or an index in the target
**		(for new words).
**
***********************************************************************/
{
	REBINT *binds  = WORDS_HEAD(Bind_Table); // GC safe to do here
	REBVAL *words;
	REBVAL *vals;
	REBINT n;
	REBINT m;
	REBCNT i = 0;

	CHECK_BIND_TABLE;

	if (IS_PROTECT_SERIES(target)) Trap0(RE_PROTECTED);

	if (IS_INTEGER(only_words)) { // Must be: 0 < i <= tail
		i = VAL_INT32(only_words); // never <= 0
		if (i == 0) i = 1;
		if (i >= target->tail) return;
	}

	Collect_Start(BIND_NO_SELF);  // DO NOT TRAP IN THIS SECTION

	n = 0;

	// If limited resolve, tag the word ids that need to be copied:
	if (i) {
		// Only the new words of the target:
		for (words = FRM_WORD(target, i); NOT_END(words); words++)
			binds[VAL_BIND_CANON(words)] = -1;
		n = SERIES_TAIL(target) - 1;
	}
	else if (IS_BLOCK(only_words)) {
		// Limit exports to only these words:
		for (words = VAL_BLK_DATA(only_words); NOT_END(words); words++) {
			if (IS_WORD(words) || IS_SET_WORD(words)) {
				binds[VAL_WORD_CANON(words)] = -1;
				n++;
			}
		}
	}

	// Expand target as needed:
	if (expand && n > 0) {
		// Determine how many new words to add:
		for (words = FRM_WORD(target, 1); NOT_END(words); words++)
			if (binds[VAL_BIND_CANON(words)]) n--;
		// Expand frame by the amount required:
		if (n > 0) Expand_Frame(target, n, 0);
		else expand = 0;
	}

	// Maps a word to its value index in the source context.
	// Done by marking all source words (in bind table):
	words = FRM_WORDS(source)+1;
	for (n = 1; NOT_END(words); n++, words++) {
		if (IS_NONE(only_words) || binds[VAL_BIND_CANON(words)])
			binds[VAL_WORD_CANON(words)] = n;
	}

	// Foreach word in target, copy the correct value from source:
	n = i ? i : 1;
	vals = FRM_VALUE(target, n);
	for (words = FRM_WORD(target, n); NOT_END(words); words++, vals++) {
		if ((m = binds[VAL_BIND_CANON(words)])) {
			binds[VAL_BIND_CANON(words)] = 0; // mark it as set
			if (!VAL_PROTECTED(words) && (all || IS_UNSET(vals))) {
				if (m < 0) SET_UNSET(vals); // no value in source context
				else *vals = *FRM_VALUE(source, m);
				//Debug_Num("type:", VAL_TYPE(vals));
				//Debug_Str(Get_Word_Name(words));
			}
		}
	}

	// Add any new words and values:
	if (expand) {
		REBVAL *val;
		words = FRM_WORDS(source)+1;
		for (n = 1; NOT_END(words); n++, words++) {
			if (binds[VAL_BIND_CANON(words)]) {
				// Note: no protect check is needed here
				binds[VAL_BIND_CANON(words)] = 0;
				val = Append_Frame(target, 0, VAL_BIND_SYM(words));
				*val = *FRM_VALUE(source, n);
			}
		}
	}
	else {
		// Reset bind table (do not use Collect_End):
		if (i) {
			for (words = FRM_WORD(target, i); NOT_END(words); words++)
				binds[VAL_BIND_CANON(words)] = 0;
		}
		else if (IS_BLOCK(only_words)) {
			for (words = VAL_BLK_DATA(only_words); NOT_END(words); words++) {
				if (IS_WORD(words) || IS_SET_WORD(words)) binds[VAL_WORD_CANON(words)] = 0;
			}
		}
		else {
			for (words = FRM_WORDS(source)+1; NOT_END(words); words++)
				binds[VAL_BIND_CANON(words)] = 0;
		}
	}

	CHECK_BIND_TABLE;

	RESET_TAIL(BUF_WORDS);  // allow reuse, trapping ok now
}
예제 #13
0
파일: t-map.c 프로젝트: draegtun/ren-c
*/	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;
}