xx*/ REBSER *Make_Func_Words(REBSER *spec)
/*
** Make a word list part of a context block for a function spec.
** This series is stored in the ARGS field of the function value.
**
***********************************************************************/
{
REBVAL *word = BLK_HEAD(spec);
REBSER *words;
REBCNT n;
REBCNT len = 0;
// Count the number of words within the spec:
for (n = 0; n < SERIES_TAIL(spec); n++) {
if (ANY_WORD(word+n)) len++;
}
// Make the words table:
words = Make_Words(len+1);
// Skip 0th entry (because 0 is not valid for bind index).
len = 1;
WORDS_HEAD(words)[0] = 0;
// Initialize the words in the new table.
for (n = 0; n < SERIES_TAIL(spec); n++) {
if (ANY_WORD(word+n)) WORDS_HEAD(words)[len++] = n;
}
SERIES_TAIL(words) = len;
return words;
}
//
// 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;
}
//
// VAL_SPECIFIC_Debug: C
//
REBCTX *VAL_SPECIFIC_Debug(const REBVAL *v)
{
REBCTX *specific;
assert(NOT(GET_VAL_FLAG(v, VALUE_FLAG_RELATIVE)));
assert(
ANY_WORD(v)
|| ANY_ARRAY(v)
|| IS_VARARGS(v)
|| IS_FUNCTION(v)
|| ANY_CONTEXT(v)
);
specific = VAL_SPECIFIC_COMMON(v);
if (specific != SPECIFIED) {
//
// Basic sanity check: make sure it's a context at all
//
if (!GET_CTX_FLAG(specific, ARRAY_FLAG_VARLIST)) {
printf("Non-CONTEXT found as specifier in specific value\n");
Panic_Series(cast(REBSER*, specific)); // may not be series either
}
// While an ANY-WORD! can be bound specifically to an arbitrary
// object, an ANY-ARRAY! only becomes bound specifically to frames.
// The keylist for a frame's context should come from a function's
// paramlist, which should have a FUNCTION! value in keylist[0]
//
if (ANY_ARRAY(v))
assert(IS_FUNCTION(CTX_ROOTKEY(specific)));
}
return specific;
}
*/ 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));
}
}
//
// COPY_VALUE_Debug: C
//
// The implementation of COPY_VALUE_CORE is designed to be fairly optimal
// (since it is being called in lieu of what would have been a memcpy() or
// plain assignment). It is left in its raw form as an inline function to
// to help convey that it is nearly as efficient as an assignment.
//
// This adds some verbose checking in the debug build to help debug cases
// where the relative information bits are incorrect.
//
void COPY_VALUE_Debug(
REBVAL *dest,
const RELVAL *src,
REBCTX *specifier
) {
assert(!IS_END(src));
assert(!IS_TRASH_DEBUG(src));
#ifdef __cplusplus
Assert_Cell_Writable(dest, __FILE__, __LINE__);
#endif
if (IS_RELATIVE(src)) {
assert(ANY_WORD(src) || ANY_ARRAY(src));
if (specifier == SPECIFIED) {
Debug_Fmt("Internal Error: Relative item used with SPECIFIED");
PROBE_MSG(src, "word or array");
PROBE_MSG(FUNC_VALUE(VAL_RELATIVE(src)), "func");
assert(FALSE);
}
else if (
VAL_RELATIVE(src)
!= VAL_FUNC(CTX_FRAME_FUNC_VALUE(specifier))
) {
Debug_Fmt("Internal Error: Function mismatch in specific binding");
PROBE_MSG(src, "word or array");
PROBE_MSG(FUNC_VALUE(VAL_RELATIVE(src)), "expected func");
PROBE_MSG(CTX_FRAME_FUNC_VALUE(specifier), "actual func");
assert(FALSE);
}
}
COPY_VALUE_CORE(dest, src, specifier);
}
//
// Resolve_Path: C
//
// Given a path, determine if it is ultimately specifying a selection out
// of a context...and if it is, return that context. So `a/obj/key` would
// return the object assocated with obj, while `a/str/1` would return
// NULL if `str` were a string as it's not an object selection.
//
// !!! This routine overlaps the logic of Do_Path, and should potentially
// be a mode of that instead. It is not very complete, considering that it
// does not execute GROUP! (and perhaps shouldn't?) and only supports a
// path that picks contexts out of other contexts, via word selection.
//
REBCTX *Resolve_Path(const REBVAL *path, REBCNT *index_out)
{
RELVAL *selector;
const REBVAL *var;
REBARR *array;
REBCNT i;
array = VAL_ARRAY(path);
selector = ARR_HEAD(array);
if (IS_END(selector) || !ANY_WORD(selector))
return NULL; // !!! only handles heads of paths that are ANY-WORD!
var = GET_OPT_VAR_MAY_FAIL(selector, VAL_SPECIFIER(path));
++selector;
if (IS_END(selector))
return NULL; // !!! does not handle single-element paths
while (ANY_CONTEXT(var) && IS_WORD(selector)) {
i = Find_Canon_In_Context(
VAL_CONTEXT(var), VAL_WORD_CANON(selector), FALSE
);
++selector;
if (IS_END(selector)) {
*index_out = i;
return VAL_CONTEXT(var);
}
var = CTX_VAR(VAL_CONTEXT(var), i);
}
DEAD_END;
}
*/ 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;
}
//
// 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
}
*/ 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;
}
*/ REBSER *Map_To_Object(REBSER *mapser)
/*
***********************************************************************/
{
REBVAL *val;
REBCNT cnt = 0;
REBSER *frame;
REBVAL *word;
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);
word = FRM_WORD(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)) {
Init_Unword(
word,
REB_SET_WORD,
VAL_WORD_SYM(mval),
// all types except END or UNSET
~((TYPESET(REB_END) | TYPESET(REB_UNSET)))
);
word++;
*val++ = mval[1];
}
}
SET_END(word);
SET_END(val);
FRM_WORD_SERIES(frame)->tail = frame->tail = cnt + 1;
return frame;
}
*/ void Unbind_Block(REBVAL *val, REBCNT deep)
/*
***********************************************************************/
{
for (; NOT_END(val); val++) {
if (ANY_WORD(val)) {
UNBIND(val);
}
if (ANY_BLOCK(val) && deep) {
Unbind_Block(VAL_BLK_DATA(val), TRUE);
}
}
}
*/ static void Bind_Block_Words(REBSER *frame, REBVAL *value, REBCNT mode)
/*
** Inner loop of bind block. Modes are:
**
** BIND_ONLY Only bind the words found in the frame.
** BIND_SET Add set-words to the frame during the bind.
** BIND_ALL Add words to the frame during the bind.
** BIND_DEEP Recurse into sub-blocks.
**
** NOTE: BIND_SET must be used carefully, because it does not
** bind prior instances of the word before the set-word. That is
** forward references are not allowed.
**
***********************************************************************/
{
REBINT *binds = WORDS_HEAD(Bind_Table); // GC safe to do here
REBCNT n;
REBFLG selfish = !IS_SELFLESS(frame);
for (; NOT_END(value); value++) {
if (ANY_WORD(value)) {
//Print("Word: %s", Get_Sym_Name(VAL_WORD_CANON(value)));
// Is the word found in this frame?
if (NZ(n = binds[VAL_WORD_CANON(value)])) {
if (n == NO_RESULT) n = 0; // SELF word
ASSERT1(n < SERIES_TAIL(frame), RP_BIND_BOUNDS);
// Word is in frame, bind it:
VAL_WORD_INDEX(value) = n;
VAL_WORD_FRAME(value) = frame;
}
else if (selfish && VAL_WORD_CANON(value) == SYM_SELF) {
VAL_WORD_INDEX(value) = 0;
VAL_WORD_FRAME(value) = frame;
}
else {
// Word is not in frame. Add it if option is specified:
if ((mode & BIND_ALL) || ((mode & BIND_SET) && (IS_SET_WORD(value)))) {
Append_Frame(frame, value, 0);
binds[VAL_WORD_CANON(value)] = VAL_WORD_INDEX(value);
}
}
}
else if (ANY_BLOCK(value) && (mode & BIND_DEEP))
Bind_Block_Words(frame, VAL_BLK_DATA(value), mode);
else if ((IS_FUNCTION(value) || IS_CLOSURE(value)) && (mode & BIND_FUNC))
Bind_Block_Words(frame, BLK_HEAD(VAL_FUNC_BODY(value)), mode);
}
}
*/ REBCNT Find_Word(REBSER *series, REBCNT index, REBCNT sym)
/*
** Find word (of any type) in a block... quickly.
**
***********************************************************************/
{
REBVAL *value;
for (; index < SERIES_TAIL(series); index++) {
value = BLK_SKIP(series, index);
if (ANY_WORD(value) && sym == VAL_WORD_CANON(value))
return index;
}
return NOT_FOUND;
}
*/ void Unbind_Values_Core(REBVAL value[], REBSER *frame, REBOOL deep)
/*
** Unbind words in a block, optionally unbinding those which are
** bound to a particular frame (if frame is NULL, then all
** words will be unbound regardless of their VAL_WORD_FRAME).
**
***********************************************************************/
{
for (; NOT_END(value); value++) {
if (ANY_WORD(value) && (!frame || VAL_WORD_FRAME(value) == frame))
UNBIND_WORD(value);
if (ANY_BLOCK(value) && deep)
Unbind_Values_Core(VAL_BLK_DATA(value), frame, TRUE);
}
}
//
// INIT_WORD_INDEX_Debug: C
//
void INIT_WORD_INDEX_Debug(RELVAL *v, REBCNT i)
{
assert(ANY_WORD(v));
assert(GET_VAL_FLAG((v), WORD_FLAG_BOUND));
if (IS_RELATIVE(v))
assert(
VAL_WORD_CANON(v)
== VAL_PARAM_CANON(FUNC_PARAM(VAL_WORD_FUNC(v), i))
);
else
assert(
VAL_WORD_CANON(v)
== CTX_KEY_CANON(VAL_WORD_CONTEXT(KNOWN(v)), i)
);
v->payload.any_word.index = i;
}
*/ void Rebind_Block(REBSER *frame_src, REBSER *frame_dst, REBSER *block)
/*
** Rebind all words that reference src frame to dst frame.
** Rebind is always deep.
**
***********************************************************************/
{
REBVAL *value;
for (value = BLK_HEAD(block); NOT_END(value); value++) {
if (ANY_BLOCK(value)) Rebind_Block(frame_src, frame_dst, VAL_SERIES(value));
else if (ANY_WORD(value) && VAL_WORD_FRAME(value) == frame_src) {
VAL_WORD_FRAME(value) = frame_dst;
}
}
}
static REBSER *make_string(REBVAL *arg, REBOOL make)
{
REBSER *ser = 0;
// MAKE <type> 123
if (make && (IS_INTEGER(arg) || IS_DECIMAL(arg))) {
ser = Make_Binary(Int32s(arg, 0));
}
// MAKE/TO <type> <binary!>
else if (IS_BINARY(arg)) {
REBYTE *bp = VAL_BIN_DATA(arg);
REBCNT len = VAL_LEN(arg);
switch (What_UTF(bp, len)) {
case 0:
break;
case 8: // UTF-8 encoded
bp += 3;
len -= 3;
break;
default:
Trap0(RE_BAD_DECODE);
}
ser = Decode_UTF_String(bp, len, 8); // UTF-8
}
// MAKE/TO <type> <any-string>
else if (ANY_BINSTR(arg)) {
ser = Copy_String(VAL_SERIES(arg), VAL_INDEX(arg), VAL_LEN(arg));
}
// MAKE/TO <type> <any-word>
else if (ANY_WORD(arg)) {
ser = Copy_Mold_Value(arg, TRUE);
//ser = Append_UTF8(0, Get_Word_Name(arg), -1);
}
// MAKE/TO <type> #"A"
else if (IS_CHAR(arg)) {
ser = (VAL_CHAR(arg) > 0xff) ? Make_Unicode(2) : Make_Binary(2);
Append_Byte(ser, VAL_CHAR(arg));
}
// MAKE/TO <type> <any-value>
// else if (IS_NONE(arg)) {
// ser = Make_Binary(0);
// }
else
ser = Copy_Form_Value(arg, 1<<MOPT_TIGHT);
return ser;
}
//
// RL_Map_Words: C
//
// 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.
//
RL_API u32 *RL_Map_Words(REBARR *array)
{
REBCNT i = 1;
u32 *words;
REBVAL *val = ARR_HEAD(array);
words = OS_ALLOC_N(u32, ARR_LEN(array) + 2);
for (; NOT_END(val); val++) {
if (ANY_WORD(val)) words[i++] = VAL_WORD_CANON(val);
}
words[0] = i;
words[i] = 0;
return words;
}
//
// Copy_Rerelativized_Array_Deep_Managed: C
//
// The invariant of copying in general is that when you are done with the
// copy, there are no relative values in that copy. One exception to this
// is the deep copy required to make a relative function body in the first
// place (which it currently does in two passes--a normal deep copy followed
// by a relative binding). The other exception is when a relativized
// function body is copied to make another relativized function body.
//
// This is specialized logic for the latter case. It's constrained enough
// to be simple (all relative values are known to be relative to the same
// function), and the feature is questionable anyway. So it's best not to
// further complicate ordinary copying with a parameterization to copy
// and change all the relative binding information from one function's
// paramlist to another.
//
REBARR *Copy_Rerelativized_Array_Deep_Managed(
REBARR *original,
REBACT *before, // references to `before` will be changed to `after`
REBACT *after
){
const REBFLGS flags = NODE_FLAG_MANAGED;
REBARR *copy = Make_Array_For_Copy(ARR_LEN(original), flags, original);
RELVAL *src = ARR_HEAD(original);
RELVAL *dest = ARR_HEAD(copy);
for (; NOT_END(src); ++src, ++dest) {
if (not IS_RELATIVE(src)) {
Move_Value(dest, KNOWN(src));
continue;
}
// All relative values under a sub-block must be relative to the
// same function.
//
assert(VAL_RELATIVE(src) == before);
Move_Value_Header(dest, src);
if (ANY_ARRAY_OR_PATH(src)) {
INIT_VAL_NODE(
dest,
Copy_Rerelativized_Array_Deep_Managed(
VAL_ARRAY(src), before, after
)
);
PAYLOAD(Any, dest).second = PAYLOAD(Any, src).second;
INIT_BINDING(dest, after); // relative binding
}
else {
assert(ANY_WORD(src));
PAYLOAD(Any, dest) = PAYLOAD(Any, src);
INIT_BINDING(dest, after);
}
}
TERM_ARRAY_LEN(copy, ARR_LEN(original));
return copy;
}
*/ REBFLG MT_Block(REBVAL *out, REBVAL *data, REBCNT type)
/*
***********************************************************************/
{
REBCNT i;
if (!ANY_BLOCK(data)) return FALSE;
if (type >= REB_PATH && type <= REB_LIT_PATH)
if (!ANY_WORD(VAL_BLK(data))) return FALSE;
*out = *data++;
VAL_SET(out, type);
i = IS_INTEGER(data) ? Int32(data) - 1 : 0;
if (i > VAL_TAIL(out)) i = VAL_TAIL(out); // clip it
VAL_INDEX(out) = i;
return TRUE;
}
*/ 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);
}
*/ static void Bind_Values_Inner_Loop(REBINT *binds, REBVAL value[], REBSER *frame, REBCNT mode)
/*
** Bind_Values_Core() sets up the binding table and then calls
** this recursive routine to do the actual binding.
**
***********************************************************************/
{
REBFLG selfish = !IS_SELFLESS(frame);
for (; NOT_END(value); value++) {
if (ANY_WORD(value)) {
//Print("Word: %s", Get_Sym_Name(VAL_WORD_CANON(value)));
// Is the word found in this frame?
REBCNT n = binds[VAL_WORD_CANON(value)];
if (n != 0) {
if (n == NO_RESULT) n = 0; // SELF word
assert(n < SERIES_TAIL(frame));
// Word is in frame, bind it:
VAL_WORD_INDEX(value) = n;
VAL_WORD_FRAME(value) = frame;
}
else if (selfish && VAL_WORD_CANON(value) == SYM_SELF) {
VAL_WORD_INDEX(value) = 0;
VAL_WORD_FRAME(value) = frame;
}
else {
// Word is not in frame. Add it if option is specified:
if ((mode & BIND_ALL) || ((mode & BIND_SET) && (IS_SET_WORD(value)))) {
Expand_Frame(frame, 1, 1);
Append_Frame(frame, value, 0);
binds[VAL_WORD_CANON(value)] = VAL_WORD_INDEX(value);
}
}
}
else if (ANY_BLOCK(value) && (mode & BIND_DEEP))
Bind_Values_Inner_Loop(
binds, VAL_BLK_DATA(value), frame, mode
);
else if ((IS_FUNCTION(value) || IS_CLOSURE(value)) && (mode & BIND_FUNC))
Bind_Values_Inner_Loop(
binds, BLK_HEAD(VAL_FUNC_BODY(value)), frame, mode
);
}
}
*/ 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);
}
//
// Rebind_Values_Deep: C
//
// Rebind all words that reference src target to dst target.
// Rebind is always deep.
//
void Rebind_Values_Deep(
REBCTX *src,
REBCTX *dst,
RELVAL *head,
struct Reb_Binder *opt_binder
) {
RELVAL *value = head;
for (; NOT_END(value); value++) {
if (ANY_ARRAY(value)) {
Rebind_Values_Deep(src, dst, VAL_ARRAY_AT(value), opt_binder);
}
else if (
ANY_WORD(value)
&& GET_VAL_FLAG(value, WORD_FLAG_BOUND)
&& !GET_VAL_FLAG(value, VALUE_FLAG_RELATIVE)
&& VAL_WORD_CONTEXT(KNOWN(value)) == src
) {
INIT_WORD_CONTEXT(value, dst);
if (opt_binder != NULL) {
INIT_WORD_INDEX(
value,
Try_Get_Binder_Index(opt_binder, VAL_WORD_CANON(value))
);
}
}
else if (IS_FUNCTION(value) && IS_FUNCTION_INTERPRETED(value)) {
//
// !!! Extremely questionable feature--walking into function
// bodies and changing them. This R3-Alpha concept was largely
// broken (didn't work for closures) and created a lot of extra
// garbage (inheriting an object's methods meant making deep
// copies of all that object's method bodies...each time).
// Ren-C has a different idea in the works.
//
Rebind_Values_Deep(
src, dst, VAL_FUNC_BODY(value), opt_binder
);
}
}
}
*/ static void Collect_Words_Inner_Loop(REBINT *binds, REBVAL value[], REBCNT modes)
/*
** Used for Collect_Words() after the binds table has
** been set up.
**
***********************************************************************/
{
for (; NOT_END(value); value++) {
if (ANY_WORD(value)
&& !binds[VAL_WORD_CANON(value)]
&& (modes & BIND_ALL || IS_SET_WORD(value))
) {
REBVAL *word;
binds[VAL_WORD_CANON(value)] = 1;
word = Alloc_Tail_Array(BUF_WORDS);
Val_Init_Word_Unbound(word, REB_WORD, VAL_WORD_SYM(value));
}
else if (ANY_EVAL_BLOCK(value) && (modes & BIND_DEEP))
Collect_Words_Inner_Loop(binds, VAL_BLK_DATA(value), modes);
}
}
//
// Unbind_Values_Core: C
//
// Unbind words in a block, optionally unbinding those which are
// bound to a particular target (if target is NULL, then all
// words will be unbound regardless of their VAL_WORD_CONTEXT).
//
void Unbind_Values_Core(RELVAL *head, REBCTX *context, REBOOL deep)
{
RELVAL *value = head;
for (; NOT_END(value); value++) {
if (
ANY_WORD(value)
&& (
!context
|| (
IS_WORD_BOUND(value)
&& !IS_RELATIVE(value)
&& VAL_WORD_CONTEXT(KNOWN(value)) == context
)
)
) {
UNBIND_WORD(value);
}
else if (ANY_ARRAY(value) && deep)
Unbind_Values_Core(VAL_ARRAY_AT(value), context, TRUE);
}
}
//
// PD_Map: C
//
REBINT PD_Map(REBPVS *pvs)
{
REBVAL *data = pvs->value;
REBVAL *val = 0;
REBINT n = 0;
if (IS_END(pvs->path+1)) val = pvs->setval;
if (IS_NONE(pvs->select)) return PE_NONE;
if (!ANY_WORD(pvs->select) && !ANY_BINSTR(pvs->select) &&
!IS_INTEGER(pvs->select) && !IS_CHAR(pvs->select))
return PE_BAD_SELECT;
n = Find_Entry(VAL_SERIES(data), pvs->select, val);
if (!n) return PE_NONE;
TRAP_PROTECT(VAL_SERIES(data));
pvs->value = VAL_BLK_SKIP(data, ((n-1)*2)+1);
return PE_OK;
}
*/ void Collect_Simple_Words(REBVAL *block, REBCNT modes)
/*
** Used for Collect_Block_Words().
**
***********************************************************************/
{
REBINT *binds = WORDS_HEAD(Bind_Table); // GC safe to do here
REBVAL *val;
for (; NOT_END(block); block++) {
if (ANY_WORD(block)
&& !binds[VAL_WORD_CANON(block)]
&& (modes & BIND_ALL || IS_SET_WORD(block))
) {
binds[VAL_WORD_CANON(block)] = 1;
val = Append_Value(BUF_WORDS);
Init_Word(val, VAL_WORD_SYM(block));
}
else if (ANY_EVAL_BLOCK(block) && (modes & BIND_DEEP))
Collect_Simple_Words(VAL_BLK_DATA(block), modes);
}
}
static REBSER *MAKE_TO_String_Common(const REBVAL *arg)
{
REBSER *ser = 0;
// MAKE/TO <type> <binary!>
if (IS_BINARY(arg)) {
REBYTE *bp = VAL_BIN_AT(arg);
REBCNT len = VAL_LEN_AT(arg);
switch (What_UTF(bp, len)) {
case 0:
break;
case 8: // UTF-8 encoded
bp += 3;
len -= 3;
break;
default:
fail (Error(RE_BAD_UTF8));
}
ser = Decode_UTF_String(bp, len, 8); // UTF-8
}
// MAKE/TO <type> <any-string>
else if (ANY_BINSTR(arg)) {
ser = Copy_String_Slimming(VAL_SERIES(arg), VAL_INDEX(arg), VAL_LEN_AT(arg));
}
// MAKE/TO <type> <any-word>
else if (ANY_WORD(arg)) {
ser = Copy_Mold_Value(arg, 0 /* opts... MOPT_0? */);
}
// MAKE/TO <type> #"A"
else if (IS_CHAR(arg)) {
ser = (VAL_CHAR(arg) > 0xff) ? Make_Unicode(2) : Make_Binary(2);
Append_Codepoint_Raw(ser, VAL_CHAR(arg));
}
else
ser = Copy_Form_Value(arg, 1 << MOPT_TIGHT);
return ser;
}
xx*/ void Dump_Block_Raw(REBSER *series, int depth, int max_depth)
/*
***********************************************************************/
{
REBVAL *val;
REBCNT n;
REBYTE *str;
if (!IS_BLOCK_SERIES(series) || depth > max_depth) return;
for (n = 0, val = BLK_HEAD(series); NOT_END(val); val++, n++) {
Debug_Chars(' ', depth * 4);
if (IS_BLOCK(val)) {
Debug_Fmt("%3d: [%s] len: %d", n, Get_Type_Name(val), VAL_TAIL(val));
Dump_Block_Raw(VAL_SERIES(val), depth + 1, max_depth);
} else {
str = "";
if (ANY_WORD(val)) str = Get_Word_Name(val);
Debug_Fmt("%3d: [%s] %s", n, Get_Type_Name(val), str);
}
}
//if (depth == 2) Input_Str();
}
