*/ 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; }
x*/ void Modify_StringX(REBCNT action, REBVAL *string, REBVAL *arg) /* ** Actions: INSERT, APPEND, CHANGE ** ** string [string!] {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!] ** ***********************************************************************/ { REBSER *series = VAL_SERIES(string); REBCNT index = VAL_INDEX(string); REBCNT tail = VAL_TAIL(string); REBINT rlen; // length to be removed REBINT ilen = 1; // length to be inserted REBINT cnt = 1; // DUP count REBINT size; REBVAL *val; REBSER *arg_ser = 0; // argument series // Length of target (may modify index): (arg can be anything) rlen = Partial1((action == A_CHANGE) ? string : arg, DS_ARG(AN_LENGTH)); index = VAL_INDEX(string); if (action == A_APPEND || index > tail) index = tail; // If the arg is not a string, then we need to create a string: if (IS_BINARY(string)) { if (IS_INTEGER(arg)) { if (VAL_INT64(arg) > 255 || VAL_INT64(arg) < 0) Trap_Range(arg); arg_ser = Make_Binary(1); Append_Byte(arg_ser, VAL_CHAR(arg)); // check for size!!! } else if (!ANY_BINSTR(arg)) Trap_Arg(arg); } else if (IS_BLOCK(arg)) { // MOVE! REB_MOLD mo = {0}; arg_ser = mo.series = Make_Unicode(VAL_BLK_LEN(arg) * 10); // GC!? for (val = VAL_BLK_DATA(arg); NOT_END(val); val++) Mold_Value(&mo, val, 0); } else if (IS_CHAR(arg)) { // Optimize this case !!! arg_ser = Make_Unicode(1); Append_Byte(arg_ser, VAL_CHAR(arg)); } else if (!ANY_STR(arg) || IS_TAG(arg)) { arg_ser = Copy_Form_Value(arg, 0); } if (arg_ser) Set_String(arg, arg_ser); else arg_ser = VAL_SERIES(arg); // Length of insertion: ilen = (action != A_CHANGE && DS_REF(AN_PART)) ? rlen : VAL_LEN(arg); // If Source == Destination we need to prevent possible conflicts. // Clone the argument just to be safe. // (Note: It may be possible to optimize special cases like append !!) if (series == VAL_SERIES(arg)) { arg_ser = Copy_Series_Part(arg_ser, VAL_INDEX(arg), ilen); // GC!? } // 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)); } } // For dup count: for (; cnt > 0; cnt--) { Insert_String(series, index, arg_ser, VAL_INDEX(arg), ilen, TRUE); index += ilen; } TERM_SERIES(series); VAL_INDEX(string) = (action == A_APPEND) ? 0 : index; }
*/ void Mold_Value(REB_MOLD *mold, REBVAL *value, REBFLG molded) /* ** Mold or form any value to string series tail. ** ***********************************************************************/ { REBYTE buf[60]; REBINT len; REBSER *ser = mold->series; CHECK_STACK(&len); ASSERT2(SERIES_WIDE(mold->series) == sizeof(REBUNI), RP_BAD_SIZE); ASSERT2(ser, RP_NO_BUFFER); // Special handling of string series: { if (ANY_STR(value) && !IS_TAG(value)) { // Forming a string: if (!molded) { Insert_String(ser, -1, VAL_SERIES(value), VAL_INDEX(value), VAL_LEN(value), 0); return; } // Special format for ALL string series when not at head: if (GET_MOPT(mold, MOPT_MOLD_ALL) && VAL_INDEX(value) != 0) { Mold_All_String(value, mold); return; } } switch (VAL_TYPE(value)) { case REB_NONE: Emit(mold, "+N", SYM_NONE); break; case REB_LOGIC: // if (!molded || !VAL_LOGIC_WORDS(value) || !GET_MOPT(mold, MOPT_MOLD_ALL)) Emit(mold, "+N", VAL_LOGIC(value) ? SYM_TRUE : SYM_FALSE); // else // Mold_Logic(mold, value); break; case REB_INTEGER: len = Emit_Integer(buf, VAL_INT64(value)); goto append; case REB_DECIMAL: case REB_PERCENT: len = Emit_Decimal(buf, VAL_DECIMAL(value), IS_PERCENT(value)?DEC_MOLD_PERCENT:0, Punctuation[GET_MOPT(mold, MOPT_COMMA_PT) ? PUNCT_COMMA : PUNCT_DOT], mold->digits); goto append; case REB_MONEY: len = Emit_Money(value, buf, mold->opts); goto append; case REB_CHAR: Mold_Uni_Char(ser, VAL_CHAR(value), (REBOOL)molded, (REBOOL)GET_MOPT(mold, MOPT_MOLD_ALL)); break; case REB_PAIR: len = Emit_Decimal(buf, VAL_PAIR_X(value), DEC_MOLD_MINIMAL, Punctuation[PUNCT_DOT], mold->digits/2); Append_Bytes_Len(ser, buf, len); Append_Byte(ser, 'x'); len = Emit_Decimal(buf, VAL_PAIR_Y(value), DEC_MOLD_MINIMAL, Punctuation[PUNCT_DOT], mold->digits/2); Append_Bytes_Len(ser, buf, len); //Emit(mold, "IxI", VAL_PAIR_X(value), VAL_PAIR_Y(value)); break; case REB_TUPLE: len = Emit_Tuple(value, buf); goto append; case REB_TIME: //len = Emit_Time(value, buf, Punctuation[GET_MOPT(mold, MOPT_COMMA_PT) ? PUNCT_COMMA : PUNCT_DOT]); Emit_Time(mold, value); break; case REB_DATE: Emit_Date(mold, value); break; case REB_STRING: // FORM happens in top section. Mold_String_Series(value, mold); break; case REB_BINARY: if (GET_MOPT(mold, MOPT_MOLD_ALL) && VAL_INDEX(value) != 0) { Mold_All_String(value, mold); return; } Mold_Binary(value, mold); break; case REB_FILE: if (VAL_LEN(value) == 0) { Append_Bytes(ser, "%\"\""); break; } Mold_File(value, mold); break; case REB_EMAIL: case REB_URL: Mold_Url(value, mold); break; case REB_TAG: if (GET_MOPT(mold, MOPT_MOLD_ALL) && VAL_INDEX(value) != 0) { Mold_All_String(value, mold); return; } Mold_Tag(value, mold); break; // Mold_Issue(value, mold); // break; case REB_BITSET: Pre_Mold(value, mold); // #[bitset! or make bitset! Mold_Bitset(value, mold); End_Mold(mold); break; case REB_IMAGE: Pre_Mold(value, mold); if (!GET_MOPT(mold, MOPT_MOLD_ALL)) { Append_Byte(ser, '['); Mold_Image_Data(value, mold); Append_Byte(ser, ']'); End_Mold(mold); } else { REBVAL val = *value; VAL_INDEX(&val) = 0; // mold all of it Mold_Image_Data(&val, mold); Post_Mold(value, mold); } break; case REB_BLOCK: case REB_PAREN: if (!molded) Form_Block_Series(VAL_SERIES(value), VAL_INDEX(value), mold, 0); else Mold_Block(value, mold); break; case REB_PATH: case REB_SET_PATH: case REB_GET_PATH: case REB_LIT_PATH: Mold_Block(value, mold); break; case REB_VECTOR: Mold_Vector(value, mold, molded); break; case REB_DATATYPE: if (!molded) Emit(mold, "N", VAL_DATATYPE(value) + 1); else Emit(mold, "+DN", SYM_DATATYPE_TYPE, VAL_DATATYPE(value) + 1); break; case REB_TYPESET: Mold_Typeset(value, mold, molded); break; case REB_WORD: // This is a high frequency function, so it is optimized. Append_UTF8(ser, Get_Sym_Name(VAL_WORD_SYM(value)), -1); break; case REB_SET_WORD: Emit(mold, "W:", value); break; case REB_GET_WORD: Emit(mold, ":W", value); break; case REB_LIT_WORD: Emit(mold, "\'W", value); break; case REB_REFINEMENT: Emit(mold, "/W", value); break; case REB_ISSUE: Emit(mold, "#W", value); break; case REB_CLOSURE: case REB_FUNCTION: case REB_NATIVE: case REB_ACTION: case REB_COMMAND: Mold_Function(value, mold); break; case REB_OBJECT: case REB_MODULE: case REB_PORT: if (!molded) Form_Object(value, mold); else Mold_Object(value, mold); break; case REB_TASK: Mold_Object(value, mold); //// | (1<<MOPT_NO_NONE)); break; case REB_ERROR: Mold_Error(value, mold, molded); break; case REB_MAP: Mold_Map(value, mold, molded); break; case REB_GOB: { REBSER *blk; Pre_Mold(value, mold); blk = Gob_To_Block(VAL_GOB(value)); Mold_Block_Series(mold, blk, 0, 0); End_Mold(mold); } break; case REB_EVENT: Mold_Event(value, mold); break; case REB_REBCODE: case REB_OP: case REB_FRAME: case REB_HANDLE: case REB_STRUCT: case REB_LIBRARY: case REB_UTYPE: // Value has no printable form, so just print its name. if (!molded) Emit(mold, "?T?", value); else Emit(mold, "+T", value); break; case REB_END: case REB_UNSET: if (molded) Emit(mold, "+T", value); break; default: Crash(RP_DATATYPE+5, VAL_TYPE(value)); } return; append: Append_Bytes_Len(ser, buf, len); }
static REBSER *make_binary(REBVAL *arg, REBOOL make) { REBSER *ser; // MAKE BINARY! 123 switch (VAL_TYPE(arg)) { case REB_INTEGER: case REB_DECIMAL: if (make) ser = Make_Binary(Int32s(arg, 0)); else ser = Make_Binary_BE64(arg); break; // MAKE/TO BINARY! BINARY! case REB_BINARY: ser = Copy_Bytes(VAL_BIN_DATA(arg), VAL_LEN(arg)); break; // MAKE/TO BINARY! <any-string> case REB_STRING: case REB_FILE: case REB_EMAIL: case REB_URL: case REB_TAG: // case REB_ISSUE: ser = Encode_UTF8_Value(arg, VAL_LEN(arg), 0); break; case REB_BLOCK: // Join_Binary returns a shared buffer, so produce a copy: ser = Copy_Series(Join_Binary(arg)); break; // MAKE/TO BINARY! <tuple!> case REB_TUPLE: ser = Copy_Bytes(VAL_TUPLE(arg), VAL_TUPLE_LEN(arg)); break; // MAKE/TO BINARY! <char!> case REB_CHAR: ser = Make_Binary(6); ser->tail = Encode_UTF8_Char(BIN_HEAD(ser), VAL_CHAR(arg)); break; // MAKE/TO BINARY! <bitset!> case REB_BITSET: ser = Copy_Bytes(VAL_BIN(arg), VAL_TAIL(arg)); break; // MAKE/TO BINARY! <image!> case REB_IMAGE: ser = Make_Image_Binary(arg); break; case REB_MONEY: ser = Make_Binary(12); ser->tail = 12; deci_to_binary(ser->data, VAL_DECI(arg)); ser->data[12] = 0; break; default: ser = 0; } return ser; }