*/ static REBFLG Get_Struct_Var(REBSTU *stu, REBVAL *word, REBVAL *val) /* ***********************************************************************/ { struct Struct_Field *field = NULL; REBCNT i = 0; field = (struct Struct_Field *)SERIES_DATA(stu->fields); for (i = 0; i < SERIES_TAIL(stu->fields); i ++, field ++) { if (VAL_WORD_CANON(word) == VAL_SYM_CANON(BLK_SKIP(PG_Word_Table.series, field->sym))) { if (field->array) { REBSER *ser = Make_Array(field->dimension); REBCNT n = 0; for (n = 0; n < field->dimension; n ++) { REBVAL elem; get_scalar(stu, field, n, &elem); Append_Value(ser, &elem); } Val_Init_Block(val, ser); } else { get_scalar(stu, field, 0, val); } return TRUE; } } return FALSE; }
*/ REBINT Awake_System(REBSER *ports, REBINT only) /* ** Returns: ** -1 for errors ** 0 for nothing to do ** 1 for wait is satisifed ** ***********************************************************************/ { REBVAL *port; REBVAL *state; REBVAL *waked; REBVAL *awake; REBVAL tmp; REBVAL ref_only; REBINT result; REBVAL out; // Get the system port object: port = Get_System(SYS_PORTS, PORTS_SYSTEM); if (!IS_PORT(port)) return -10; // verify it is a port object // Get wait queue block (the state field): state = VAL_OBJ_VALUE(port, STD_PORT_STATE); if (!IS_BLOCK(state)) return -10; //Debug_Num("S", VAL_TAIL(state)); // Get waked queue block: waked = VAL_OBJ_VALUE(port, STD_PORT_DATA); if (!IS_BLOCK(waked)) return -10; // If there is nothing new to do, return now: if (VAL_TAIL(state) == 0 && VAL_TAIL(waked) == 0) return -1; //Debug_Num("A", VAL_TAIL(waked)); // Get the system port AWAKE function: awake = VAL_OBJ_VALUE(port, STD_PORT_AWAKE); if (!ANY_FUNC(awake)) return -1; if (ports) Val_Init_Block(&tmp, ports); else SET_NONE(&tmp); if (only) SET_TRUE(&ref_only); else SET_NONE(&ref_only); // Call the system awake function: if (Apply_Func_Throws(&out, awake, port, &tmp, &ref_only, 0)) raise Error_No_Catch_For_Throw(&out); // Awake function returns 1 for end of WAIT: result = (IS_LOGIC(&out) && VAL_LOGIC(&out)) ? 1 : 0; return result; }
x*/ void RXI_To_Block(RXIFRM *frm, REBVAL *out) { /* ***********************************************************************/ REBCNT n; REBSER *blk; REBVAL *val; REBCNT len; blk = Make_Array(len = RXA_COUNT(frm)); for (n = 1; n <= len; n++) { val = Alloc_Tail_Array(blk); RXI_To_Value(val, frm->args[n], RXA_TYPE(frm, n)); } Val_Init_Block(out, blk); }
REB_R N_debug(REBFRM *frame_) { PARAM(1, value); REBVAL *value = ARG(value); if (IS_VOID(value)) { // // e.g. just `>> debug` and [enter] in the console. Ideally this // would shift the REPL into a mode where all commands issued were // assumed to be in the debug dialect, similar to Ren Garden's // modalities like `debug>>`. // Debug_Fmt("Sorry, there is no debug>> 'mode' yet in the console."); goto modify_with_confidence; } if (IS_INTEGER(value) || IS_FRAME(value) || IS_FUNCTION(value)) { REBFRM *frame; // We pass TRUE here to account for an extra stack level... the one // added by DEBUG itself, which presumably should not count. // if (!(frame = Frame_For_Stack_Level(&HG_Stack_Level, value, TRUE))) fail (Error_Invalid_Arg(value)); Val_Init_Block(D_OUT, Make_Where_For_Frame(frame)); return R_OUT; } assert(IS_BLOCK(value)); Debug_Fmt( "Sorry, but the `debug [...]` dialect is not defined yet.\n" "Change the stack level (integer!, frame!, function!)\n" "Or try out these commands:\n" "\n" " BREAKPOINT, RESUME, BACKTRACE\n" ); modify_with_confidence: Debug_Fmt( "(Note: Ren-C is 'modify-with-confidence'...so just because a debug\n" "feature you want isn't implemented doesn't mean you can't add it!)\n" ); return R_BLANK; }
// // RL_Extend: C // // Appends embedded extension to system/catalog/boot-exts. // // Returns: // A pointer to the REBOL library (see reb-lib.h). // Arguments: // source - A pointer to a UTF-8 (or ASCII) string that provides // extension module header, function definitions, and other // related functions and data. // call - A pointer to the extension's command dispatcher. // Notes: // This function simply adds the embedded extension to the // boot-exts list. All other processing and initialization // happens later during startup. Each embedded extension is // queried and init using LOAD-EXTENSION system native. // See c:extensions-embedded // RL_API void *RL_Extend(const REBYTE *source, RXICAL call) { REBVAL *value; REBARR *array; value = CTX_VAR(Sys_Context, SYS_CTX_BOOT_EXTS); if (IS_BLOCK(value)) array = VAL_ARRAY(value); else { array = Make_Array(2); Val_Init_Block(value, array); } value = Alloc_Tail_Array(array); Val_Init_Binary(value, Copy_Bytes(source, -1)); // UTF-8 value = Alloc_Tail_Array(array); SET_HANDLE_CODE(value, cast(CFUNC*, call)); return Extension_Lib(); }
*/ RL_API void *RL_Extend(const REBYTE *source, RXICAL call) /* ** Appends embedded extension to system/catalog/boot-exts. ** ** Returns: ** A pointer to the REBOL library (see reb-lib.h). ** Arguments: ** source - A pointer to a UTF-8 (or ASCII) string that provides ** extension module header, function definitions, and other ** related functions and data. ** call - A pointer to the extension's command dispatcher. ** Notes: ** This function simply adds the embedded extension to the ** boot-exts list. All other processing and initialization ** happens later during startup. Each embedded extension is ** queried and init using LOAD-EXTENSION system native. ** See c:extensions-embedded ** ***********************************************************************/ { REBVAL *value; REBSER *ser; value = BLK_SKIP(Sys_Context, SYS_CTX_BOOT_EXTS); if (IS_BLOCK(value)) ser = VAL_SERIES(value); else { ser = Make_Array(2); Val_Init_Block(value, ser); } value = Alloc_Tail_Array(ser); Val_Init_Binary(value, Copy_Bytes(source, -1)); // UTF-8 value = Alloc_Tail_Array(ser); SET_HANDLE_CODE(value, cast(CFUNC*, call)); return Extension_Lib(); }
*/ REBSER *Struct_To_Block(const REBSTU *stu) /* ** Used by MOLD to create a block. ** ***********************************************************************/ { REBSER *ser = Make_Array(10); struct Struct_Field *field = (struct Struct_Field*) SERIES_DATA(stu->fields); REBCNT i; // We are building a recursive structure. So if we did not hand each // sub-series over to the GC then a single Free_Series() would not know // how to free them all. There would have to be a specialized walk to // free the resulting structure. Hence, don't invoke the GC until the // root series being returned is done being used or is safe from GC! MANAGE_SERIES(ser); for(i = 0; i < SERIES_TAIL(stu->fields); i ++, field ++) { REBVAL *val = NULL; REBVAL *type_blk = NULL; /* required field name */ val = Alloc_Tail_Array(ser); Val_Init_Word_Unbound(val, REB_SET_WORD, field->sym); /* required type */ type_blk = Alloc_Tail_Array(ser); Val_Init_Block(type_blk, Make_Array(1)); val = Alloc_Tail_Array(VAL_SERIES(type_blk)); if (field->type == STRUCT_TYPE_STRUCT) { REBVAL *nested = NULL; DS_PUSH_NONE; nested = DS_TOP; Val_Init_Word_Unbound(val, REB_WORD, SYM_STRUCT_TYPE); get_scalar(stu, field, 0, nested); val = Alloc_Tail_Array(VAL_SERIES(type_blk)); Val_Init_Block(val, Struct_To_Block(&VAL_STRUCT(nested))); DS_DROP; } else Val_Init_Word_Unbound(val, REB_WORD, type_to_sym[field->type]); /* optional dimension */ if (field->dimension > 1) { REBSER *dim = Make_Array(1); REBVAL *dv = NULL; val = Alloc_Tail_Array(VAL_SERIES(type_blk)); Val_Init_Block(val, dim); dv = Alloc_Tail_Array(dim); SET_INTEGER(dv, field->dimension); } /* optional initialization */ if (field->dimension > 1) { REBSER *dim = Make_Array(1); REBCNT n = 0; val = Alloc_Tail_Array(ser); Val_Init_Block(val, dim); for (n = 0; n < field->dimension; n ++) { REBVAL *dv = Alloc_Tail_Array(dim); get_scalar(stu, field, n, dv); } } else { val = Alloc_Tail_Array(ser); get_scalar(stu, field, 0, val); } } return ser; }
*/ static REBINT Do_Set_Operation(struct Reb_Call *call_, REBCNT flags) /* ** Do set operations on a series. ** ***********************************************************************/ { REBVAL *val; REBVAL *val1; REBVAL *val2 = 0; REBSER *ser; REBSER *hser = 0; // hash table for series REBSER *retser; // return series REBSER *hret; // hash table for return series REBCNT i; REBINT h = TRUE; REBCNT skip = 1; // record size REBCNT cased = 0; // case sensitive when TRUE SET_NONE(D_OUT); val1 = D_ARG(1); i = 2; // Check for second series argument: if (flags != SET_OP_UNIQUE) { val2 = D_ARG(i++); if (VAL_TYPE(val1) != VAL_TYPE(val2)) raise Error_Unexpected_Type(VAL_TYPE(val1), VAL_TYPE(val2)); } // Refinements /case and /skip N cased = D_REF(i++); // cased if (D_REF(i++)) skip = Int32s(D_ARG(i), 1); switch (VAL_TYPE(val1)) { case REB_BLOCK: i = VAL_LEN(val1); // Setup result block: if (GET_FLAG(flags, SOP_BOTH)) i += VAL_LEN(val2); retser = BUF_EMIT; // use preallocated shared block Resize_Series(retser, i); hret = Make_Hash_Sequence(i); // allocated // Optimization note: !! // This code could be optimized for small blocks by not hashing them // and extending Find_Key to do a FIND on the value itself w/o the hash. do { // Check what is in series1 but not in series2: if (GET_FLAG(flags, SOP_CHECK)) hser = Hash_Block(val2, cased); // Iterate over first series: ser = VAL_SERIES(val1); i = VAL_INDEX(val1); for (; val = BLK_SKIP(ser, i), i < SERIES_TAIL(ser); i += skip) { if (GET_FLAG(flags, SOP_CHECK)) { h = Find_Key(VAL_SERIES(val2), hser, val, skip, cased, 1) >= 0; if (GET_FLAG(flags, SOP_INVERT)) h = !h; } if (h) Find_Key(retser, hret, val, skip, cased, 2); } // Iterate over second series? if ((i = GET_FLAG(flags, SOP_BOTH))) { val = val1; val1 = val2; val2 = val; CLR_FLAG(flags, SOP_BOTH); } if (GET_FLAG(flags, SOP_CHECK)) Free_Series(hser); } while (i); if (hret) Free_Series(hret); Val_Init_Block(D_OUT, Copy_Array_Shallow(retser)); RESET_TAIL(retser); // required - allow reuse break; case REB_BINARY: cased = TRUE; SET_TYPE(D_OUT, REB_BINARY); case REB_STRING: i = VAL_LEN(val1); // Setup result block: if (GET_FLAG(flags, SOP_BOTH)) i += VAL_LEN(val2); retser = BUF_MOLD; Reset_Buffer(retser, i); RESET_TAIL(retser); do { REBUNI uc; cased = cased ? AM_FIND_CASE : 0; // Iterate over first series: ser = VAL_SERIES(val1); i = VAL_INDEX(val1); for (; i < SERIES_TAIL(ser); i += skip) { uc = GET_ANY_CHAR(ser, i); if (GET_FLAG(flags, SOP_CHECK)) { h = Find_Str_Char(VAL_SERIES(val2), 0, VAL_INDEX(val2), VAL_TAIL(val2), skip, uc, cased) != NOT_FOUND; if (GET_FLAG(flags, SOP_INVERT)) h = !h; } if (h && (Find_Str_Char(retser, 0, 0, SERIES_TAIL(retser), skip, uc, cased) == NOT_FOUND)) { Append_String(retser, ser, i, skip); } } // Iterate over second series? if ((i = GET_FLAG(flags, SOP_BOTH))) { val = val1; val1 = val2; val2 = val; CLR_FLAG(flags, SOP_BOTH); } } while (i); ser = Copy_String(retser, 0, -1); if (IS_BINARY(D_OUT)) Val_Init_Binary(D_OUT, ser); else Val_Init_String(D_OUT, ser); break; case REB_BITSET: switch (flags) { case SET_OP_UNIQUE: return R_ARG1; case SET_OP_UNION: i = A_OR; break; case SET_OP_INTERSECT: i = A_AND; break; case SET_OP_DIFFERENCE: i = A_XOR; break; case SET_OP_EXCLUDE: i = 0; // special case break; } ser = Xandor_Binary(i, val1, val2); Val_Init_Bitset(D_OUT, ser); break; case REB_TYPESET: switch (flags) { case SET_OP_UNIQUE: break; case SET_OP_UNION: VAL_TYPESET(val1) |= VAL_TYPESET(val2); break; case SET_OP_INTERSECT: VAL_TYPESET(val1) &= VAL_TYPESET(val2); break; case SET_OP_DIFFERENCE: VAL_TYPESET(val1) ^= VAL_TYPESET(val2); break; case SET_OP_EXCLUDE: VAL_TYPESET(val1) &= ~VAL_TYPESET(val2); break; } return R_ARG1; default: raise Error_Invalid_Arg(val1); } return R_OUT; }
*/ static REB_R Dir_Actor(struct Reb_Call *call_, REBSER *port, REBCNT action) /* ** Internal port handler for file directories. ** ***********************************************************************/ { REBVAL *spec; REBVAL *path; REBVAL *state; REBREQ dir; REBCNT args = 0; REBINT result; REBCNT len; //REBYTE *flags; Validate_Port(port, action); *D_OUT = *D_ARG(1); CLEARS(&dir); // Validate and fetch relevant PORT fields: spec = BLK_SKIP(port, STD_PORT_SPEC); if (!IS_OBJECT(spec)) raise Error_1(RE_INVALID_SPEC, spec); path = Obj_Value(spec, STD_PORT_SPEC_HEAD_REF); if (!path) raise Error_1(RE_INVALID_SPEC, spec); if (IS_URL(path)) path = Obj_Value(spec, STD_PORT_SPEC_HEAD_PATH); else if (!IS_FILE(path)) raise Error_1(RE_INVALID_SPEC, path); state = BLK_SKIP(port, STD_PORT_STATE); // if block, then port is open. //flags = Security_Policy(SYM_FILE, path); // Get or setup internal state data: dir.port = port; dir.device = RDI_FILE; switch (action) { case A_READ: //Trap_Security(flags[POL_READ], POL_READ, path); args = Find_Refines(call_, ALL_READ_REFS); if (!IS_BLOCK(state)) { // !!! ignores /SKIP and /PART, for now Init_Dir_Path(&dir, path, 1, POL_READ); Val_Init_Block(state, Make_Array(7)); // initial guess result = Read_Dir(&dir, VAL_SERIES(state)); ///OS_FREE(dir.file.path); if (result < 0) raise Error_On_Port(RE_CANNOT_OPEN, port, dir.error); *D_OUT = *state; SET_NONE(state); } else { // !!! This copies the strings in the block, shallowly. What is // the purpose of doing this? Why copy at all? Val_Init_Block( D_OUT, Copy_Array_Core_Managed( VAL_SERIES(state), 0, VAL_BLK_LEN(state), FALSE, // !deep TS_STRING ) ); } break; case A_CREATE: //Trap_Security(flags[POL_WRITE], POL_WRITE, path); if (IS_BLOCK(state)) raise Error_1(RE_ALREADY_OPEN, path); create: Init_Dir_Path(&dir, path, 0, POL_WRITE | REMOVE_TAIL_SLASH); // Sets RFM_DIR too result = OS_DO_DEVICE(&dir, RDC_CREATE); ///OS_FREE(dir.file.path); if (result < 0) raise Error_1(RE_NO_CREATE, path); if (action == A_CREATE) { // !!! Used to return R_ARG2, but create is single arity. :-/ return R_ARG1; } SET_NONE(state); break; case A_RENAME: if (IS_BLOCK(state)) raise Error_1(RE_ALREADY_OPEN, path); else { REBSER *target; Init_Dir_Path(&dir, path, 0, POL_WRITE | REMOVE_TAIL_SLASH); // Sets RFM_DIR too // Convert file name to OS format: if (!(target = Value_To_OS_Path(D_ARG(2), TRUE))) raise Error_1(RE_BAD_FILE_PATH, D_ARG(2)); dir.common.data = BIN_DATA(target); OS_DO_DEVICE(&dir, RDC_RENAME); Free_Series(target); if (dir.error) raise Error_1(RE_NO_RENAME, path); } break; case A_DELETE: //Trap_Security(flags[POL_WRITE], POL_WRITE, path); SET_NONE(state); Init_Dir_Path(&dir, path, 0, POL_WRITE); // !!! add *.r deletion // !!! add recursive delete (?) result = OS_DO_DEVICE(&dir, RDC_DELETE); ///OS_FREE(dir.file.path); if (result < 0) raise Error_1(RE_NO_DELETE, path); // !!! Returned R_ARG2 before, but there is no second argument :-/ return R_ARG1; case A_OPEN: // !! If open fails, what if user does a READ w/o checking for error? if (IS_BLOCK(state)) raise Error_1(RE_ALREADY_OPEN, path); //Trap_Security(flags[POL_READ], POL_READ, path); args = Find_Refines(call_, ALL_OPEN_REFS); if (args & AM_OPEN_NEW) goto create; //if (args & ~AM_OPEN_READ) raise Error_1(RE_INVALID_SPEC, path); Val_Init_Block(state, Make_Array(7)); Init_Dir_Path(&dir, path, 1, POL_READ); result = Read_Dir(&dir, VAL_SERIES(state)); ///OS_FREE(dir.file.path); if (result < 0) raise Error_On_Port(RE_CANNOT_OPEN, port, dir.error); break; case A_OPENQ: if (IS_BLOCK(state)) return R_TRUE; return R_FALSE; case A_CLOSE: SET_NONE(state); break; case A_QUERY: //Trap_Security(flags[POL_READ], POL_READ, path); SET_NONE(state); Init_Dir_Path(&dir, path, -1, REMOVE_TAIL_SLASH | POL_READ); if (OS_DO_DEVICE(&dir, RDC_QUERY) < 0) return R_NONE; Ret_Query_File(port, &dir, D_OUT); ///OS_FREE(dir.file.path); break; //-- Port Series Actions (only called if opened as a port) case A_LENGTH: len = IS_BLOCK(state) ? VAL_BLK_LEN(state) : 0; SET_INTEGER(D_OUT, len); break; default: raise Error_Illegal_Action(REB_PORT, action); } return R_OUT; }
*/ 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; }