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