Skip to content

Commit

Permalink
FEAT: implemented collect set parse's command
Browse files Browse the repository at this point in the history 
related to: Oldes/Rebol-issues#2471
  • Loading branch information
@Oldes
Oldes committed Jul 23, 2022
1 parent 8d3e132 commit 9d919b6
Show file tree
Hide file tree
Showing 2 changed files with 75 additions and 28 deletions.
58 changes: 41 additions & 17 deletions src/core/u-parse.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -23,7 +23,7 @@
** Module: u-parse.c
** Summary: parse dialect interpreter
** Section: utility
** Author: Carl Sassenrath
** Author: Carl Sassenrath, Oldes
** Notes:
**
***********************************************************************/
Expand All @@ -41,6 +41,7 @@ typedef struct reb_parse_collect {
REBVAL *result;
REBSER *block;
REBINT depth;
REBFLG flags;
} REB_PARSE_COLLECT;

typedef struct reb_parse {
Expand Down Expand Up @@ -70,6 +71,10 @@ enum parse_flags {
PF_PICK,
};

enum collect_flags {
CF_ROOT_SET, // that the root collect block was SET to a word, so return parse's result (logic) instead
};

#define MAX_PARSE_DEPTH 512

// Returns SYMBOL or 0 if not a command:
Expand Down Expand Up @@ -777,6 +782,7 @@ void Print_Parse_Index(REBCNT type, REBVAL *rules, REBSER *series, REBCNT index)
REBFLG flags;
REBCNT cmd;
REBSER *blk;
REB_PARSE_COLLECT *collect = parse->collect;
//REBVAL *rule_head = rules;

CHECK_STACK(&flags);
Expand Down Expand Up @@ -870,26 +876,46 @@ void Print_Parse_Index(REBCNT type, REBVAL *rules, REBSER *series, REBCNT index)
case SYM_COLLECT:
if (IS_END(rules))
Trap1(RE_PARSE_END, rules - 1);
//printf("COLLECT start %i\n", parse->collect->depth);
//printf("COLLECT start %i\n", collect->depth);
// reserve a new value on stack
DS_PUSH_NONE;
if (parse->collect->block == NULL) {

if (collect->block == NULL) {
// --- FIRST collect -------------------------
// allocate the resulting block on the stack, so it is GC safe
Set_Series(REB_BLOCK, DS_TOP, Make_Block(2));
parse->collect->result = DS_TOP;
parse->collect->block = VAL_SERIES(DS_TOP);
collect->result = DS_TOP;
collect->block = VAL_SERIES(DS_TOP);
} else {
// --- SUBSEQUENT collect ---------------------
// store current block on stack
Set_Series(REB_BLOCK, DS_TOP, parse->collect->block);
Set_Series(REB_BLOCK, DS_TOP, collect->block);
// do not allocate a new one, until it is needed, else
// there could be unwanted empty blocks like in case:
// parse [1][collect some [collect keep integer!]]
parse->collect->block = NULL;
collect->block = NULL;
}
SET_FLAG(flags, PF_COLLECT);
parse->collect->depth++;

if (IS_WORD(rules) && VAL_SYM_CANON(rules) == SYM_SET) {
rules++;
if (!(IS_WORD(rules) || IS_SET_WORD(rules)))
Trap1(RE_PARSE_VARIABLE, rules);
if (collect->block == NULL) {
// the block was not allocated yet, but we need it now!
val = Append_Value(VAL_SERIES(DS_TOP));
Set_Series(REB_BLOCK, val, Make_Block(2));
// and mark it for use
collect->block = VAL_SERIES(val);
}
if (collect->depth == 0) {
SET_FLAG(collect->flags, CF_ROOT_SET);
}

Set_Var_Series(rules, REB_BLOCK, collect->block, 0);
rules++;
}
collect->depth++;
continue;

case SYM_KEEP:
Expand Down Expand Up @@ -1086,7 +1112,7 @@ void Print_Parse_Index(REBCNT type, REBVAL *rules, REBSER *series, REBCNT index)
val = BLK_SKIP(series, index);
i = (
(ANY_BINSTR(val) || ANY_BLOCK(val))
&& (Parse_Series(val, VAL_BLK_DATA(item), parse->flags, depth+1, &parse->collect) == VAL_TAIL(val))
&& (Parse_Series(val, VAL_BLK_DATA(item), parse->flags, depth+1, &collect) == VAL_TAIL(val))
) ? index+1 : NOT_FOUND;
break;
#ifdef USE_DO_PARSE_RULE
Expand Down Expand Up @@ -1216,7 +1242,7 @@ void Print_Parse_Index(REBCNT type, REBVAL *rules, REBSER *series, REBCNT index)
}
if (GET_FLAG(flags, PF_KEEP)) {
if (ser && GET_FLAG(flags, PF_COPY)) {
val = Append_Value(parse->collect->block);
val = Append_Value(collect->block);
if (IS_BLOCK_INPUT(parse)) {
Set_Block(val, ser);
}
Expand All @@ -1238,9 +1264,9 @@ void Print_Parse_Index(REBCNT type, REBVAL *rules, REBSER *series, REBCNT index)
// COLLECT ends
// get the previous target block from the stack and use it
val = DS_POP;
parse->collect->block = VAL_SERIES(val);
parse->collect->depth--;
//printf("COLLECT done %i\n", parse->collect->depth);
collect->block = VAL_SERIES(val);
collect->depth--;
//printf("COLLECT done %i\n", collect->depth);
}

if (GET_FLAG(flags, PF_RETURN)) {
Expand Down Expand Up @@ -1512,12 +1538,10 @@ void Print_Parse_Index(REBCNT type, REBVAL *rules, REBSER *series, REBCNT index)
Throw_Error(VAL_ERR_OBJECT(DS_RETURN));
}
SET_STATE(state, Saved_State);
collect.depth = 0;
collect.result = NULL;
collect.block = NULL;
CLEARS(&collect);

n = Parse_Series(val, VAL_BLK_DATA(arg), (opts & PF_CASE) ? AM_FIND_CASE : 0, 0, &collect);
if (collect.result) {
if (collect.result && !GET_FLAG(collect.flags, CF_ROOT_SET)) {
*D_RET = *collect.result;
}
else {
Expand Down
45 changes: 34 additions & 11 deletions src/tests/units/parse-test.r3
View file
Original file line number Diff line number Diff line change
Expand Up @@ -194,11 +194,23 @@ Rebol [
--assert [3] = parse [1][collect [integer! keep (1 + 2)]]
--assert [3 "A"] = parse [1][collect [integer! keep (1 + 2) keep ("A")]]

--test-- "block collect set (Red specific)"
;@@ Not yet implemented!
;- Sets a given word to a block of collected values.
; a: none --assert all [parse [] [collect set a []] a = []]
; a: none --assert all [parse [1] [collect set a [keep skip]] a = [1]]
--test-- "block collect set"
a: none --assert all [#[true] = parse [ ] [collect set a []] a = []]
a: none --assert all [#[true] = parse [1] [collect set a [keep skip]] a = [1]]
a: none --assert all [#[false] = parse [1 2] [collect set a [keep skip]] a = [1]]
a: none --assert all [
[[1]] = parse [1] [collect [collect set a keep skip]]
a = [1]
]
a: none --assert all [
#[true] = parse [1] [collect set a [collect set a keep skip]]
a = [1]
]
a: b: none --assert all [
#[true] = parse [1] [collect set a [collect set b keep skip]]
a = [[1]]
b = [1]
]

--test-- "block collect into"
;@@ Not yet implemented!
Expand Down Expand Up @@ -257,12 +269,23 @@ Rebol [
--assert [#{0102}] = parse #{0102} [collect [keep 2 skip]]
--assert [1 2] = parse #{0102} [collect [keep pick 2 skip]]

--test-- "string collect set (Red specific)"
;@@ Not yet implemented!
;- Sets a given word to a block of collected values.
; a: none --assert all [parse "" [collect set a []] a = []]
; a: none --assert all [parse "1" [collect set a [keep skip]] a = [#"1"]]

--test-- "string collect set"
a: none --assert all [#[true] = parse "" [collect set a []] a = []]
a: none --assert all [#[true] = parse "1" [collect set a [keep skip]] a = [#"1"]]
a: none --assert all [#[false] = parse "12" [collect set a [keep skip]] a = [#"1"]]
a: none --assert all [
[[#"1"]] = parse "1" [collect [collect set a keep skip]]
a = [#"1"]
]
a: none --assert all [
#[true] = parse "1" [collect set a [collect set a keep skip]]
a = [#"1"]
]
a: b: none --assert all [
#[true] = parse "1" [collect set a [collect set b keep skip]]
a = [[#"1"]]
b = [#"1"]
]
--test-- "string collect into"
;@@ Not yet implemented!
;- Inserts collected values into a series referred by a word, resets series' index to the head.
Expand Down

0 comments on commit 9d919b6

Please sign in to comment.