FEAT: COLLECT-WORDS /as type [datatype!] option

resolves: Oldes/Rebol-issues#724

Author: Oldes

src/boot/natives.reb

@@ -372,14 +372,7 @@ context?: native [ ; was originally named `bound?`
 	;return: [object! function! none!]
 ]
 
-collect-words: native [
-	"Collect unique words used in a block (used for context construction)."
-	block [block!]
-	/deep "Include nested blocks"
-	/set "Only include set-words"
-	/ignore "Ignore prior words"
-	words [any-object! block! none!] "Words to ignore"
-]
+;collect-words: native [] ;defined in %n-data.c
 
 ;checksum:   native [] ; defined in %n-string.c
 ;compress:   native [] ; defined in %n-string.c

src/core/c-frame.c

@@ -3,6 +3,7 @@
 **  REBOL [R3] Language Interpreter and Run-time Environment
 **
 **  Copyright 2012 REBOL Technologies
+**  Copyright 2012-2021 Rebol Open Source Developers
 **  REBOL is a trademark of REBOL Technologies
 **
 **  Licensed under the Apache License, Version 2.0 (the "License");
@@ -365,7 +366,7 @@
 
 /***********************************************************************
 **
-*/  void Collect_Simple_Words(REBVAL *block, REBCNT modes)
+*/  void Collect_Simple_Words(REBVAL *block, REBCNT modes, REBINT type)
 /*
 **		Used for Collect_Block_Words().
 **
@@ -381,17 +382,20 @@
 		) {
 			binds[VAL_WORD_CANON(block)] = 1;
 			val = Append_Value(BUF_WORDS);
-			Init_Word(val, VAL_WORD_SYM(block));
+			VAL_SET(val, type);
+			VAL_WORD_INDEX(val) = 0;
+			VAL_WORD_FRAME(val) = 0;
+			VAL_WORD_SYM(val) = VAL_WORD_SYM(block);
 		}
 		else if (ANY_EVAL_BLOCK(block) && (modes & BIND_DEEP))
-			Collect_Simple_Words(VAL_BLK_DATA(block), modes);
+			Collect_Simple_Words(VAL_BLK_DATA(block), modes, type);
 	}
 }
 
 
 /***********************************************************************
 **
-*/  REBSER *Collect_Block_Words(REBVAL *block, REBVAL *prior, REBCNT modes)
+*/  REBSER *Collect_Block_Words(REBVAL *block, REBVAL *prior, REBCNT modes, REBINT type)
 /*
 **		Collect words from a prior block and new block.
 **
@@ -405,10 +409,10 @@
 	if (SERIES_TAIL(BUF_WORDS)) Crash(RP_WORD_LIST); // still in use
 
 	if (prior)
-		Collect_Simple_Words(prior, BIND_ALL);
+		Collect_Simple_Words(prior, BIND_ALL, type);
 
 	start = SERIES_TAIL(BUF_WORDS);
-	Collect_Simple_Words(block, modes);
+	Collect_Simple_Words(block, modes, type);
 
 	// Reset word markers:
 	for (block = BLK_HEAD(BUF_WORDS); NOT_END(block); block++)

src/core/n-data.c

@@ -3,6 +3,7 @@
 **  REBOL [R3] Language Interpreter and Run-time Environment
 **
 **  Copyright 2012 REBOL Technologies
+**  Copyright 2012-2021 Rebol Open Source Developers
 **  REBOL is a trademark of REBOL Technologies
 **
 **  Licensed under the Apache License, Version 2.0 (the "License");
@@ -383,19 +384,24 @@ static int Check_Char_Range(REBVAL *val, REBINT limit)
 **
 */	REBNATIVE(collect_words)
 /*
-**		1 block
-**		3 /deep
-**		4 /set
-**      4 /ignore
-**      5 object | block
-**
+//	collect-words: native [
+//		"Collect unique words used in a block (used for context construction)."
+//		block [block!]
+//		/deep    "Include nested blocks"
+//		/set     "Only include set-words"
+//		/ignore  "Ignore prior words"
+//		 words [any-object! block! none!] "Words to ignore"
+//		/as   "Datatype of the words in the returned block"
+//		 type [datatype!] "Any word type"
+//	]
 ***********************************************************************/
 {
 	REBSER *words;
 	REBCNT modes = 0;
 	REBVAL *prior = 0;
 	REBVAL *block;
 	REBVAL *obj;
+	REBINT type;
 
 	block = VAL_BLK_DATA(D_ARG(1));
 
@@ -411,8 +417,11 @@ static int Check_Char_Range(REBVAL *val, REBINT limit)
 			prior = VAL_BLK_DATA(obj);
 		// else stays 0
 	}
+	type = D_REF(6) ? VAL_DATATYPE(D_ARG(7)) : REB_WORD;
+	if (type < REB_WORD || type > REB_ISSUE)
+		Trap1(RE_BAD_FUNC_ARG, D_ARG(7));
 
-	words = Collect_Block_Words(block, prior, modes);
+	words = Collect_Block_Words(block, prior, modes, type);
 	Set_Block(D_RET, words);
 	return R_RET;
 }

src/tests/units/func-test.r3

@@ -204,6 +204,14 @@ Rebol [
 		--assert [a c] = collect-words/ignore blk none
 		--assert [a] = collect-words/ignore blk [c]
 		--assert [c] = collect-words/ignore blk object [a: 1]
+	--test-- "collect-words/as"
+	;@@ https://github.com/Oldes/Rebol-issues/issues/724
+		--assert [:a :c] = collect-words/as blk get-word!
+		--assert [a: c:] = collect-words/as blk set-word!
+		--assert ['a 'c] = collect-words/as blk lit-word!
+		--assert [/a /c] = collect-words/as blk refinement!
+		--assert [#a #c] = collect-words/as blk issue!
+		--assert all [error? e: try [collect-words/as blk string!] e/id = 'bad-func-arg]
 ===end-group===