STOID Form_Block_Series(REBSER *blk, REBCNT index, REB_MOLD *mold, REBSER *frame)
{
// Form a series (part_mold means mold non-string values):
REBINT n;
REBINT len = SERIES_TAIL(blk) - index;
REBVAL *val;
REBVAL *wval;
if (len < 0) len = 0;
for (n = 0; n < len;) {
val = BLK_SKIP(blk, index+n);
wval = 0;
if (frame && (IS_WORD(val) || IS_GET_WORD(val))) {
wval = Find_Word_Value(frame, VAL_WORD_SYM(val));
if (wval) val = wval;
}
Mold_Value(mold, val, wval != 0);
n++;
if (GET_MOPT(mold, MOPT_LINES)) {
Append_Byte(mold->series, LF);
}
else {
// Add a space if needed:
if (n < len && mold->series->tail
&& *UNI_LAST(mold->series) != LF
&& !GET_MOPT(mold, MOPT_TIGHT)
)
Append_Byte(mold->series, ' ');
}
}
}
STOID Mold_Object(REBVAL *value, REB_MOLD *mold)
{
REBSER *wser;
REBVAL *words;
REBVAL *vals; // first value is context
REBCNT n;
REBOOL indented = !GET_MOPT(mold, MOPT_INDENT);
ASSERT(VAL_OBJ_FRAME(value), RP_NO_OBJECT_FRAME);
wser = VAL_OBJ_WORDS(value);
// if (wser < 1000)
// Dump_Block_Raw(VAL_OBJ_FRAME(value), 0, 1);
words = BLK_HEAD(wser);
vals = VAL_OBJ_VALUES(value); // first value is context
Pre_Mold(value, mold);
Append_Byte(mold->series, '[');
// Prevent infinite looping:
if (Find_Same_Block(MOLD_LOOP, value) > 0) {
Append_Bytes(mold->series, "...]");
return;
}
Append_Val(MOLD_LOOP, value);
mold->indent++;
for (n = 1; n < SERIES_TAIL(wser); n++) {
if (
!VAL_GET_OPT(words+n, OPTS_HIDE) &&
((VAL_TYPE(vals+n) > REB_NONE) || !GET_MOPT(mold, MOPT_NO_NONE))
){
if(indented)
New_Indented_Line(mold);
else if (n > 1)
Append_Byte(mold->series, ' ');
Append_UTF8(mold->series, Get_Sym_Name(VAL_WORD_SYM(words+n)), -1);
//Print("Slot: %s", Get_Sym_Name(VAL_WORD_SYM(words+n)));
Append_Bytes(mold->series, ": ");
if (IS_WORD(vals+n) && !GET_MOPT(mold, MOPT_MOLD_ALL)) Append_Byte(mold->series, '\'');
Mold_Value(mold, vals+n, TRUE);
}
}
mold->indent--;
if (indented) New_Indented_Line(mold);
Append_Byte(mold->series, ']');
End_Mold(mold);
Remove_Last(MOLD_LOOP);
}
*/ void New_Indented_Line(REB_MOLD *mold)
/*
** Create a newline with auto-indent on next line if needed.
**
***********************************************************************/
{
REBINT n;
REBUNI *cp = 0;
// Check output string has content already but no terminator:
if (mold->series->tail) {
cp = UNI_LAST(mold->series);
if (*cp == ' ' || *cp == '\t') *cp = '\n';
else cp = 0;
}
// Add terminator:
if (!cp) Append_Byte(mold->series, '\n');
// Add proper indentation:
if (!GET_MOPT(mold, MOPT_INDENT)) {
for (n = 0; n < mold->indent; n++)
Append_Bytes(mold->series, " ");
}
}
*/ void Reset_Mold(REB_MOLD *mold)
/*
***********************************************************************/
{
REBSER *buf = BUF_MOLD;
REBINT len;
if (!buf) Crash(RP_NO_BUFFER);
if (SERIES_REST(buf) > MAX_COMMON)
Shrink_Series(buf, MIN_COMMON);
BLK_RESET(MOLD_LOOP);
RESET_SERIES(buf);
mold->series = buf;
// This is not needed every time, but w/o a functional way to set the option,
// it must be done like this and each time.
if (GET_MOPT(mold, MOPT_MOLD_ALL)) len = MAX_DIGITS;
else {
len = Get_System_Int(SYS_OPTIONS, OPTIONS_DECIMAL_DIGITS, MAX_DIGITS);
if (len > MAX_DIGITS) len = MAX_DIGITS;
else if (len < 0) len = 0;
}
mold->digits = len;
}
*/ void Reset_Mold(REB_MOLD *mold)
/*
***********************************************************************/
{
REBSER *buf = BUF_MOLD;
REBINT len;
if (!buf) Panic(RP_NO_BUFFER);
if (SERIES_REST(buf) > MAX_COMMON)
Shrink_Series(buf, MIN_COMMON);
BLK_RESET(MOLD_LOOP);
RESET_SERIES(buf);
mold->series = buf;
// This is not needed every time, but w/o a functional way to set the option,
// it must be done like this and each time.
if (GET_MOPT(mold, MOPT_MOLD_ALL)) len = MAX_DIGITS;
else {
// !!! It may be necessary to mold out values before the options
// block is loaded, and this 'Get_System_Int' is a bottleneck which
// crashes that in early debugging. BOOT_ERRORS is sufficient.
if (PG_Boot_Phase >= BOOT_ERRORS)
len = Get_System_Int(SYS_OPTIONS, OPTIONS_DECIMAL_DIGITS, MAX_DIGITS);
else
len = MAX_DIGITS;
if (len > MAX_DIGITS) len = MAX_DIGITS;
else if (len < 0) len = 0;
}
mold->digits = len;
}
*/ void End_Mold(REB_MOLD *mold)
/*
** Finish the mold, depending on /ALL with close block.
**
***********************************************************************/
{
if (GET_MOPT(mold, MOPT_MOLD_ALL)) Append_Byte(mold->series, ']');
}
*/ void Pre_Mold(REBVAL *value, REB_MOLD *mold)
/*
** Emit the initial datatype function, depending on /ALL option
**
***********************************************************************/
{
Emit(mold, GET_MOPT(mold, MOPT_MOLD_ALL) ? "#[T " : "make T ", value);
}
*/ void Post_Mold(REBVAL *value, REB_MOLD *mold)
/*
** For series that has an index, add the index for mold/all.
** Add closing block.
**
***********************************************************************/
{
if (VAL_INDEX(value)) {
Append_Byte(mold->series, ' ');
Append_Int(mold->series, VAL_INDEX(value)+1);
}
if (GET_MOPT(mold, MOPT_MOLD_ALL)) Append_Byte(mold->series, ']');
}
*/ REBSER *Emit(REB_MOLD *mold, REBYTE *fmt, ...)
/*
***********************************************************************/
{
va_list args;
REBYTE ender = 0;
REBSER *series = mold->series;
ASSERT2(SERIES_WIDE(series) ==2, 9997);
va_start(args, fmt);
for (; *fmt; fmt++) {
switch (*fmt) {
case 'W': // Word symbol
Append_UTF8(series, Get_Word_Name(va_arg(args, REBVAL*)), -1);
break;
case 'V': // Value
Mold_Value(mold, va_arg(args, REBVAL*), TRUE);
break;
case 'S': // String of bytes
Append_Bytes(series, va_arg(args, REBYTE*));
break;
case 'C': // Char
Append_Byte(series, va_arg(args, REBCNT));
break;
case 'E': // Series (byte or uni)
{
REBSER *src = va_arg(args, REBSER*);
Insert_String(series, SERIES_TAIL(series), src, 0, SERIES_TAIL(src), 0);
}
break;
case 'I': // Integer
Append_Int(series, va_arg(args, REBINT));
break;
case 'i':
Append_Int_Pad(series, va_arg(args, REBINT), -9);
Trim_Tail(mold->series, '0');
break;
case '2': // 2 digit int (for time)
Append_Int_Pad(series, va_arg(args, REBINT), 2);
break;
case 'T': // Type name
Append_UTF8(series, Get_Type_Name(va_arg(args, REBVAL*)), -1);
break;
case 'N': // Symbol name
Append_UTF8(series, Get_Sym_Name(va_arg(args, REBCNT)), -1);
break;
case '+': // Add #[ if mold/all
if (GET_MOPT(mold, MOPT_MOLD_ALL)) {
Append_Bytes(series, "#[");
ender = ']';
}
break;
case 'D': // Datatype symbol: #[type
if (ender) {
Append_UTF8(series, Get_Sym_Name(va_arg(args, REBCNT)), -1);
Append_Byte(series, ' ');
} else va_arg(args, REBCNT); // ignore it
break;
case 'B': // Boot string
Append_Boot_Str(series, va_arg(args, REBINT));
break;
default:
Append_Byte(series, *fmt);
}
}
va_end(args);
if (ender) Append_Byte(series, ender);
return series;
}
STOID Mold_Block(REBVAL *value, REB_MOLD *mold)
{
REBYTE *sep;
REBOOL all = GET_MOPT(mold, MOPT_MOLD_ALL);
REBSER *series = mold->series;
REBFLG over = FALSE;
if (SERIES_WIDE(VAL_SERIES(value)) == 0)
Crash(RP_BAD_WIDTH, sizeof(REBVAL), 0, VAL_TYPE(value));
// Optimize when no index needed:
if (VAL_INDEX(value) == 0 && !IS_MAP(value)) // && (VAL_TYPE(value) <= REB_LIT_PATH))
all = FALSE;
// If out of range, do not cause error to avoid error looping.
if (VAL_INDEX(value) >= VAL_TAIL(value)) over = TRUE; // Force it into []
if (all || (over && !IS_BLOCK(value) && !IS_PAREN(value))) {
SET_FLAG(mold->opts, MOPT_MOLD_ALL);
Pre_Mold(value, mold); // #[block! part
//if (over) Append_Bytes(mold->series, "[]");
//else
Mold_Block_Series(mold, VAL_SERIES(value), 0, 0);
Post_Mold(value, mold);
}
else
{
switch(VAL_TYPE(value)) {
case REB_MAP:
Pre_Mold(value, mold);
sep = 0;
case REB_BLOCK:
if (GET_MOPT(mold, MOPT_ONLY)) {
CLR_FLAG(mold->opts, MOPT_ONLY); // only top level
sep = "\000\000";
}
else sep = 0;
break;
case REB_PAREN:
sep = "()";
break;
case REB_GET_PATH:
series = Append_Byte(series, ':');
sep = "/";
break;
case REB_LIT_PATH:
series = Append_Byte(series, '\'');
/* fall through */
case REB_PATH:
case REB_SET_PATH:
sep = "/";
break;
}
if (over) Append_Bytes(mold->series, sep ? sep : (REBYTE*)("[]"));
else Mold_Block_Series(mold, VAL_SERIES(value), VAL_INDEX(value), sep);
if (VAL_TYPE(value) == REB_SET_PATH)
Append_Byte(series, ':');
}
}
STOID Mold_String_Series(REBVAL *value, REB_MOLD *mold)
{
REBCNT len = VAL_LEN(value);
REBSER *ser = VAL_SERIES(value);
REBCNT idx = VAL_INDEX(value);
REB_STRF sf = {0};
REBYTE *bp;
REBUNI *up;
REBUNI *dp;
REBOOL uni = !BYTE_SIZE(ser);
REBCNT n;
REBUNI c;
// Empty string:
if (idx >= VAL_TAIL(value)) {
Append_Bytes(mold->series, "\"\""); //Trap0(RE_PAST_END);
return;
}
Sniff_String(ser, idx, &sf);
if (!GET_MOPT(mold, MOPT_ANSI_ONLY)) sf.paren = 0;
// Source can be 8 or 16 bits:
if (uni) up = UNI_HEAD(ser);
else bp = STR_HEAD(ser);
// If it is a short quoted string, emit it as "string":
if (len <= MAX_QUOTED_STR && sf.quote == 0 && sf.newline < 3) {
dp = Prep_Uni_Series(mold, len + sf.newline + sf.escape + sf.paren + sf.chr1e + 2);
*dp++ = '"';
for (n = idx; n < VAL_TAIL(value); n++) {
c = uni ? up[n] : (REBUNI)(bp[n]);
dp = Emit_Uni_Char(dp, c, (REBOOL)GET_MOPT(mold, MOPT_ANSI_ONLY)); // parened
}
*dp++ = '"';
*dp = 0;
return;
}
// It is a braced string, emit it as {string}:
if (!sf.malign) sf.brace_in = sf.brace_out = 0;
dp = Prep_Uni_Series(mold, len + sf.brace_in + sf.brace_out + sf.escape + sf.paren + sf.chr1e + 2);
*dp++ = '{';
for (n = idx; n < VAL_TAIL(value); n++) {
c = uni ? up[n] : (REBUNI)(bp[n]);
switch (c) {
case '{':
case '}':
if (sf.malign) {
*dp++ = '^';
*dp++ = c;
break;
}
case '\n':
case '"':
*dp++ = c;
break;
default:
dp = Emit_Uni_Char(dp, c, (REBOOL)GET_MOPT(mold, MOPT_ANSI_ONLY)); // parened
}
}
*dp++ = '}';
*dp = 0;
}
*/ 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);
}
*/ void Emit_Date(REB_MOLD *mold, const REBVAL *value_orig)
/*
***********************************************************************/
{
REBYTE buf[64];
REBYTE *bp = &buf[0];
REBINT tz;
REBYTE dash = GET_MOPT(mold, MOPT_SLASH_DATE) ? '/' : '-';
// We don't want to modify the incoming date value we are molding,
// so we make a copy that we can tweak during the emit process
REBVAL value_buffer = *value_orig;
REBVAL *value = &value_buffer;
if (
VAL_MONTH(value) == 0
|| VAL_MONTH(value) > 12
|| VAL_DAY(value) == 0
|| VAL_DAY(value) > 31
) {
Append_Unencoded(mold->series, "?date?");
return;
}
if (VAL_TIME(value) != NO_TIME) Adjust_Date_Zone(value, FALSE);
// Punctuation[GET_MOPT(mold, MOPT_COMMA_PT) ? PUNCT_COMMA : PUNCT_DOT]
bp = Form_Int(bp, (REBINT)VAL_DAY(value));
*bp++ = dash;
memcpy(bp, Month_Names[VAL_MONTH(value)-1], 3);
bp += 3;
*bp++ = dash;
bp = Form_Int_Pad(bp, (REBINT)VAL_YEAR(value), 6, -4, '0');
*bp = 0;
Append_Unencoded(mold->series, s_cast(buf));
if (VAL_TIME(value) != NO_TIME) {
Append_Byte(mold->series, '/');
Emit_Time(mold, value);
if (VAL_ZONE(value) != 0) {
bp = &buf[0];
tz = VAL_ZONE(value);
if (tz < 0) {
*bp++ = '-';
tz = -tz;
}
else
*bp++ = '+';
bp = Form_Int(bp, tz/4);
*bp++ = ':';
bp = Form_Int_Pad(bp, (tz&3) * 15, 2, 2, '0');
*bp = 0;
Append_Unencoded(mold->series, s_cast(buf));
}
}
}
//
// Mold_Vector: C
//
void Mold_Vector(const REBVAL *value, REB_MOLD *mold, REBOOL molded)
{
REBSER *vect = VAL_SERIES(value);
REBYTE *data = SER_DATA_RAW(vect);
REBCNT bits = VECT_TYPE(vect);
// REBCNT dims = vect->size >> 8;
REBCNT len;
REBCNT n;
REBCNT c;
union {REBU64 i; REBDEC d;} v;
REBYTE buf[32];
REBYTE l;
if (GET_MOPT(mold, MOPT_MOLD_ALL)) {
len = VAL_LEN_HEAD(value);
n = 0;
} else {
len = VAL_LEN_AT(value);
n = VAL_INDEX(value);
}
if (molded) {
enum Reb_Kind kind = (bits >= VTSF08) ? REB_DECIMAL : REB_INTEGER;
Pre_Mold(value, mold);
if (!GET_MOPT(mold, MOPT_MOLD_ALL))
Append_Codepoint_Raw(mold->series, '[');
if (bits >= VTUI08 && bits <= VTUI64)
Append_Unencoded(mold->series, "unsigned ");
Emit(
mold,
"N I I [",
Canon(SYM_FROM_KIND(kind)),
bit_sizes[bits & 3],
len
);
if (len)
New_Indented_Line(mold);
}
c = 0;
for (; n < SER_LEN(vect); n++) {
v.i = get_vect(bits, data, n);
if (bits < VTSF08) {
l = Emit_Integer(buf, v.i);
} else {
l = Emit_Decimal(buf, v.d, 0, '.', mold->digits);
}
Append_Unencoded_Len(mold->series, s_cast(buf), l);
if ((++c > 7) && (n + 1 < SER_LEN(vect))) {
New_Indented_Line(mold);
c = 0;
}
else
Append_Codepoint_Raw(mold->series, ' ');
}
if (len) {
//
// remove final space (overwritten with terminator)
//
TERM_UNI_LEN(mold->series, UNI_LEN(mold->series) - 1);
}
if (molded) {
if (len) New_Indented_Line(mold);
Append_Codepoint_Raw(mold->series, ']');
if (!GET_MOPT(mold, MOPT_MOLD_ALL)) {
Append_Codepoint_Raw(mold->series, ']');
}
else {
Post_Mold(value, mold);
}
}
}