//
// Map_To_Block: C
//
// mapser = series of the map
// what: -1 - words, +1 - values, 0 -both
//
REBSER *Map_To_Block(REBSER *mapser, REBINT what)
{
REBVAL *val;
REBCNT cnt = 0;
REBSER *blk;
REBVAL *out;
// Count number of set entries:
for (val = BLK_HEAD(mapser); NOT_END(val) && NOT_END(val+1); val += 2) {
if (!IS_NONE(val+1)) cnt++; // must have non-none value
}
// Copy entries to new block:
blk = Make_Array(cnt * ((what == 0) ? 2 : 1));
out = BLK_HEAD(blk);
for (val = BLK_HEAD(mapser); NOT_END(val) && NOT_END(val+1); val += 2) {
if (!IS_NONE(val+1)) {
if (what <= 0) *out++ = val[0];
if (what >= 0) *out++ = val[1];
}
}
SET_END(out);
blk->tail = out - BLK_HEAD(blk);
return blk;
}
//
// Copy_And_Bind_Relative_Deep_Managed: C
//
// This routine is called by Make_Function in order to take the raw material
// given as a function body, and de-relativize any IS_RELATIVE(value)s that
// happen to be in it already (as any Copy does). But it also needs to make
// new relative references to ANY-WORD! that are referencing function
// parameters, as well as to relativize the copies of ANY-ARRAY! that contain
// these relative words...so that they refer to the archetypal function
// to which they should be relative.
//
REBARR *Copy_And_Bind_Relative_Deep_Managed(
const REBVAL *body,
REBARR *paramlist, // body of function is not actually ready yet
REBU64 bind_types
) {
// !!! Currently this is done in two phases, because the historical code
// would use the generic copying code and then do a bind phase afterward.
// Both phases are folded into this routine to make it easier to make
// a one-pass version when time permits.
//
REBARR *copy = COPY_ANY_ARRAY_AT_DEEP_MANAGED(body);
struct Reb_Binder binder;
INIT_BINDER(&binder);
// Setup binding table from the argument word list
//
REBCNT index = 1;
RELVAL *param = ARR_AT(paramlist, 1); // [0] is FUNCTION! value
for (; NOT_END(param); param++, index++)
Add_Binder_Index(&binder, VAL_KEY_CANON(param), index);
Bind_Relative_Inner_Loop(&binder, ARR_HEAD(copy), paramlist, bind_types);
// Reset binding table
//
param = ARR_AT(paramlist, 1); // [0] is FUNCTION! value
for (; NOT_END(param); param++)
Remove_Binder_Index(&binder, VAL_KEY_CANON(param));
SHUTDOWN_BINDER(&binder);
return copy;
}
*/ void Bind_Relative(REBSER *words, REBSER *frame, REBSER *block)
/*
** Bind the words of a function block to a stack frame.
** To indicate the relative nature of the index, it is set to
** a negative offset.
**
** words: VAL_FUNC_ARGS(func)
** frame: VAL_FUNC_ARGS(func)
** block: block to bind
**
***********************************************************************/
{
REBVAL *args;
REBINT index;
REBINT *binds = WORDS_HEAD(Bind_Table); // GC safe to do here
args = BLK_SKIP(words, 1);
CHECK_BIND_TABLE;
//Dump_Block(words);
// Setup binding table from the argument word list:
for (index = 1; NOT_END(args); args++, index++)
binds[VAL_BIND_CANON(args)] = -index;
Bind_Relative_Words(frame, block);
// Reset binding table:
for (args = BLK_SKIP(words, 1); NOT_END(args); args++)
binds[VAL_BIND_CANON(args)] = 0;
}
static REBSER *Trim_Object(REBSER *obj)
{
REBVAL *val;
REBINT cnt = 0;
REBSER *nobj;
REBVAL *nval;
REBVAL *word;
REBVAL *nwrd;
word = FRM_WORDS(obj)+1;
for (val = FRM_VALUES(obj)+1; NOT_END(val); val++, word++) {
if (VAL_TYPE(val) > REB_NONE && !VAL_GET_OPT(word, OPTS_HIDE))
cnt++;
}
nobj = Make_Frame(cnt);
nval = FRM_VALUES(nobj)+1;
word = FRM_WORDS(obj)+1;
nwrd = FRM_WORDS(nobj)+1;
for (val = FRM_VALUES(obj)+1; NOT_END(val); val++, word++) {
if (VAL_TYPE(val) > REB_NONE && !VAL_GET_OPT(word, OPTS_HIDE)) {
*nval++ = *val;
*nwrd++ = *word;
}
}
SET_END(nval);
SET_END(nwrd);
SERIES_TAIL(nobj) = cnt+1;
SERIES_TAIL(FRM_WORD_SERIES(nobj)) = cnt+1;
return nobj;
}
//
// Append_Map: C
//
static void Append_Map(REBSER *ser, REBVAL *arg, REBCNT len)
{
REBVAL *val;
REBCNT n;
val = VAL_BLK_DATA(arg);
for (n = 0; n < len && NOT_END(val) && NOT_END(val+1); val += 2, n += 2) {
Find_Entry(ser, val, val+1);
}
}
STOID Mold_Block_Series(REB_MOLD *mold, REBSER *series, REBCNT index, REBYTE *sep)
{
REBSER *out = mold->series;
REBOOL line_flag = FALSE; // newline was part of block
REBOOL had_lines = FALSE;
REBVAL *value = BLK_SKIP(series, index);
if (!sep) sep = "[]";
if (IS_END(value)) {
Append_Bytes(out, sep);
return;
}
// Recursion check: (variation of: Find_Same_Block(MOLD_LOOP, value))
for (value = BLK_HEAD(MOLD_LOOP); NOT_END(value); value++) {
if (VAL_SERIES(value) == series) {
Emit(mold, "C...C", sep[0], sep[1]);
return;
}
}
value = Append_Value(MOLD_LOOP);
Set_Block(value, series);
if (sep[1]) {
Append_Byte(out, sep[0]);
mold->indent++;
}
// else out->tail--; // why?????
value = BLK_SKIP(series, index);
while (NOT_END(value)) {
if (VAL_GET_LINE(value)) {
if (sep[1] || line_flag) New_Indented_Line(mold);
had_lines = TRUE;
}
line_flag = TRUE;
Mold_Value(mold, value, TRUE);
value++;
if (NOT_END(value))
Append_Byte(out, (sep[0] == '/') ? '/' : ' ');
}
if (sep[1]) {
mold->indent--;
if (VAL_GET_LINE(value) || had_lines) New_Indented_Line(mold);
Append_Byte(out, sep[1]);
}
Remove_Last(MOLD_LOOP);
}
//
// Bind_Values_Core: C
//
// Bind words in an array of values terminated with END
// to a specified context. See warnings on the functions like
// Bind_Values_Deep() about not passing just a singular REBVAL.
//
// NOTE: If types are added, then they will be added in "midstream". Only
// bindings that come after the added value is seen will be bound.
//
void Bind_Values_Core(
RELVAL *head,
REBCTX *context,
REBU64 bind_types,
REBU64 add_midstream_types,
REBFLGS flags // see %sys-core.h for BIND_DEEP, etc.
) {
struct Reb_Binder binder;
INIT_BINDER(&binder);
// Via the global hash table, each spelling of the word can find the
// canon form of the word. Associate that with an index number to signal
// a binding should be created to this context (at that index.)
REBCNT index = 1;
REBVAL *key = CTX_KEYS_HEAD(context);
for (; index <= CTX_LEN(context); key++, index++)
if (!GET_VAL_FLAG(key, TYPESET_FLAG_UNBINDABLE))
Add_Binder_Index(&binder, VAL_KEY_CANON(key), index);
Bind_Values_Inner_Loop(
&binder, head, context, bind_types, add_midstream_types, flags
);
// Reset all the binder indices to zero, balancing out what was added.
key = CTX_KEYS_HEAD(context);
for (; NOT_END(key); key++)
Remove_Binder_Index(&binder, VAL_KEY_CANON(key));
SHUTDOWN_BINDER(&binder);
}
*/ RL_API u32 *RL_Map_Words(REBSER *series)
/*
** Given a block of word values, return an array of word ids.
**
** Returns:
** An array of global word identifiers (integers). The [0] value is the size.
** Arguments:
** series - block of words as values (from REBOL blocks, not strings.)
** Notes:
** Word identifiers are persistent, and you can use them anytime.
** The block can include any kind of word, including set-words, lit-words, etc.
** If the input block contains non-words, they will be skipped.
** The array is allocated with OS_ALLOC and you can OS_FREE it any time.
**
***********************************************************************/
{
REBCNT i = 1;
u32 *words;
REBVAL *val = BLK_HEAD(series);
words = OS_ALLOC_ARRAY(u32, series->tail + 2);
for (; NOT_END(val); val++) {
if (ANY_WORD(val)) words[i++] = VAL_WORD_CANON(val);
}
words[0] = i;
words[i] = 0;
return words;
}
//
// RL_Words_Of_Object: C
//
// Returns information about the object.
//
// Returns:
// Returns an array of words used as fields of the object.
// Arguments:
// obj - object pointer (e.g. from RXA_OBJECT)
// Notes:
// Returns a word array similar to MAP_WORDS().
// The array is allocated with OS_ALLOC. You can OS_FREE it any time.
//
RL_API u32 *RL_Words_Of_Object(REBSER *obj)
{
REBCNT index;
u32 *syms;
REBVAL *key;
REBCTX *context = AS_CONTEXT(obj);
key = CTX_KEYS_HEAD(context);
// We don't include hidden keys (e.g. SELF), but terminate by 0.
// Conservative estimate that there are no hidden keys, add one.
//
syms = OS_ALLOC_N(u32, CTX_LEN(context) + 1);
index = 0;
for (; NOT_END(key); key++) {
if (GET_VAL_FLAG(key, TYPESET_FLAG_HIDDEN))
continue;
syms[index] = VAL_TYPESET_CANON(key);
index++;
}
syms[index] = SYM_0; // Null terminate
return syms;
}
*/ REBSER *Collect_Words(REBVAL value[], REBVAL prior_value[], REBCNT modes)
/*
** Collect words from a prior block and new block.
**
***********************************************************************/
{
REBSER *series;
REBCNT start;
REBINT *binds = WORDS_HEAD(Bind_Table); // GC safe to do here
CHECK_BIND_TABLE;
if (SERIES_TAIL(BUF_WORDS)) panic Error_0(RE_WORD_LIST); // still in use
if (prior_value)
Collect_Words_Inner_Loop(binds, &prior_value[0], BIND_ALL);
start = SERIES_TAIL(BUF_WORDS);
Collect_Words_Inner_Loop(binds, &value[0], modes);
// Reset word markers:
for (value = BLK_HEAD(BUF_WORDS); NOT_END(value); value++)
binds[VAL_WORD_CANON(value)] = 0;
series = Copy_Array_At_Max_Shallow(
BUF_WORDS, start, SERIES_TAIL(BUF_WORDS) - start
);
RESET_TAIL(BUF_WORDS); // allow reuse
CHECK_BIND_TABLE;
return series;
}
*/ 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;
}
//
// 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));
}
*/ REBSER *Merge_Frames(REBSER *parent1, REBSER *parent2)
/*
** Create a child frame from two parent frames. Merge common fields.
** Values from the second parent take precedence.
**
** Deep copy and rebind the child.
**
***********************************************************************/
{
REBSER *wrds;
REBSER *child;
REBVAL *words;
REBVAL *value;
REBCNT n;
REBINT *binds = WORDS_HEAD(Bind_Table);
// Merge parent1 and parent2 words.
// Keep the binding table.
Collect_Start(BIND_ALL);
// Setup binding table and BUF_WORDS with parent1 words:
if (parent1) Collect_Object(parent1);
// Add parent2 words to binding table and BUF_WORDS:
Collect_Words(BLK_SKIP(FRM_WORD_SERIES(parent2), 1), BIND_ALL);
// Allocate child (now that we know the correct size):
wrds = Copy_Series(BUF_WORDS);
child = Make_Block(SERIES_TAIL(wrds));
value = Append_Value(child);
VAL_SET(value, REB_FRAME);
VAL_FRM_WORDS(value) = wrds;
VAL_FRM_SPEC(value) = 0;
// Copy parent1 values:
COPY_VALUES(FRM_VALUES(parent1)+1, FRM_VALUES(child)+1, SERIES_TAIL(parent1)-1);
// Copy parent2 values:
words = FRM_WORDS(parent2)+1;
value = FRM_VALUES(parent2)+1;
for (; NOT_END(words); words++, value++) {
// no need to search when the binding table is available
n = binds[VAL_WORD_CANON(words)];
BLK_HEAD(child)[n] = *value;
}
// Terminate the child frame:
SERIES_TAIL(child) = SERIES_TAIL(wrds);
BLK_TERM(child);
// Deep copy the child
Copy_Deep_Values(child, 1, SERIES_TAIL(child), TS_CLONE);
// Rebind the child
Rebind_Block(parent1, child, BLK_SKIP(child, 1), REBIND_FUNC);
Rebind_Block(parent2, child, BLK_SKIP(child, 1), REBIND_FUNC | REBIND_TABLE);
// release the bind table
Collect_End(wrds);
return child;
}
*/ static void Bind_Relative_Words(REBSER *frame, REBSER *block)
/*
** Recursive function for relative function word binding.
**
** Note: frame arg points to an identifying series of the function,
** not a normal frame. This will be used to verify the word fetch.
**
***********************************************************************/
{
REBVAL *value = BLK_HEAD(block);
REBINT n;
for (; NOT_END(value); value++) {
if (ANY_WORD(value)) {
// Is the word (canon sym) found in this frame?
if (NZ(n = WORDS_HEAD(Bind_Table)[VAL_WORD_CANON(value)])) {
// Word is in frame, bind it:
VAL_WORD_INDEX(value) = n;
VAL_WORD_FRAME(value) = frame; // func body
}
}
else if (ANY_BLOCK(value))
Bind_Relative_Words(frame, VAL_SERIES(value));
}
}
*/ REBSER *Collect_Block_Words(REBVAL *block, REBVAL *prior, REBCNT modes)
/*
** Collect words from a prior block and new block.
**
***********************************************************************/
{
REBSER *series;
REBCNT start;
REBINT *binds = WORDS_HEAD(Bind_Table); // GC safe to do here
CHECK_BIND_TABLE;
if (SERIES_TAIL(BUF_WORDS)) Crash(RP_WORD_LIST); // still in use
if (prior)
Collect_Simple_Words(prior, BIND_ALL);
start = SERIES_TAIL(BUF_WORDS);
Collect_Simple_Words(block, modes);
// Reset word markers:
for (block = BLK_HEAD(BUF_WORDS); NOT_END(block); block++)
binds[VAL_WORD_CANON(block)] = 0;
series = Copy_Series_Part(BUF_WORDS, start, SERIES_TAIL(BUF_WORDS)-start);
RESET_TAIL(BUF_WORDS); // allow reuse
CHECK_BIND_TABLE;
return series;
}
*/ REBFLG MT_Tuple(REBVAL *out, REBVAL *data, REBCNT type)
/*
***********************************************************************/
{
REBYTE *vp;
REBINT len = 0;
REBINT n;
vp = VAL_TUPLE(out);
for (; NOT_END(data); data++, vp++, len++) {
if (len >= 10) return FALSE;
if (IS_INTEGER(data)) {
n = Int32(data);
}
else if (IS_CHAR(data)) {
n = VAL_CHAR(data);
}
else return FALSE;
if (n > 255 || n < 0) return FALSE;
*vp = n;
}
VAL_TUPLE_LEN(out) = len;
for (; len < 10; len++) *vp++ = 0;
VAL_SET(out, type);
return TRUE;
}
*/ 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;
}
/***********************************************************************
**
** Get_Obj_Mods -- return a block of modified words from an object
**
***********************************************************************/
REBVAL *Get_Obj_Mods(REBFRM *frame, REBVAL **inter_block)
{
REBVAL *obj = D_ARG(1);
REBVAL *words, *val;
REBFRM *frm = VAL_OBJ_FRAME(obj);
REBSER *ser = Make_Block(2);
REBOOL clear = D_REF(2);
//DISABLE_GC;
val = BLK_HEAD(frm->values);
words = BLK_HEAD(frm->words);
for (; NOT_END(val); val++, words++)
if (!(VAL_FLAGS(val) & FLAGS_CLEAN)) {
Append_Val(ser, words);
if (clear) VAL_FLAGS(val) |= FLAGS_CLEAN;
}
if (!STR_LEN(ser)) {
ENABLE_GC;
goto is_none;
}
Bind_Block(frm, BLK_HEAD(ser), FALSE);
VAL_SERIES(Temp_Blk_Value) = ser;
//ENABLE_GC;
return Temp_Blk_Value;
}
*/ void Init_Errors(REBVAL *errors)
/*
***********************************************************************/
{
REBSER *errs;
REBVAL *val;
// Create error objects and error type objects:
*ROOT_ERROBJ = *Get_System(SYS_STANDARD, STD_ERROR);
errs = Construct_Object(0, VAL_BLK(errors), 0);
Set_Object(Get_System(SYS_CATALOG, CAT_ERRORS), errs);
Set_Root_Series(TASK_ERR_TEMPS, Make_Block(3));
// Create objects for all error types:
for (val = BLK_SKIP(errs, 1); NOT_END(val); val++) {
errs = Construct_Object(0, VAL_BLK(val), 0);
SET_OBJECT(val, errs);
}
// Catch top level errors, to provide decent output:
PUSH_STATE(Top_State, Saved_State);
if (SET_JUMP(Top_State)) {
POP_STATE(Top_State, Saved_State);
DSP++; // Room for return value
Catch_Error(DS_TOP); // Stores error value here
Print_Value(DS_TOP, 0, FALSE);
Crash(RP_NO_CATCH);
}
SET_STATE(Top_State, Saved_State);
}
*/ REBSER *Collect_End(REBSER *prior)
/*
** Finish collecting words, and free the Bind_Table for reuse.
**
***********************************************************************/
{
REBVAL *words;
REBINT *binds = WORDS_HEAD(Bind_Table); // GC safe to do here
// Reset binding table (note BUF_WORDS may have expanded):
for (words = BLK_HEAD(BUF_WORDS); NOT_END(words); words++)
binds[VAL_WORD_CANON(words)] = 0;
// If no new words, prior frame:
if (prior && SERIES_TAIL(BUF_WORDS) == SERIES_TAIL(prior)) {
RESET_TAIL(BUF_WORDS); // allow reuse
return FRM_WORD_SERIES(prior);
}
prior = Copy_Series(BUF_WORDS);
RESET_TAIL(BUF_WORDS); // allow reuse
BARE_SERIES(prior); // No GC ever needed for word list
CHECK_BIND_TABLE;
return prior;
}
//
// Next_Path_Throws: C
//
// Evaluate next part of a path.
//
REBOOL Next_Path_Throws(REBPVS *pvs)
{
REBPEF dispatcher;
REBVAL temp;
VAL_INIT_WRITABLE_DEBUG(&temp);
// Path must have dispatcher, else return:
dispatcher = Path_Dispatch[VAL_TYPE_0(pvs->value)];
if (!dispatcher) return FALSE; // unwind, then check for errors
pvs->item++;
//Debug_Fmt("Next_Path: %r/%r", pvs->path-1, pvs->path);
// object/:field case:
if (IS_GET_WORD(pvs->item)) {
pvs->selector = GET_MUTABLE_VAR_MAY_FAIL(pvs->item);
if (IS_UNSET(pvs->selector))
fail (Error(RE_NO_VALUE, pvs->item));
}
// object/(expr) case:
else if (IS_GROUP(pvs->item)) {
if (DO_VAL_ARRAY_AT_THROWS(&temp, pvs->item)) {
*pvs->value = temp;
return TRUE;
}
pvs->selector = &temp;
}
else // object/word and object/value case:
pvs->selector = pvs->item;
switch (dispatcher(pvs)) {
case PE_OK:
break;
case PE_SET_IF_END:
if (pvs->opt_setval && IS_END(pvs->item + 1)) {
*pvs->value = *pvs->opt_setval;
pvs->opt_setval = NULL;
}
break;
case PE_NONE:
SET_NONE(pvs->store);
case PE_USE_STORE:
pvs->value = pvs->store;
break;
default:
assert(FALSE);
}
if (NOT_END(pvs->item + 1)) return Next_Path_Throws(pvs);
return FALSE;
}
//
// Find_Max_Bit: C
//
// Return integer number for the maximum bit number defined by
// the value. Used to determine how much space to allocate.
//
REBINT Find_Max_Bit(REBVAL *val)
{
REBINT maxi = 0;
REBINT n;
switch (VAL_TYPE(val)) {
case REB_CHAR:
maxi = VAL_CHAR(val)+1;
break;
case REB_INTEGER:
maxi = Int32s(val, 0);
break;
case REB_STRING:
case REB_FILE:
case REB_EMAIL:
case REB_URL:
case REB_TAG:
// case REB_ISSUE:
n = VAL_INDEX(val);
if (VAL_BYTE_SIZE(val)) {
REBYTE *bp = VAL_BIN(val);
for (; n < cast(REBINT, VAL_LEN_HEAD(val)); n++)
if (bp[n] > maxi) maxi = bp[n];
}
else {
REBUNI *up = VAL_UNI(val);
for (; n < cast(REBINT, VAL_LEN_HEAD(val)); n++)
if (up[n] > maxi) maxi = up[n];
}
maxi++;
break;
case REB_BINARY:
maxi = VAL_LEN_AT(val) * 8 - 1;
if (maxi < 0) maxi = 0;
break;
case REB_BLOCK:
for (val = VAL_ARRAY_AT(val); NOT_END(val); val++) {
n = Find_Max_Bit(val);
if (n > maxi) maxi = n;
}
//maxi++;
break;
case REB_NONE:
maxi = 0;
break;
default:
return -1;
}
return maxi;
}
*/ 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);
}
*/ void Assert_Public_Object(REBVAL *value)
/*
***********************************************************************/
{
REBVAL *word = BLK_HEAD(VAL_OBJ_WORDS(value));
for (; NOT_END(word); word++)
if (VAL_GET_OPT(word, OPTS_HIDE)) Trap0(RE_HIDDEN);
}
*/ void Check_Frame(REBSER *frame)
/*
***********************************************************************/
{
REBINT n;
REBVAL *values = FRM_VALUES(frame);
REBVAL *words = FRM_WORDS(frame);
REBINT tail = SERIES_TAIL(frame);
for (n = 0; n < tail; n++, values++, words++) {
if (IS_END(words) || IS_END(values)) {
Debug_Fmt("** Early %s end at index: %d", IS_END(words) ? "words" : "values", n);
}
}
if (NOT_END(words) || NOT_END(values))
Debug_Fmt("** Missing %s end at index: %d type: %d", NOT_END(words) ? "words" : "values", n, VAL_TYPE(words));
}
*/ void Assert_Public_Object(const REBVAL *value)
/*
***********************************************************************/
{
REBVAL *word = BLK_HEAD(VAL_OBJ_WORDS(value));
for (; NOT_END(word); word++)
if (VAL_GET_EXT(word, EXT_WORD_HIDE)) raise Error_0(RE_HIDDEN);
}
*/ 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);
}
STOID Mold_Simple_Block(REB_MOLD *mold, REBVAL *block, REBCNT len)
{
// Simple molder for error locations. Series must be valid.
// Max length in chars must be provided.
REBCNT start = SERIES_TAIL(mold->series);
while (NOT_END(block)) {
if ((SERIES_TAIL(mold->series) - start) > len) break;
Mold_Value(mold, block, TRUE);
block++;
if (NOT_END(block)) Append_Byte(mold->series, ' ');
}
// If it's too large, truncate it:
if ((SERIES_TAIL(mold->series) - start) > len) {
SERIES_TAIL(mold->series) = start + len;
Append_Bytes(mold->series, "...");
}
}
*/ 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;
}