//
// Bind_Relative_Inner_Loop: C
//
// Recursive function for relative function word binding. Returns TRUE if
// any relative bindings were made.
//
static void Bind_Relative_Inner_Loop(
struct Reb_Binder *binder,
RELVAL *head,
REBARR *paramlist,
REBU64 bind_types
) {
RELVAL *value = head;
for (; NOT_END(value); value++) {
REBU64 type_bit = FLAGIT_KIND(VAL_TYPE(value));
// The two-pass copy-and-then-bind should have gotten rid of all the
// relative values to other functions during the copy.
//
// !!! Long term, in a single pass copy, this would have to deal
// with relative values and run them through the specification
// process if they were not just getting overwritten.
//
assert(!IS_RELATIVE(value));
if (type_bit & bind_types) {
REBINT n = Try_Get_Binder_Index(binder, VAL_WORD_CANON(value));
if (n != 0) {
//
// Word's canon symbol is in frame. Relatively bind it.
// (clear out existing binding flags first).
//
UNBIND_WORD(value);
SET_VAL_FLAGS(value, WORD_FLAG_BOUND | VALUE_FLAG_RELATIVE);
INIT_WORD_FUNC(value, AS_FUNC(paramlist)); // incomplete func
INIT_WORD_INDEX(value, n);
}
}
else if (ANY_ARRAY(value)) {
Bind_Relative_Inner_Loop(
binder, VAL_ARRAY_AT(value), paramlist, bind_types
);
// Set the bits in the ANY-ARRAY! REBVAL to indicate that it is
// relative to the function.
//
// !!! Technically speaking it is not necessary for an array to
// be marked relative if it doesn't contain any relative words
// under it. However, for uniformity in the near term, it's
// easiest to debug if there is a clear mark on arrays that are
// part of a deep copy of a function body either way.
//
SET_VAL_FLAG(value, VALUE_FLAG_RELATIVE);
INIT_RELATIVE(value, AS_FUNC(paramlist)); // incomplete func
}
}
}
//
// 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;
}
//
// Try_Bind_Word: C
//
// Binds a word to a context. If word is not part of the context.
//
REBCNT Try_Bind_Word(REBCTX *context, REBVAL *word)
{
REBCNT n = Find_Canon_In_Context(context, VAL_WORD_CANON(word), FALSE);
if (n != 0) {
//
// Previously may have been bound relative, remove flag.
//
CLEAR_VAL_FLAG(word, VALUE_FLAG_RELATIVE);
SET_VAL_FLAG(word, WORD_FLAG_BOUND);
INIT_WORD_CONTEXT(word, context);
INIT_WORD_INDEX(word, n);
}
return n;
}
//
// Split_Lines: C
//
// Given a string series, split lines on CR-LF.
// Series can be bytes or Unicode.
//
REBARR *Split_Lines(REBVAL *val)
{
REBARR *array = BUF_EMIT; // GC protected (because it is emit buffer)
REBSER *str = VAL_SERIES(val);
REBCNT len = VAL_LEN_AT(val);
REBCNT idx = VAL_INDEX(val);
REBCNT start = idx;
REBSER *out;
REBUNI c;
RESET_ARRAY(array);
while (idx < len) {
c = GET_ANY_CHAR(str, idx);
if (c == LF || c == CR) {
out = Copy_String_Slimming(str, start, idx - start);
val = Alloc_Tail_Array(array);
Val_Init_String(val, out);
SET_VAL_FLAG(val, VALUE_FLAG_LINE);
idx++;
if (c == CR && GET_ANY_CHAR(str, idx) == LF)
idx++;
start = idx;
}
else idx++;
}
// Possible remainder (no terminator)
if (idx > start) {
out = Copy_String_Slimming(str, start, idx - start);
val = Alloc_Tail_Array(array);
Val_Init_String(val, out);
SET_VAL_FLAG(val, VALUE_FLAG_LINE);
}
return Copy_Array_Shallow(array, SPECIFIED); // no relative values
}
//
// Bind_Values_Inner_Loop: C
//
// Bind_Values_Core() sets up the binding table and then calls
// this recursive routine to do the actual binding.
//
static void Bind_Values_Inner_Loop(
struct Reb_Binder *binder,
RELVAL *head,
REBCTX *context,
REBU64 bind_types, // !!! REVIEW: force word types low enough for 32-bit?
REBU64 add_midstream_types,
REBFLGS flags
) {
RELVAL *value = head;
for (; NOT_END(value); value++) {
REBU64 type_bit = FLAGIT_KIND(VAL_TYPE(value));
if (type_bit & bind_types) {
REBSTR *canon = VAL_WORD_CANON(value);
REBCNT n = Try_Get_Binder_Index(binder, canon);
if (n != 0) {
assert(n <= CTX_LEN(context));
// We're overwriting any previous binding, which may have
// been relative.
//
CLEAR_VAL_FLAG(value, VALUE_FLAG_RELATIVE);
SET_VAL_FLAG(value, WORD_FLAG_BOUND);
INIT_WORD_CONTEXT(value, context);
INIT_WORD_INDEX(value, n);
}
else if (type_bit & add_midstream_types) {
//
// Word is not in context, so add it if option is specified
//
Expand_Context(context, 1);
Append_Context(context, value, 0);
Add_Binder_Index(binder, canon, VAL_WORD_INDEX(value));
}
}
else if (ANY_ARRAY(value) && (flags & BIND_DEEP)) {
Bind_Values_Inner_Loop(
binder,
VAL_ARRAY_AT(value),
context,
bind_types,
add_midstream_types,
flags
);
}
else if (
IS_FUNCTION(value)
&& IS_FUNCTION_INTERPRETED(value)
&& (flags & BIND_FUNC)
) {
// !!! Likely-to-be deprecated functionality--rebinding inside the
// content of an already formed function. :-/
//
Bind_Values_Inner_Loop(
binder,
VAL_FUNC_BODY(value),
context,
bind_types,
add_midstream_types,
flags
);
}
}
}
