*/ 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;
}
*/ 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;
}
//
// 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;
}
*/ 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;
}
*/ REBYTE *Get_Word_Name(REBVAL *value)
/*
***********************************************************************/
{
if (value) return Get_Sym_Name(VAL_WORD_SYM(value));
return (REBYTE*)"(unnamed)";
}
//
// 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
}
xx*/ void Dump_Word_Value(REBVAL *word)
/*
***********************************************************************/
{
Debug_Fmt("Word: %s (Symbol %d Frame %x Index %d)", Get_Word_Name(word),
VAL_WORD_SYM(word), VAL_WORD_FRAME(word), VAL_WORD_INDEX(word));
}
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, ' ');
}
}
}
*/ REBVAL *Append_Frame(REBSER *frame, REBVAL *word, REBCNT sym)
/*
** Append a word to the frame word list. Expands the list
** if necessary. Returns the value cell for the word. (Set to
** UNSET by default to avoid GC corruption.)
**
** If word is not NULL, use the word sym and bind the word value,
** otherwise use sym.
**
***********************************************************************/
{
REBSER *words = FRM_WORD_SERIES(frame);
REBVAL *value;
// Add to word list:
EXPAND_SERIES_TAIL(words, 1);
value = BLK_LAST(words);
Val_Init_Word_Typed(value, REB_WORD, word ? VAL_WORD_SYM(word) : sym, ALL_64);
BLK_TERM(words);
// Bind the word to this frame:
if (word) {
VAL_WORD_FRAME(word) = frame;
VAL_WORD_INDEX(word) = frame->tail;
}
// Add unset value to frame:
EXPAND_SERIES_TAIL(frame, 1);
word = BLK_LAST(frame);
SET_UNSET(word);
BLK_TERM(frame);
return word; // The value cell for word.
}
*/ 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;
}
*/ void Set_Word(REBVAL *value, REBINT sym, REBSER *frame, REBCNT index)
/*
***********************************************************************/
{
VAL_SET(value, REB_WORD);
VAL_WORD_SYM(value) = sym;
VAL_WORD_FRAME(value) = frame;
VAL_WORD_INDEX(value) = index;
}
//
// 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 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;
}
*/ void Init_Word(REBVAL *value, REBCNT sym)
/*
** Initialize a value as a word. Set frame as unbound (no context).
**
***********************************************************************/
{
VAL_SET(value, REB_WORD);
VAL_WORD_INDEX(value) = 0;
VAL_WORD_FRAME(value) = 0;
VAL_WORD_SYM(value) = sym;
}
//
// CT_Word: C
//
REBINT CT_Word(REBVAL *a, REBVAL *b, REBINT mode)
{
REBINT e;
REBINT diff;
if (mode >= 0) {
e = VAL_WORD_CANON(a) == VAL_WORD_CANON(b);
if (mode == 1) e &= VAL_WORD_INDEX(a) == VAL_WORD_INDEX(b)
&& VAL_WORD_FRAME(a) == VAL_WORD_FRAME(b);
else if (mode >= 2) {
e = (VAL_WORD_SYM(a) == VAL_WORD_SYM(b) &&
VAL_WORD_INDEX(a) == VAL_WORD_INDEX(b) &&
VAL_WORD_FRAME(a) == VAL_WORD_FRAME(b));
}
} else {
diff = Compare_Word(a, b, FALSE);
if (mode == -1) e = diff >= 0;
else e = diff > 0;
}
return e;
}
*/ void Bind_Stack_Word(REBSER *frame, REBVAL *word)
/*
***********************************************************************/
{
REBINT index;
index = Find_Arg_Index(frame, VAL_WORD_SYM(word));
if (!index) Trap1(RE_NOT_IN_CONTEXT, word);
VAL_WORD_FRAME(word) = frame;
VAL_WORD_INDEX(word) = -index;
}
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);
}
//
// 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;
}
*/ 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;
}
//
// 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;
}
//
// 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;
}
*/ REBOOL Loop_Throw_Should_Return(REBVAL *val)
/*
** Process values thrown during loop, and tell the loop whether
** to take that processed value and return it up the stack.
** If not, then the throw was a continue...and the code
** should just keep going.
**
** Note: This modifies the input value. If it returns FALSE
** then the value is guaranteed to not be THROWN(), but it
** may-or-may-not be THROWN() if TRUE is returned.
**
***********************************************************************/
{
assert(THROWN(val));
// Using words for BREAK and CONTINUE to parallel old VAL_ERR_SYM()
// code. So if the throw wasn't a word it can't be either of those,
// hence the loop doesn't handle it and needs to bubble up the THROWN()
if (!IS_WORD(val))
return TRUE;
// If it's a CONTINUE then wipe out the THROWN() value with UNSET,
// and tell the loop it doesn't have to return.
if (VAL_WORD_SYM(val) == SYM_CONTINUE) {
SET_UNSET(val);
return FALSE;
}
// If it's a BREAK, get the /WITH value (UNSET! if no /WITH) and
// say it should be returned.
if (VAL_WORD_SYM(val) == SYM_BREAK) {
TAKE_THROWN_ARG(val, val);
return TRUE;
}
// Else: Let all other THROWN() values bubble up.
return TRUE;
}
void set_font_styles(REBFNT* font, REBVAL* val){
REBINT result = Reb_Find_Word(VAL_WORD_SYM(val), Symbol_Ids, 0);
switch (result){
case SW_BOLD:
font->bold = TRUE;
break;
case SW_ITALIC:
font->italic = TRUE;
break;
case SW_UNDERLINE:
font->underline = TRUE;
break;
}
}
*/ REBCNT Bind_Word(REBSER *frame, REBVAL *word)
/*
** Binds a word to a frame. If word is not part of the
** frame, ignore it.
**
***********************************************************************/
{
REBCNT n;
n = Find_Word_Index(frame, VAL_WORD_SYM(word), FALSE);
if (n) {
VAL_WORD_FRAME(word) = frame;
VAL_WORD_INDEX(word) = n;
}
return n;
}
*/ 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;
}
*/ static void Collect_Frame_Inner_Loop(REBINT *binds, REBVAL value[], REBCNT modes)
/*
** The inner recursive loop used for Collect_Frame function below.
**
***********************************************************************/
{
for (; NOT_END(value); value++) {
if (ANY_WORD(value)) {
if (!binds[VAL_WORD_CANON(value)]) { // only once per word
if (IS_SET_WORD(value) || modes & BIND_ALL) {
REBVAL *word;
binds[VAL_WORD_CANON(value)] = SERIES_TAIL(BUF_WORDS);
EXPAND_SERIES_TAIL(BUF_WORDS, 1);
word = BLK_LAST(BUF_WORDS);
Val_Init_Word_Typed(
word,
VAL_TYPE(value),
VAL_WORD_SYM(value),
// Allow all datatypes but END or UNSET (initially):
~((TYPESET(REB_END) | TYPESET(REB_UNSET)))
);
}
} else {
// If word duplicated:
if (modes & BIND_NO_DUP) {
// Reset binding table (note BUF_WORDS may have expanded):
REBVAL *word;
for (word = BLK_HEAD(BUF_WORDS); NOT_END(word); word++)
binds[VAL_WORD_CANON(word)] = 0;
RESET_TAIL(BUF_WORDS); // allow reuse
raise Error_1(RE_DUP_VARS, value);
}
}
continue;
}
// Recurse into sub-blocks:
if (ANY_EVAL_BLOCK(value) && (modes & BIND_DEEP))
Collect_Frame_Inner_Loop(binds, VAL_BLK_DATA(value), modes);
// In this mode (foreach native), do not allow non-words:
//else if (modes & BIND_GET) raise Error_Invalid_Arg(value);
}
BLK_TERM(BUF_WORDS);
}
*/ 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;
}
*/ REBSER *Map_To_Object(REBSER *mapser)
/*
***********************************************************************/
{
REBVAL *val;
REBCNT cnt = 0;
REBSER *frame;
REBVAL *key;
REBVAL *mval;
// Count number of set entries:
for (mval = BLK_HEAD(mapser); NOT_END(mval) && NOT_END(mval+1); mval += 2) {
if (ANY_WORD(mval) && !IS_NONE(mval+1)) cnt++;
}
// See Make_Frame() - cannot use it directly because no Collect_Words
frame = Make_Frame(cnt, TRUE);
key = FRM_KEY(frame, 1);
val = FRM_VALUE(frame, 1);
for (mval = BLK_HEAD(mapser); NOT_END(mval) && NOT_END(mval+1); mval += 2) {
if (ANY_WORD(mval) && !IS_NONE(mval+1)) {
// !!! Used to leave SET_WORD typed values here... but why?
// (Objects did not make use of the set-word vs. other distinctions
// that function specs did.)
Val_Init_Typeset(
key,
// all types except END or UNSET
~((FLAGIT_64(REB_END) | FLAGIT_64(REB_UNSET))),
VAL_WORD_SYM(mval)
);
key++;
*val++ = mval[1];
}
}
SET_END(key);
SET_END(val);
FRM_KEYLIST(frame)->tail = frame->tail = cnt + 1;
return frame;
}