*/ 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)); } }
*/ 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); } }
*/ 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); } }
*/ 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; } } }
*/ 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; }
*/ 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 ); } }
*/ void Pop_Stack_Values(REBVAL *out, REBINT dsp_start, REBOOL into) /* ** Pop_Stack_Values computed values from the stack into the series ** specified by "into", or if into is NULL then store it as a ** block on top of the stack. (Also checks to see if into ** is protected, and will trigger a trap if that is the case.) ** ** Protocol for /INTO is to set the position to the tail. ** ***********************************************************************/ { REBSER *series; REBCNT len = DSP - dsp_start; REBVAL *values = BLK_SKIP(DS_Series, dsp_start + 1); if (into) { assert(ANY_BLOCK(out)); series = VAL_SERIES(out); if (IS_PROTECT_SERIES(series)) Trap(RE_PROTECTED); VAL_INDEX(out) = Insert_Series( series, VAL_INDEX(out), cast(REBYTE*, values), len ); } else {
*/ void Rebind_Block(REBSER *src_frame, REBSER *dst_frame, REBVAL *data, REBFLG modes) /* ** Rebind all words that reference src frame to dst frame. ** Rebind is always deep. ** ** There are two types of frames: relative frames and normal frames. ** When frame_src type and frame_dst type differ, ** modes must have REBIND_TYPE. ** ***********************************************************************/ { REBINT *binds = WORDS_HEAD(Bind_Table); for (; NOT_END(data); data++) { if (ANY_BLOCK(data)) Rebind_Block(src_frame, dst_frame, VAL_BLK_DATA(data), modes); else if (ANY_WORD(data) && VAL_WORD_FRAME(data) == src_frame) { VAL_WORD_FRAME(data) = dst_frame; if (modes & REBIND_TABLE) VAL_WORD_INDEX(data) = binds[VAL_WORD_CANON(data)]; if (modes & REBIND_TYPE) VAL_WORD_INDEX(data) = - VAL_WORD_INDEX(data); } else if ((modes & REBIND_FUNC) && (IS_FUNCTION(data) || IS_CLOSURE(data))) Rebind_Block(src_frame, dst_frame, BLK_HEAD(VAL_FUNC_BODY(data)), modes); } }
*/ static REB_R Loop_Each(struct Reb_Call *call_, REBINT mode) /* ** Supports these natives (modes): ** 0: foreach ** 1: remove-each ** 2: map ** ***********************************************************************/ { REBSER *body; REBVAL *vars; REBVAL *words; REBSER *frame; REBVAL *value; REBSER *series; REBSER *out; // output block (for MAP, mode = 2) REBINT index; // !!!! should these be REBCNT? REBINT tail; REBINT windex; // write REBINT rindex; // read REBINT err; REBCNT i; REBCNT j; REBVAL *ds; assert(mode >= 0 && mode < 3); value = D_ARG(2); // series if (IS_NONE(value)) return R_NONE; body = Init_Loop(D_ARG(1), D_ARG(3), &frame); // vars, body SET_OBJECT(D_ARG(1), frame); // keep GC safe Set_Block(D_ARG(3), body); // keep GC safe SET_NONE(D_OUT); // Default result to NONE if the loop does not run // If it's MAP, create result block: if (mode == 2) { out = Make_Block(VAL_LEN(value)); SAVE_SERIES(out); } // Get series info: if (ANY_OBJECT(value)) { series = VAL_OBJ_FRAME(value); out = FRM_WORD_SERIES(series); // words (the out local reused) index = 1; //if (frame->tail > 3) Trap_Arg_DEAD_END(FRM_WORD(frame, 3)); } else if (IS_MAP(value)) { series = VAL_SERIES(value); index = 0; //if (frame->tail > 3) Trap_Arg_DEAD_END(FRM_WORD(frame, 3)); } else { series = VAL_SERIES(value); index = VAL_INDEX(value); if (index >= cast(REBINT, SERIES_TAIL(series))) { if (mode == 1) { SET_INTEGER(D_OUT, 0); } else if (mode == 2) { Set_Block(D_OUT, out); UNSAVE_SERIES(out); } return R_OUT; } } windex = index; // Iterate over each value in the series block: while (index < (tail = SERIES_TAIL(series))) { rindex = index; // remember starting spot j = 0; // Set the FOREACH loop variables from the series: for (i = 1; i < frame->tail; i++) { vars = FRM_VALUE(frame, i); words = FRM_WORD(frame, i); // var spec is WORD if (IS_WORD(words)) { if (index < tail) { if (ANY_BLOCK(value)) { *vars = *BLK_SKIP(series, index); } else if (ANY_OBJECT(value)) { if (!VAL_GET_EXT(BLK_SKIP(out, index), EXT_WORD_HIDE)) { // Alternate between word and value parts of object: if (j == 0) { Init_Word(vars, REB_WORD, VAL_WORD_SYM(BLK_SKIP(out, index)), series, index); if (NOT_END(vars+1)) index--; // reset index for the value part } else if (j == 1) *vars = *BLK_SKIP(series, index); else Trap_Arg_DEAD_END(words); j++; } else { // Do not evaluate this iteration index++; goto skip_hidden; } } else if (IS_VECTOR(value)) { Set_Vector_Value(vars, series, index); } else if (IS_MAP(value)) { REBVAL *val = BLK_SKIP(series, index | 1); if (!IS_NONE(val)) { if (j == 0) { *vars = *BLK_SKIP(series, index & ~1); if (IS_END(vars+1)) index++; // only words } else if (j == 1) *vars = *BLK_SKIP(series, index); else Trap_Arg_DEAD_END(words); j++; } else { index += 2; goto skip_hidden; } } else { // A string or binary if (IS_BINARY(value)) { SET_INTEGER(vars, (REBI64)(BIN_HEAD(series)[index])); } else if (IS_IMAGE(value)) { Set_Tuple_Pixel(BIN_SKIP(series, index), vars); } else { VAL_SET(vars, REB_CHAR); VAL_CHAR(vars) = GET_ANY_CHAR(series, index); } } index++; } else SET_NONE(vars); } // var spec is SET_WORD: else if (IS_SET_WORD(words)) { if (ANY_OBJECT(value) || IS_MAP(value)) { *vars = *value; } else { VAL_SET(vars, REB_BLOCK); VAL_SERIES(vars) = series; VAL_INDEX(vars) = index; } //if (index < tail) index++; // do not increment block. } else Trap_Arg_DEAD_END(words); } if (index == rindex) index++; //the word block has only set-words: foreach [a:] [1 2 3][] if (!DO_BLOCK(D_OUT, body, 0)) { if ((err = Check_Error(D_OUT)) >= 0) { index = rindex; break; } // else CONTINUE: if (mode == 1) SET_FALSE(D_OUT); // keep the value (for mode == 1) } else { err = 0; // prevent later test against uninitialized value } if (mode > 0) { //if (ANY_OBJECT(value)) Trap_Types_DEAD_END(words, REB_BLOCK, VAL_TYPE(value)); //check not needed // If FALSE return, copy values to the write location: if (mode == 1) { // remove-each if (IS_CONDITIONAL_FALSE(D_OUT)) { REBCNT wide = SERIES_WIDE(series); // memory areas may overlap, so use memmove and not memcpy! memmove(series->data + (windex * wide), series->data + (rindex * wide), (index - rindex) * wide); windex += index - rindex; // old: while (rindex < index) *BLK_SKIP(series, windex++) = *BLK_SKIP(series, rindex++); } } else if (!IS_UNSET(D_OUT)) Append_Value(out, D_OUT); // (mode == 2) } skip_hidden: ; } // Finish up: if (mode == 1) { // Remove hole (updates tail): if (windex < index) Remove_Series(series, windex, index - windex); SET_INTEGER(D_OUT, index - windex); return R_OUT; } // If MAP... if (mode == 2) { UNSAVE_SERIES(out); if (err != 2) { // ...and not BREAK/RETURN: Set_Block(D_OUT, out); return R_OUT; } } return R_OUT; }
*/ static REBCNT Do_Eval_Rule(REBPARSE *parse, REBCNT index, REBVAL **rule) /* ** Evaluate the input as a code block. Advance input if ** rule succeeds. Return new index or failure. ** ** Examples: ** do skip ** do end ** do "abc" ** do 'abc ** do [...] ** do variable ** do datatype! ** do quote 123 ** do into [...] ** ** Problem: cannot write: set var do datatype! ** ***********************************************************************/ { REBVAL value; REBVAL *item = *rule; REBCNT n; REBPARSE newparse; // First, check for end of input: if (index >= parse->series->tail) { if (IS_WORD(item) && VAL_CMD(item) == SYM_END) return index; else return NOT_FOUND; } // Evaluate next N input values: index = Do_Next(parse->series, index, FALSE); // Value is on top of stack (volatile!): value = *DS_POP; if (THROWN(&value)) Throw_Break(&value); // Get variable or command: if (IS_WORD(item)) { n = VAL_CMD(item); if (n == SYM_SKIP) return (IS_SET(&value)) ? index : NOT_FOUND; if (n == SYM_QUOTE) { item = item + 1; (*rule)++; if (IS_END(item)) Trap1(RE_PARSE_END, item-2); if (IS_PAREN(item)) { item = Do_Block_Value_Throw(item); // might GC } } else if (n == SYM_INTO) { item = item + 1; (*rule)++; if (IS_END(item)) Trap1(RE_PARSE_END, item-2); item = Get_Parse_Value(item); // sub-rules if (!IS_BLOCK(item)) Trap1(RE_PARSE_RULE, item-2); if (!ANY_BINSTR(&value) && !ANY_BLOCK(&value)) return NOT_FOUND; return (Parse_Series(&value, VAL_BLK_DATA(item), parse->flags, 0) == VAL_TAIL(&value)) ? index : NOT_FOUND; } else if (n > 0) Trap1(RE_PARSE_RULE, item); else item = Get_Parse_Value(item); // variable } else if (IS_PATH(item)) { item = Get_Parse_Value(item); // variable } else if (IS_SET_WORD(item) || IS_GET_WORD(item) || IS_SET_PATH(item) || IS_GET_PATH(item)) Trap1(RE_PARSE_RULE, item); if (IS_NONE(item)) { return (VAL_TYPE(&value) > REB_NONE) ? NOT_FOUND : index; } // Copy the value into its own block: newparse.series = Make_Block(1); SAVE_SERIES(newparse.series); Append_Val(newparse.series, &value); newparse.type = REB_BLOCK; newparse.flags = parse->flags; newparse.result = 0; n = (Parse_Next_Block(&newparse, 0, item, 0) != NOT_FOUND) ? index : NOT_FOUND; UNSAVE_SERIES(newparse.series); return n; }
*/ static REBCNT Parse_Rules_Loop(REBPARSE *parse, REBCNT index, REBVAL *rules, REBCNT depth) /* ***********************************************************************/ { REBSER *series = parse->series; REBVAL *item; // current rule item REBVAL *word; // active word to be set REBCNT start; // recovery restart point REBCNT i; // temp index point REBCNT begin; // point at beginning of match REBINT count; // iterated pattern counter REBINT mincount; // min pattern count REBINT maxcount; // max pattern count REBVAL *item_hold; REBVAL *val; // spare REBCNT rulen; REBSER *ser; REBFLG flags; REBCNT cmd; REBVAL *rule_head = rules; CHECK_STACK(&flags); //if (depth > MAX_PARSE_DEPTH) Trap_Word(RE_LIMIT_HIT, SYM_PARSE, 0); flags = 0; word = 0; mincount = maxcount = 1; start = begin = index; // For each rule in the rule block: while (NOT_END(rules)) { //Print_Parse_Index(parse->type, rules, series, index); if (--Eval_Count <= 0 || Eval_Signals) Do_Signals(); //-------------------------------------------------------------------- // Pre-Rule Processing Section // // For non-iterated rules, including setup for iterated rules. // The input index is not advanced here, but may be changed by // a GET-WORD variable. //-------------------------------------------------------------------- item = rules++; // If word, set-word, or get-word, process it: if (VAL_TYPE(item) >= REB_WORD && VAL_TYPE(item) <= REB_GET_WORD) { // Is it a command word? if (cmd = VAL_CMD(item)) { if (!IS_WORD(item)) Trap1(RE_PARSE_COMMAND, item); // SET or GET not allowed if (cmd <= SYM_BREAK) { // optimization switch (cmd) { case SYM_OR_BAR: return index; // reached it successfully // Note: mincount = maxcount = 1 on entry case SYM_WHILE: SET_FLAG(flags, PF_WHILE); case SYM_ANY: mincount = 0; case SYM_SOME: maxcount = MAX_I32; continue; case SYM_OPT: mincount = 0; continue; case SYM_COPY: SET_FLAG(flags, PF_COPY); case SYM_SET: SET_FLAG(flags, PF_SET); item = rules++; if (!IS_WORD(item)) Trap1(RE_PARSE_VARIABLE, item); if (VAL_CMD(item)) Trap1(RE_PARSE_COMMAND, item); word = item; continue; case SYM_NOT: SET_FLAG(flags, PF_NOT); flags ^= (1<<PF_NOT2); continue; case SYM_AND: SET_FLAG(flags, PF_AND); continue; case SYM_THEN: SET_FLAG(flags, PF_THEN); continue; case SYM_REMOVE: SET_FLAG(flags, PF_REMOVE); continue; case SYM_INSERT: SET_FLAG(flags, PF_INSERT); goto post; case SYM_CHANGE: SET_FLAG(flags, PF_CHANGE); continue; case SYM_RETURN: if (IS_PAREN(rules)) { item = Do_Block_Value_Throw(rules); // might GC Throw_Return_Value(item); } SET_FLAG(flags, PF_RETURN); continue; case SYM_ACCEPT: case SYM_BREAK: parse->result = 1; return index; case SYM_REJECT: parse->result = -1; return index; case SYM_FAIL: index = NOT_FOUND; goto post; case SYM_IF: item = rules++; if (IS_END(item)) goto bad_end; if (!IS_PAREN(item)) Trap1(RE_PARSE_RULE, item); item = Do_Block_Value_Throw(item); // might GC if (IS_TRUE(item)) continue; else { index = NOT_FOUND; goto post; } case SYM_LIMIT: Trap0(RE_NOT_DONE); //val = Get_Parse_Value(rules++); // if (IS_INTEGER(val)) limit = index + Int32(val); // else if (ANY_SERIES(val)) limit = VAL_INDEX(val); // else goto //goto bad_rule; // goto post; case SYM_QQ: Print_Parse_Index(parse->type, rules, series, index); continue; } } // Any other cmd must be a match command, so proceed... } else { // It's not a PARSE command, get or set it: // word: - set a variable to the series at current index if (IS_SET_WORD(item)) { Set_Var_Series(item, parse->type, series, index); continue; } // :word - change the index for the series to a new position if (IS_GET_WORD(item)) { item = Get_Var(item); // CureCode #1263 change //if (parse->type != VAL_TYPE(item) || VAL_SERIES(item) != series) // Trap1(RE_PARSE_SERIES, rules-1); if (!ANY_SERIES(item)) Trap1(RE_PARSE_SERIES, rules-1); index = Set_Parse_Series(parse, item); series = parse->series; continue; } // word - some other variable if (IS_WORD(item)) { item = Get_Var(item); } // item can still be 'word or /word } } else if (ANY_PATH(item)) { item = Do_Parse_Path(item, parse, &index); // index can be modified if (index > series->tail) index = series->tail; if (item == 0) continue; // for SET and GET cases } if (IS_PAREN(item)) { Do_Block_Value_Throw(item); // might GC if (index > series->tail) index = series->tail; continue; } // Counter? 123 if (IS_INTEGER(item)) { // Specify count or range count SET_FLAG(flags, PF_WHILE); mincount = maxcount = Int32s(item, 0); item = Get_Parse_Value(rules++); if (IS_END(item)) Trap1(RE_PARSE_END, rules-2); if (IS_INTEGER(item)) { maxcount = Int32s(item, 0); item = Get_Parse_Value(rules++); if (IS_END(item)) Trap1(RE_PARSE_END, rules-2); } } // else fall through on other values and words //-------------------------------------------------------------------- // Iterated Rule Matching Section: // // Repeats the same rule N times or until the rule fails. // The index is advanced and stored in a temp variable i until // the entire rule has been satisfied. //-------------------------------------------------------------------- item_hold = item; // a command or literal match value if (VAL_TYPE(item) <= REB_UNSET || VAL_TYPE(item) >= REB_NATIVE) goto bad_rule; begin = index; // input at beginning of match section rulen = 0; // rules consumed (do not use rule++ below) i = index; //note: rules var already advanced for (count = 0; count < maxcount;) { item = item_hold; if (IS_WORD(item)) { switch (cmd = VAL_WORD_CANON(item)) { case SYM_SKIP: i = (index < series->tail) ? index+1 : NOT_FOUND; break; case SYM_END: i = (index < series->tail) ? NOT_FOUND : series->tail; break; case SYM_TO: case SYM_THRU: if (IS_END(rules)) goto bad_end; item = Get_Parse_Value(rules); rulen = 1; i = Parse_To(parse, index, item, cmd == SYM_THRU); break; case SYM_QUOTE: if (IS_END(rules)) goto bad_end; rulen = 1; if (IS_PAREN(rules)) { item = Do_Block_Value_Throw(rules); // might GC } else item = rules; i = (0 == Cmp_Value(BLK_SKIP(series, index), item, parse->flags & AM_FIND_CASE)) ? index+1 : NOT_FOUND; break; case SYM_INTO: if (IS_END(rules)) goto bad_end; rulen = 1; item = Get_Parse_Value(rules); // sub-rules if (!IS_BLOCK(item)) goto bad_rule; val = BLK_SKIP(series, index); i = ( (ANY_BINSTR(val) || ANY_BLOCK(val)) && (Parse_Series(val, VAL_BLK_DATA(item), parse->flags, depth+1) == VAL_TAIL(val)) ) ? index+1 : NOT_FOUND; break; case SYM_DO: if (!IS_BLOCK_INPUT(parse)) goto bad_rule; i = Do_Eval_Rule(parse, index, &rules); rulen = 1; break; default: goto bad_rule; } } else if (IS_BLOCK(item)) { item = VAL_BLK_DATA(item); //if (IS_END(rules) && item == rule_head) { // rules = item; // goto top; //} i = Parse_Rules_Loop(parse, index, item, depth+1); if (parse->result) { index = (parse->result > 0) ? i : NOT_FOUND; parse->result = 0; break; } } // Parse according to datatype: else { if (IS_BLOCK_INPUT(parse)) i = Parse_Next_Block(parse, index, item, depth+1); else i = Parse_Next_String(parse, index, item, depth+1); } // Necessary for special cases like: some [to end] // i: indicates new index or failure of the match, but // that does not mean failure of the rule, because optional // matches can still succeed, if if the last match failed. if (i != NOT_FOUND) { count++; // may overflow to negative if (count < 0) count = MAX_I32; // the forever case // If input did not advance: if (i == index && !GET_FLAG(flags, PF_WHILE)) { if (count < mincount) index = NOT_FOUND; // was not enough break; } } //if (i >= series->tail) { // OLD check: no more input else { if (count < mincount) index = NOT_FOUND; // was not enough else if (i != NOT_FOUND) index = i; // else keep index as is. break; } index = i; // A BREAK word stopped us: //if (parse->result) {parse->result = 0; break;} } rules += rulen; //if (index > series->tail && index != NOT_FOUND) index = series->tail; if (index > series->tail) index = NOT_FOUND; //-------------------------------------------------------------------- // Post Match Processing: //-------------------------------------------------------------------- post: // Process special flags: if (flags) { // NOT before all others: if (GET_FLAG(flags, PF_NOT)) { if (GET_FLAG(flags, PF_NOT2) && index != NOT_FOUND) index = NOT_FOUND; else index = begin; } if (index == NOT_FOUND) { // Failure actions: // not decided: if (word) Set_Var_Basic(word, REB_NONE); if (GET_FLAG(flags, PF_THEN)) { SKIP_TO_BAR(rules); if (!IS_END(rules)) rules++; } } else { // Success actions: count = (begin > index) ? 0 : index - begin; // how much we advanced the input if (GET_FLAG(flags, PF_COPY)) { ser = (IS_BLOCK_INPUT(parse)) ? Copy_Block_Len(series, begin, count) : Copy_String(series, begin, count); // condenses Set_Var_Series(word, parse->type, ser, 0); } else if (GET_FLAG(flags, PF_SET)) { if (IS_BLOCK_INPUT(parse)) { item = Get_Var_Safe(word); if (count == 0) SET_NONE(item); else *item = *BLK_SKIP(series, begin); } else { item = Get_Var_Safe(word); if (count == 0) SET_NONE(item); else { i = GET_ANY_CHAR(series, begin); if (parse->type == REB_BINARY) { SET_INTEGER(item, i); } else { SET_CHAR(item, i); } } } } if (GET_FLAG(flags, PF_RETURN)) { ser = (IS_BLOCK_INPUT(parse)) ? Copy_Block_Len(series, begin, count) : Copy_String(series, begin, count); // condenses Throw_Return_Series(parse->type, ser); } if (GET_FLAG(flags, PF_REMOVE)) { if (count) Remove_Series(series, begin, count); index = begin; } if (flags & (1<<PF_INSERT | 1<<PF_CHANGE)) { count = GET_FLAG(flags, PF_INSERT) ? 0 : count; cmd = GET_FLAG(flags, PF_INSERT) ? 0 : (1<<AN_PART); item = rules++; if (IS_END(item)) goto bad_end; // Check for ONLY flag: if (IS_WORD(item) && NZ(cmd = VAL_CMD(item))) { if (cmd != SYM_ONLY) goto bad_rule; cmd |= (1<<AN_ONLY); item = rules++; } // CHECK FOR QUOTE!! item = Get_Parse_Value(item); // new value if (IS_UNSET(item)) Trap1(RE_NO_VALUE, rules-1); if (IS_END(item)) goto bad_end; if (IS_BLOCK_INPUT(parse)) { index = Modify_Block(GET_FLAG(flags, PF_CHANGE) ? A_CHANGE : A_INSERT, series, begin, item, cmd, count, 1); if (IS_LIT_WORD(item)) SET_TYPE(BLK_SKIP(series, index-1), REB_WORD); } else { if (parse->type == REB_BINARY) cmd |= (1<<AN_SERIES); // special flag index = Modify_String(GET_FLAG(flags, PF_CHANGE) ? A_CHANGE : A_INSERT, series, begin, item, cmd, count, 1); } } if (GET_FLAG(flags, PF_AND)) index = begin; } flags = 0; word = 0; } // Goto alternate rule and reset input: if (index == NOT_FOUND) { SKIP_TO_BAR(rules); if (IS_END(rules)) break; rules++; index = begin = start; } begin = index; mincount = maxcount = 1; } return index; bad_rule: Trap1(RE_PARSE_RULE, rules-1); bad_end: Trap1(RE_PARSE_END, rules-1); return 0; }
*/ REBCNT Find_Block(REBSER *series, REBCNT index, REBCNT end, REBVAL *target, REBCNT len, REBCNT flags, REBINT skip) /* ** Flags are set according to: ALL_FIND_REFS ** ** Main Parameters: ** start - index to start search ** end - ending position ** len - length of target ** skip - skip factor ** dir - direction ** ** Comparison Parameters: ** case - case sensitivity ** wild - wild cards/keys ** ** Final Parmameters: ** tail - tail position ** match - sequence ** SELECT - (value that follows) ** ***********************************************************************/ { REBVAL *value; REBVAL *val; REBCNT cnt; REBCNT start = index; if (flags & (AM_FIND_REVERSE | AM_FIND_LAST)) { skip = -1; start = 0; if (flags & AM_FIND_LAST) index = end - len; else index--; } // Optimized find word in block: if (ANY_WORD(target)) { for (; index >= start && index < end; index += skip) { value = BLK_SKIP(series, index); if (ANY_WORD(value)) { cnt = (VAL_WORD_SYM(value) == VAL_WORD_SYM(target)); if (flags & AM_FIND_CASE) { // Must be same type and spelling: if (cnt && VAL_TYPE(value) == VAL_TYPE(target)) return index; } else { // Can be different type or alias: if (cnt || VAL_WORD_CANON(value) == VAL_WORD_CANON(target)) return index; } } if (flags & AM_FIND_MATCH) break; } return NOT_FOUND; } // Match a block against a block: else if (ANY_BLOCK(target) && !(flags & AM_FIND_ONLY)) { for (; index >= start && index < end; index += skip) { cnt = 0; value = BLK_SKIP(series, index); for (val = VAL_BLK_DATA(target); NOT_END(val); val++, value++) { if (0 != Cmp_Value(value, val, (REBOOL)(flags & AM_FIND_CASE))) break; if (++cnt >= len) { return index; } } if (flags & AM_FIND_MATCH) break; } return NOT_FOUND; } // Find a datatype in block: else if (IS_DATATYPE(target) || IS_TYPESET(target)) { for (; index >= start && index < end; index += skip) { value = BLK_SKIP(series, index); // Used if's so we can trace it... if (IS_DATATYPE(target)) { if ((REBINT)VAL_TYPE(value) == VAL_DATATYPE(target)) return index; if (IS_DATATYPE(value) && VAL_DATATYPE(value) == VAL_DATATYPE(target)) return index; } if (IS_TYPESET(target)) { if (TYPE_CHECK(target, VAL_TYPE(value))) return index; if (IS_DATATYPE(value) && TYPE_CHECK(target, VAL_DATATYPE(value))) return index; if (IS_TYPESET(value) && EQUAL_TYPESET(value, target)) return index; } if (flags & AM_FIND_MATCH) break; } return NOT_FOUND; } // All other cases: else { for (; index >= start && index < end; index += skip) { value = BLK_SKIP(series, index); if (0 == Cmp_Value(value, target, (REBOOL)(flags & AM_FIND_CASE))) return index; if (flags & AM_FIND_MATCH) break; } return NOT_FOUND; } }
*/ REBCNT Modify_Block(REBCNT action, REBSER *dst_ser, REBCNT dst_idx, const REBVAL *src_val, REBCNT flags, REBINT dst_len, REBINT dups) /* ** action: INSERT, APPEND, CHANGE ** ** dst_ser: target ** dst_idx: position ** src_val: source ** flags: AN_ONLY, AN_PART ** dst_len: length to remove ** dups: dup count ** ** return: new dst_idx ** ***********************************************************************/ { REBCNT tail = SERIES_TAIL(dst_ser); REBINT ilen = 1; // length to be inserted REBINT size; // total to insert if (dups < 0) return (action == A_APPEND) ? 0 : dst_idx; if (action == A_APPEND || dst_idx > tail) dst_idx = tail; // Check /PART, compute LEN: if (!GET_FLAG(flags, AN_ONLY) && ANY_BLOCK(src_val)) { // Adjust length of insertion if changing /PART: if (action != A_CHANGE && GET_FLAG(flags, AN_PART)) ilen = dst_len; else ilen = VAL_LEN(src_val); // Are we modifying ourselves? If so, copy src_val block first: if (dst_ser == VAL_SERIES(src_val)) { REBSER *series = Copy_Block( VAL_SERIES(src_val), VAL_INDEX(src_val) ); src_val = BLK_HEAD(series); } else src_val = VAL_BLK_DATA(src_val); // skips by VAL_INDEX values } // Total to insert: size = dups * ilen; if (action != A_CHANGE) { // Always expand dst_ser for INSERT and APPEND actions: Expand_Series(dst_ser, dst_idx, size); } else { if (size > dst_len) Expand_Series(dst_ser, dst_idx, size-dst_len); else if (size < dst_len && GET_FLAG(flags, AN_PART)) Remove_Series(dst_ser, dst_idx, dst_len-size); else if (size + dst_idx > tail) { EXPAND_SERIES_TAIL(dst_ser, size - (tail - dst_idx)); } } tail = (action == A_APPEND) ? 0 : size + dst_idx; dst_idx *= SERIES_WIDE(dst_ser); // loop invariant ilen *= SERIES_WIDE(dst_ser); // loop invariant for (; dups > 0; dups--) { memcpy(dst_ser->data + dst_idx, src_val, ilen); dst_idx += ilen; } BLK_TERM(dst_ser); return tail; }
*/ void Make_Block_Type(REBFLG make, REBVAL *value, REBVAL *arg) /* ** Value can be: ** 1. a datatype (e.g. BLOCK!) ** 2. a value (e.g. [...]) ** ** Arg can be: ** 1. integer (length of block) ** 2. block (copy it) ** 3. value (convert to a block) ** ***********************************************************************/ { REBCNT type; REBCNT len; REBSER *ser; // make block! ... if (IS_DATATYPE(value)) type = VAL_DATATYPE(value); else // make [...] .... type = VAL_TYPE(value); // make block! [1 2 3] if (ANY_BLOCK(arg)) { len = VAL_BLK_LEN(arg); if (len > 0 && type >= REB_PATH && type <= REB_LIT_PATH) No_Nones(arg); ser = Copy_Values(VAL_BLK_DATA(arg), len); goto done; } if (IS_STRING(arg)) { REBCNT index, len = 0; VAL_SERIES(arg) = Prep_Bin_Str(arg, &index, &len); // (keeps safe) ser = Scan_Source(VAL_BIN(arg), VAL_LEN(arg)); goto done; } if (IS_BINARY(arg)) { ser = Scan_Source(VAL_BIN_DATA(arg), VAL_LEN(arg)); goto done; } if (IS_MAP(arg)) { ser = Map_To_Block(VAL_SERIES(arg), 0); goto done; } if (ANY_OBJECT(arg)) { ser = Make_Object_Block(VAL_OBJ_FRAME(arg), 3); goto done; } if (IS_VECTOR(arg)) { ser = Make_Vector_Block(arg); goto done; } // if (make && IS_NONE(arg)) { // ser = Make_Block(0); // goto done; // } // to block! typset if (!make && IS_TYPESET(arg) && type == REB_BLOCK) { Set_Block(value, Typeset_To_Block(arg)); return; } if (make) { // make block! 10 if (IS_INTEGER(arg) || IS_DECIMAL(arg)) { len = Int32s(arg, 0); Set_Series(type, value, Make_Block(len)); return; } Trap_Arg(arg); } ser = Copy_Values(arg, 1); done: Set_Series(type, value, ser); return; }
*/ static To_Thru(REBPARSE *parse, REBCNT index, REBVAL *block, REBFLG is_thru) /* ***********************************************************************/ { REBSER *series = parse->series; REBCNT type = parse->type; REBVAL *blk; REBVAL *item; REBCNT cmd; REBCNT i; REBCNT len; for (; index <= series->tail; index++) { for (blk = VAL_BLK(block); NOT_END(blk); blk++) { item = blk; // Deal with words and commands if (IS_WORD(item)) { if (cmd = VAL_CMD(item)) { if (cmd == SYM_END) { if (index >= series->tail) { index = series->tail; goto found; } goto next; } else if (cmd == SYM_QUOTE) { item = ++blk; // next item is the quoted value if (IS_END(item)) goto bad_target; if (IS_PAREN(item)) { item = Do_Block_Value_Throw(item); // might GC } } else goto bad_target; } else { item = Get_Var(item); } } else if (IS_PATH(item)) { item = Get_Parse_Value(item); } // Try to match it: if (type >= REB_BLOCK) { if (ANY_BLOCK(item)) goto bad_target; i = Parse_Next_Block(parse, index, item, 0); if (i != NOT_FOUND) { if (!is_thru) i--; index = i; goto found; } } else if (type == REB_BINARY) { REBYTE ch1 = *BIN_SKIP(series, index); // Handle special string types: if (IS_CHAR(item)) { if (VAL_CHAR(item) > 0xff) goto bad_target; if (ch1 == VAL_CHAR(item)) goto found1; } else if (IS_BINARY(item)) { if (ch1 == *VAL_BIN_DATA(item)) { len = VAL_LEN(item); if (len == 1) goto found1; if (0 == Compare_Bytes(BIN_SKIP(series, index), VAL_BIN_DATA(item), len, 0)) { if (is_thru) index += len; goto found; } } } else if (IS_INTEGER(item)) { if (VAL_INT64(item) > 0xff) goto bad_target; if (ch1 == VAL_INT32(item)) goto found1; } else goto bad_target; } else { // String REBCNT ch1 = GET_ANY_CHAR(series, index); REBCNT ch2; if (!HAS_CASE(parse)) ch1 = UP_CASE(ch1); // Handle special string types: if (IS_CHAR(item)) { ch2 = VAL_CHAR(item); if (!HAS_CASE(parse)) ch2 = UP_CASE(ch2); if (ch1 == ch2) goto found1; } else if (ANY_STR(item)) { ch2 = VAL_ANY_CHAR(item); if (!HAS_CASE(parse)) ch2 = UP_CASE(ch2); if (ch1 == ch2) { len = VAL_LEN(item); if (len == 1) goto found1; i = Find_Str_Str(series, 0, index, SERIES_TAIL(series), 1, VAL_SERIES(item), VAL_INDEX(item), len, AM_FIND_MATCH | parse->flags); if (i != NOT_FOUND) { if (is_thru) i += len; index = i; goto found; } } } else if (IS_INTEGER(item)) { ch1 = GET_ANY_CHAR(series, index); // No casing! if (ch1 == (REBCNT)VAL_INT32(item)) goto found1; } else goto bad_target; } next: // Check for | (required if not end) blk++; if (IS_PAREN(blk)) blk++; if (IS_END(blk)) break; if (!IS_OR_BAR(blk)) { item = blk; goto bad_target; } } } return NOT_FOUND; found: if (IS_PAREN(blk+1)) Do_Block_Value_Throw(blk+1); return index; found1: if (IS_PAREN(blk+1)) Do_Block_Value_Throw(blk+1); return index + (is_thru ? 1 : 0); bad_target: Trap1(RE_PARSE_RULE, item); return 0; }
*/ REBI64 Make_Time(REBVAL *val) /* ** Returns NO_TIME if error. ** ***********************************************************************/ { REBI64 secs = 0; if (IS_TIME(val)) { secs = VAL_TIME(val); } else if (IS_STRING(val)) { REBYTE *bp; REBCNT len; bp = Qualify_String(val, 30, &len, FALSE); // can trap, ret diff str if (!Scan_Time(bp, len, val)) goto no_time; secs = VAL_TIME(val); } else if (IS_INTEGER(val)) { if (VAL_INT64(val) < -MAX_SECONDS || VAL_INT64(val) > MAX_SECONDS) Trap_Range_DEAD_END(val); secs = VAL_INT64(val) * SEC_SEC; } else if (IS_DECIMAL(val)) { if (VAL_DECIMAL(val) < (REBDEC)(-MAX_SECONDS) || VAL_DECIMAL(val) > (REBDEC)MAX_SECONDS) Trap_Range_DEAD_END(val); secs = DEC_TO_SECS(VAL_DECIMAL(val)); } else if (ANY_BLOCK(val) && VAL_BLK_LEN(val) <= 3) { REBFLG neg = FALSE; REBI64 i; val = VAL_BLK_DATA(val); if (!IS_INTEGER(val)) goto no_time; i = Int32(val); if (i < 0) i = -i, neg = TRUE; secs = i * 3600; if (secs > MAX_SECONDS) goto no_time; if (NOT_END(++val)) { if (!IS_INTEGER(val)) goto no_time; if ((i = Int32(val)) < 0) goto no_time; secs += i * 60; if (secs > MAX_SECONDS) goto no_time; if (NOT_END(++val)) { if (IS_INTEGER(val)) { if ((i = Int32(val)) < 0) goto no_time; secs += i; if (secs > MAX_SECONDS) goto no_time; } else if (IS_DECIMAL(val)) { if (secs + (REBI64)VAL_DECIMAL(val) + 1 > MAX_SECONDS) goto no_time; // added in below } else goto no_time; } } secs *= SEC_SEC; if (IS_DECIMAL(val)) secs += DEC_TO_SECS(VAL_DECIMAL(val)); if (neg) secs = -secs; } else no_time: return NO_TIME; return secs; }
*/ void Modify_Blockx(REBCNT action, REBVAL *block, REBVAL *arg) /* ** Actions: INSERT, APPEND, CHANGE ** ** block [block!] {Series at point to insert} ** value [any-type!] {The value to insert} ** /part {Limits to a given length or position.} ** length [number! series! pair!] ** /only {Inserts a series as a series.} ** /dup {Duplicates the insert a specified number of times.} ** count [number! pair!] ** ** Add: ** Handle insert [] () case ** What does insert () [] do? ** /deep option for cloning subcontents? ** ***********************************************************************/ { REBSER *series = VAL_SERIES(block); REBCNT index = VAL_INDEX(block); REBCNT tail = VAL_TAIL(block); REBFLG only = DS_REF(AN_ONLY); REBINT rlen; // length to be removed REBINT ilen = 1; // length to be inserted REBINT cnt = 1; // DUP count REBINT size; REBFLG is_blk = FALSE; // arg is a block not a value // Length of target (may modify index): (arg can be anything) rlen = Partial1((action == A_CHANGE) ? block : arg, DS_ARG(AN_LENGTH)); index = VAL_INDEX(block); if (action == A_APPEND || index > tail) index = tail; // Check /PART, compute LEN: if (!only && ANY_BLOCK(arg)) { is_blk = TRUE; // arg is a block // Are we modifying ourselves? If so, copy arg block first: if (series == VAL_SERIES(arg)) { VAL_SERIES(arg) = Copy_Block(VAL_SERIES(arg), VAL_INDEX(arg)); VAL_INDEX(arg) = 0; } // Length of insertion: ilen = (action != A_CHANGE && DS_REF(AN_PART)) ? rlen : VAL_LEN(arg); } // Get /DUP count: if (DS_REF(AN_DUP)) { cnt = Int32(DS_ARG(AN_COUNT)); if (cnt <= 0) return; // no changes } // Total to insert: size = cnt * ilen; if (action != A_CHANGE) { // Always expand series for INSERT and APPEND actions: Expand_Series(series, index, size); } else { if (size > rlen) Expand_Series(series, index, size-rlen); else if (size < rlen && DS_REF(AN_PART)) Remove_Series(series, index, rlen-size); else if (size + index > tail) { EXPAND_SERIES_TAIL(series, size - (tail - index)); } } if (is_blk) arg = VAL_BLK_DATA(arg); // For dup count: VAL_INDEX(block) = (action == A_APPEND) ? 0 : size + index; index *= SERIES_WIDE(series); // loop invariant ilen *= SERIES_WIDE(series); // loop invariant for (; cnt > 0; cnt--) { memcpy(series->data + index, (REBYTE *)arg, ilen); index += ilen; } BLK_TERM(series); }
*/ static REB_R Loop_Each(struct Reb_Call *call_, LOOP_MODE mode) /* ** Common implementation code of FOR-EACH, REMOVE-EACH, MAP-EACH, ** and EVERY. ** ***********************************************************************/ { REBSER *body; REBVAL *vars; REBVAL *words; REBSER *frame; // `data` is the series/object/map/etc. being iterated over // Note: `data_is_object` flag is optimized out, but hints static analyzer REBVAL *data = D_ARG(2); REBSER *series; const REBOOL data_is_object = ANY_OBJECT(data); REBSER *out; // output block (needed for MAP-EACH) REBINT index; // !!!! should these be REBCNT? REBINT tail; REBINT windex; // write REBINT rindex; // read REBOOL break_with = FALSE; REBOOL every_true = TRUE; REBCNT i; REBCNT j; REBVAL *ds; if (IS_NONE(data)) return R_NONE; body = Init_Loop(D_ARG(1), D_ARG(3), &frame); // vars, body Val_Init_Object(D_ARG(1), frame); // keep GC safe Val_Init_Block(D_ARG(3), body); // keep GC safe SET_NONE(D_OUT); // Default result to NONE if the loop does not run if (mode == LOOP_MAP_EACH) { // Must be managed *and* saved...because we are accumulating results // into it, and those results must be protected from GC // !!! This means we cannot Free_Series in case of a BREAK, we // have to leave it to the GC. Should there be a variant which // lets a series be a GC root for a temporary time even if it is // not SER_KEEP? out = Make_Array(VAL_LEN(data)); MANAGE_SERIES(out); SAVE_SERIES(out); } // Get series info: if (data_is_object) { series = VAL_OBJ_FRAME(data); out = FRM_WORD_SERIES(series); // words (the out local reused) index = 1; //if (frame->tail > 3) raise Error_Invalid_Arg(FRM_WORD(frame, 3)); } else if (IS_MAP(data)) { series = VAL_SERIES(data); index = 0; //if (frame->tail > 3) raise Error_Invalid_Arg(FRM_WORD(frame, 3)); } else { series = VAL_SERIES(data); index = VAL_INDEX(data); if (index >= cast(REBINT, SERIES_TAIL(series))) { if (mode == LOOP_REMOVE_EACH) { SET_INTEGER(D_OUT, 0); } else if (mode == LOOP_MAP_EACH) { UNSAVE_SERIES(out); Val_Init_Block(D_OUT, out); } return R_OUT; } } windex = index; // Iterate over each value in the data series block: while (index < (tail = SERIES_TAIL(series))) { rindex = index; // remember starting spot j = 0; // Set the FOREACH loop variables from the series: for (i = 1; i < frame->tail; i++) { vars = FRM_VALUE(frame, i); words = FRM_WORD(frame, i); // var spec is WORD if (IS_WORD(words)) { if (index < tail) { if (ANY_BLOCK(data)) { *vars = *BLK_SKIP(series, index); } else if (data_is_object) { if (!VAL_GET_EXT(BLK_SKIP(out, index), EXT_WORD_HIDE)) { // Alternate between word and value parts of object: if (j == 0) { Val_Init_Word(vars, REB_WORD, VAL_WORD_SYM(BLK_SKIP(out, index)), series, index); if (NOT_END(vars+1)) index--; // reset index for the value part } else if (j == 1) *vars = *BLK_SKIP(series, index); else raise Error_Invalid_Arg(words); j++; } else { // Do not evaluate this iteration index++; goto skip_hidden; } } else if (IS_VECTOR(data)) { Set_Vector_Value(vars, series, index); } else if (IS_MAP(data)) { REBVAL *val = BLK_SKIP(series, index | 1); if (!IS_NONE(val)) { if (j == 0) { *vars = *BLK_SKIP(series, index & ~1); if (IS_END(vars+1)) index++; // only words } else if (j == 1) *vars = *BLK_SKIP(series, index); else raise Error_Invalid_Arg(words); j++; } else { index += 2; goto skip_hidden; } } else { // A string or binary if (IS_BINARY(data)) { SET_INTEGER(vars, (REBI64)(BIN_HEAD(series)[index])); } else if (IS_IMAGE(data)) { Set_Tuple_Pixel(BIN_SKIP(series, index), vars); } else { VAL_SET(vars, REB_CHAR); VAL_CHAR(vars) = GET_ANY_CHAR(series, index); } } index++; } else SET_NONE(vars); } // var spec is SET_WORD: else if (IS_SET_WORD(words)) { if (ANY_OBJECT(data) || IS_MAP(data)) *vars = *data; else Val_Init_Block_Index(vars, series, index); //if (index < tail) index++; // do not increment block. } else raise Error_Invalid_Arg(words); } if (index == rindex) { // the word block has only set-words: for-each [a:] [1 2 3][] index++; } if (Do_Block_Throws(D_OUT, body, 0)) { if (IS_WORD(D_OUT) && VAL_WORD_SYM(D_OUT) == SYM_CONTINUE) { if (mode == LOOP_REMOVE_EACH) { // signal the post-body-execution processing that we // *do not* want to remove the element on a CONTINUE SET_FALSE(D_OUT); } else { // CONTINUE otherwise acts "as if" the loop body execution // returned an UNSET! SET_UNSET(D_OUT); } } else if (IS_WORD(D_OUT) && VAL_WORD_SYM(D_OUT) == SYM_BREAK) { // If it's a BREAK, get the /WITH value (UNSET! if no /WITH) // Though technically this doesn't really tell us if a // BREAK/WITH happened, as you can BREAK/WITH an UNSET! TAKE_THROWN_ARG(D_OUT, D_OUT); if (!IS_UNSET(D_OUT)) break_with = TRUE; index = rindex; break; } else { // Any other kind of throw, with a WORD! name or otherwise... index = rindex; break; } } switch (mode) { case LOOP_FOR_EACH: // no action needed after body is run break; case LOOP_REMOVE_EACH: // If FALSE return, copy values to the write location // !!! Should UNSET! also act as conditional false here? Error? if (IS_CONDITIONAL_FALSE(D_OUT)) { REBYTE wide = SERIES_WIDE(series); // memory areas may overlap, so use memmove and not memcpy! // !!! This seems a slow way to do it, but there's probably // not a lot that can be done as the series is expected to // be in a good state for the next iteration of the body. :-/ memmove( series->data + (windex * wide), series->data + (rindex * wide), (index - rindex) * wide ); windex += index - rindex; } break; case LOOP_MAP_EACH: // anything that's not an UNSET! will be added to the result if (!IS_UNSET(D_OUT)) Append_Value(out, D_OUT); break; case LOOP_EVERY: if (every_true) { // !!! This currently treats UNSET! as true, which ALL // effectively does right now. That's likely a bad idea. // When ALL changes, so should this. // every_true = IS_CONDITIONAL_TRUE(D_OUT); } break; default: assert(FALSE); } skip_hidden: ; } switch (mode) { case LOOP_FOR_EACH: // Nothing to do but return last result (will be UNSET! if an // ordinary BREAK was used, the /WITH if a BREAK/WITH was used, // and an UNSET! if the last loop iteration did a CONTINUE.) return R_OUT; case LOOP_REMOVE_EACH: // Remove hole (updates tail): if (windex < index) Remove_Series(series, windex, index - windex); SET_INTEGER(D_OUT, index - windex); return R_OUT; case LOOP_MAP_EACH: UNSAVE_SERIES(out); if (break_with) { // If BREAK is given a /WITH parameter that is not an UNSET!, it // is assumed that you want to override the accumulated mapped // data so far and return the /WITH value. (which will be in // D_OUT when the loop above is `break`-ed) // !!! Would be nice if we could Free_Series(out), but it is owned // by GC (we had to make it that way to use SAVE_SERIES on it) return R_OUT; } // If you BREAK/WITH an UNSET! (or just use a BREAK that has no // /WITH, which is indistinguishable in the thrown value) then it // returns the accumulated results so far up to the break. Val_Init_Block(D_OUT, out); return R_OUT; case LOOP_EVERY: // Result is the cumulative TRUE? state of all the input (with any // unsets taken out of the consideration). The last TRUE? input // if all valid and NONE! otherwise. (Like ALL.) If the loop // never runs, `every_true` will be TRUE *but* D_OUT will be NONE! if (!every_true) SET_NONE(D_OUT); return R_OUT; } DEAD_END; }