TESTS: added PARSE's BREAK tests.

TESTS: added PARSE's BREAK tests.

Red [
	Title:	"Red PARSE test script"
	Author:	"Nenad Rakocevic"
	File:	%parse-test.reds
	Tabs:	4
	Rights:	"Copyright (C) 2011-2013 Nenad Rakocevic & Peter W A Wood. All rights reserved."
	License: "BSD-3 - https://github.com/dockimbel/Red/blob/origin/BSD-3-License.txt"
]

#include  %../../../../quick-test/quick-test.red

~~~start-file~~~ "parse"

===start-group=== "block"

	--test-- "blk-1" 	--assert parse 		[]			[]
	--test-- "blk-2" 	--assert parse 		[a]			['a]
	--test-- "blk-3" 	--assert not parse	[a]			['b]
	--test-- "blk-4" 	--assert parse 		[a b]		['a 'b]
	--test-- "blk-5" 	--assert parse 		[a #"b"]	['a #"b"]
	--test-- "blk-6" 	--assert parse 		[a]			[['a]]
	--test-- "blk-7" 	--assert parse 		[a b]		[['a] 'b]
	--test-- "blk-8" 	--assert parse 		[a b]		['a ['b]]
	--test-- "blk-9" 	--assert parse 		[a b]		[['a]['b]]
	--test-- "blk-10"	--assert parse 		["hello"]	["hello"]

	--test-- "blk-11"	--assert parse 		[#"a"] 		[#"b" | #"a"]
	--test-- "blk-12"	--assert not parse	[a b]		['b | 'a]
	--test-- "blk-13"	--assert parse 		[#"a"]		[[#"b" | #"a"]]
	--test-- "blk-14"	--assert not parse	[a b]		[['b | 'a]]
	--test-- "blk-15"	--assert parse 		[a b]		[['a | 'b]['b | 'a]]

	--test-- "blk-16"	--assert parse		[a 123]		['a integer!]
	--test-- "blk-17"	--assert not parse	[a 123]		['a char!]
	--test-- "blk-18"	--assert parse		[a 123]		[['a][integer!]]
	--test-- "blk-19"	--assert not parse	[a 123]		['a [char!]]

	--test-- "blk-20"
		res: 0
	--assert parse [] [(res: 1)]
	--assert res = 1

	--test-- "blk-21"
		res: 0
		--assert parse [a] ['a (res: 1)]
		--assert res = 1

	--test-- "blk-22"
		res: 0
		--assert not parse [a] ['b (res: 1)]
		--assert res = 0

	--test-- "blk-23"
		res: 0
		--assert parse [] [[(res: 1)]]
		--assert res = 1

	--test-- "blk-24"
		res: 0
		--assert parse [a] [['a (res: 1)]]
		--assert res = 1

	--test-- "blk-25"
		res: 0
		--assert not parse [a] [['b (res: 1)]]
		--assert res = 0

	--test-- "blk-26"
		res: 0
		--assert parse [a 123] ['a (res: 1) [char! (res: 2) | integer! (res: 3)]]
		--assert res = 3

	--test-- "blk-27"
		res: 0
		--assert not parse [a 123] ['a (res: 1) [char! (res: 2) | string! (res: 3)]]
		--assert res = 1

	--test-- "blk-28"	--assert not parse		[a a]		[1 ['a]]
	--test-- "blk-29"	--assert parse			[a a]		[2 ['a]]
	--test-- "blk-30"	--assert not parse		[a a]		[3 ['a]]
	--test-- "blk-31"	--assert not parse		[a a]		[1 1 ['a]]
	--test-- "blk-32"	--assert parse			[a a]		[1 2 ['a]]
	--test-- "blk-33"	--assert parse			[a a]		[2 2 ['a]]
	--test-- "blk-34"	--assert parse			[a a]		[2 3 ['a]]
	--test-- "blk-35"	--assert not parse		[a a]		[3 4 ['a]]

	--test-- "blk-36"	--assert not parse		[a a]		[1 'a]
	--test-- "blk-37"	--assert parse			[a a]		[2 'a]
	--test-- "blk-38"	--assert not parse		[a a]		[3 'a]
	--test-- "blk-39"	--assert not parse		[a a]		[1 1 'a]
	--test-- "blk-40"	--assert parse			[a a]		[1 2 'a]
	--test-- "blk-41"	--assert parse			[a a]		[2 2 'a]
	--test-- "blk-42"	--assert parse			[a a]		[2 3 'a]
	--test-- "blk-43"	--assert not parse		[a a]		[3 4 'a]

	--test-- "blk-44"	--assert not parse		[a a]		[1 skip]
	--test-- "blk-45"	--assert parse			[a a]		[2 skip]
	--test-- "blk-46"	--assert not parse		[a a]		[3 skip]
	--test-- "blk-47"	--assert not parse		[a a]		[1 1 skip]
	--test-- "blk-48"	--assert parse			[a a]		[1 2 skip]
	--test-- "blk-49"	--assert parse			[a a]		[2 2 skip]
	--test-- "blk-50"	--assert parse			[a a]		[2 3 skip]
	--test-- "blk-51"	--assert not parse		[a a]		[3 4 skip]

	--test-- "blk-52"	--assert parse			[a]			[skip]
	--test-- "blk-53"	--assert parse			[a b]		[skip skip]
	--test-- "blk-54"	--assert parse			[a b]		[skip [skip]]
	--test-- "blk-55"	--assert parse			[a b]		[[skip] [skip]]

	--test-- "blk-56"	--assert parse			[a a]		[some ['a]]
	--test-- "blk-57"	--assert not parse		[a a]		[some ['a] 'b]

	--test-- "blk-58"	--assert parse			[a a b a b b b a]	[some [skip]]
	--test-- "blk-59"	--assert parse			[a a b a b b b a]	[some ['a | 'b]]
	--test-- "blk-60"	--assert not parse 		[a a b a b b b a]	[some ['a | 'c]]

	--test-- "blk-61"	--assert parse 			[a a]		[any ['a]]
	--test-- "blk-62"	--assert parse			[a a]		[some ['a] any ['b]]
	--test-- "blk-63"	--assert parse			[a a b b]	[2 'a 2 'b]
	--test-- "blk-64"	--assert not parse		[a a b b]	[2 'a 3 'b]
	--test-- "blk-65"	--assert parse			[a a b b]	[some 'a some 'b]
	--test-- "blk-66"	--assert not parse		[a a b b]	[some 'a some 'c]

	--test-- "blk-67"
		p: none
		--assert parse [] [p:]
		--assert tail? p

	--test-- "blk-68"
		p: none
		--assert parse [] [[[p:]]]
		--assert tail? p

	--test-- "blk-69"
		p: none
		--assert parse [a] [p: 'a]
		--assert p = [a]

	--test-- "blk-70"
		p: none
		--assert parse [a] ['a p:]
		--assert tail? p

	--test-- "blk-71"
		p: none
		--assert parse [a] ['a [p:]]
		--assert tail? p

	--test-- "blk-72"
		p: none
		--assert not parse [a b] ['a p:]
		--assert p = [b]

	--test-- "blk-72"
		p: none
		--assert parse [a b] ['a [p:]['b | 'c]]
		--assert p = [b]

	--test-- "blk-73"
		p: none
		--assert parse [a a a b b] [3 'a p: 2 'b :p [2 'b]]
		--assert p = [b b]

	--test-- "blk-74"
	--assert parse [b a a a c][skip some ['a] 'c]

===end-group===

===start-group=== "block-end"

	--test-- "blk-end-1" --assert parse 		[a] 	['a end]
	--test-- "blk-end-2" --assert not parse 	[a b] 	['a end]
	--test-- "blk-end-3" --assert parse 		[a] 	[skip end]
	--test-- "blk-end-4" --assert not parse 	[a b]	[skip end]
	--test-- "blk-end-5" --assert parse 		[]		[end]

	--test-- "blk-end-6"
		be6: 0
		--assert parse [] [end (be6: 1)]
		--assert be6 = 1

===end-group===

===start-group=== "block-words"

	wa: ['a]
	wb: ['b]
	wca: #"a"
	wcb: #"b"
	wra: [wa]
	wrb: [wb]
	wh: "hello"
	wrab: ['a | 'b]
	wrba: ['b | 'a]

	--test-- "blk-w1" 	--assert parse 		[a]			[wa]
	--test-- "blk-w2" 	--assert not parse 	[a]			[wb]
	--test-- "blk-w3" 	--assert parse 		[a b]		[wa wb]
	--test-- "blk-w4" 	--assert parse 		[a #"b"]	[wa wcb]
	--test-- "blk-w5" 	--assert parse 		[a]			[wra]
	--test-- "blk-w6" 	--assert parse 		[a b]		[wra 'b]
	--test-- "blk-w7" 	--assert parse 		[a b]		['a wrb]
	--test-- "blk-w8" 	--assert parse 		[a b]		[wra wrb]
	--test-- "blk-w9" 	--assert parse 		["hello"]	[wh]

	--test-- "blk-w10"	--assert parse 		[#"a"] 		[wcb | wca]
	--test-- "blk-w11"	--assert not parse 	[a b]		[wb | wa]
	--test-- "blk-w12"	--assert parse 		[#"a"]		[[wcb | wca]]
	--test-- "blk-w13"	--assert not parse 	[a b]		[wrba]
	--test-- "blk-w14"	--assert parse 		[a b]		[wrab wrba]

	--test-- "blk-w15"	--assert parse		[a 123]		[wa integer!]
	--test-- "blk-w16"	--assert not parse	[a 123]		[wa char!]
	--test-- "blk-w17"	--assert parse		[a 123]		[wra [integer!]]
	--test-- "blk-w18"	--assert not parse	[a 123]		[wa  [char!]]

	--test-- "blk-w19"
		res: 0
		--assert parse [a] [wa (res: 1)]
		--assert res = 1

	--test-- "blk-w20"
		res: 0
		--assert not parse [a] [wb (res: 1)]
		--assert res = 0

	--test-- "blk-w21"
		res: 0
		wres: [(res: 1)]
		--assert parse [] [wres]
		--assert res = 1

	--test-- "blk-w22"
		res: 0
		wres: ['a (res: 1)]
		--assert parse [a] [wres]
		--assert res = 1

	--test-- "blk-w23"
		res: 0
		wres: ['b (res: 1)]
		--assert not parse [a] [wres]
		--assert res = 0

	--test-- "blk-w24"
		res: 0
		wres: [char! (res: 2) | integer! (res: 3)]
		--assert parse [a 123] [wa (res: 1) wres]
		--assert res = 3

	--test-- "blk-w25"
		res: 0
		wres: [char! (res: 2) | string! (res: 3)]
		--assert not parse [a 123] [wa (res: 1) wres]
		--assert res = 1

===end-group===

===start-group=== "block-extraction"

	wa: ['a]
	--test-- "blk-ext1"
		res: 0
		--assert parse [a][copy res skip]
		--assert res = [a]

	--test-- "blk-ext2"
		res: 0
		--assert parse [a][copy res 'a]
		--assert res = [a]

	--test-- "blk-ext3"
		res: 0
		--assert parse [a][copy res word!]
		--assert res = [a]

	--test-- "blk-ext4"
		res:  0
		res2: 0
		--assert parse [a][copy res copy res2 'a]
		--assert res  = [a]
		--assert res2 = [a]

	--test-- "blk-ext5"
		res: 0
		--assert parse [a a][copy res 2 'a]				;@@ a instead of 'a will crash!
		--assert res = [a a]

	--test-- "blk-ext6"
		res: 0
		--assert not parse [a a][copy res 3 'a]
		--assert res = 0

	--test-- "blk-ext7"
		res: 0
		--assert parse [a][copy res ['a]]
		--assert res = [a]

	--test-- "blk-ext8"
		res: 0
		--assert parse [a][copy res wa]
		--assert res = [a]

	--test-- "blk-ext9"
		res: 0
		--assert parse [a a][copy res 2 wa]
		--assert res = [a a]

	--test-- "blk-ext10"
		res: 0
		--assert parse [a a b][skip copy res 'a skip]
		--assert res = [a]

	--test-- "blk-ext11"
		res: 0
		--assert parse [a a b][skip copy res ['a | 'b] skip]
		--assert res = [a]

	--test-- "blk-ext12"
		res: 0
		--assert not parse [a][copy res ['c | 'b]]
		--assert res = 0

	--test-- "blk-ext13"
		res: 0
		--assert parse [a][set res skip]
		--assert res = 'a

	--test-- "blk-ext14"
		res: 0
		--assert parse [a][set res 'a]
		--assert res = 'a

	--test-- "blk-ext15"
		res: 0
		--assert parse [a][set res word!]
		--assert res = 'a

	--test-- "blk-ext16"
		res:  0
		res2: 0
		--assert parse [a][set res set res2 'a]
		--assert res  = 'a
		--assert res2 = 'a

	--test-- "blk-ext17"
		res: 0
		--assert parse [a a][set res 2 'a]				;@@ a instead of 'a will crash!
		--assert res = 'a

	--test-- "blk-ext18"
		res: 0
		--assert not parse [a a][set res 3 'a]
		--assert res = 0

	--test-- "blk-ext19"
		res: 0
		--assert parse [a][set res ['a]]
		--assert res = 'a

	--test-- "blk-ext20"
		res: 0
		--assert parse [a][set res wa]
		--assert res = 'a

	--test-- "blk-ext21"
		res: 0
		--assert parse [a a][set res 2 wa]
		--assert res = 'a

	--test-- "blk-ext22"
		res: 0
		--assert parse [a a b][skip set res 'a skip]
		--assert res = 'a

	--test-- "blk-ext23"
		res: 0
		--assert parse [a a b][skip set res ['a | 'b] skip]
		--assert res = 'a

	--test-- "blk-ext24"
		res: 0
		--assert not parse [a][set res ['c | 'b]]
		--assert res = 0

	--test-- "blk-ext25"
		res: 0
		--assert parse [b a a a c][skip set res some 'a 'c]
		--assert res = 'a

	--test-- "blk-ext26"
		res: 0
		--assert parse [b a a a c][skip set res some wa 'c]
		--assert res = 'a

===end-group===

===start-group=== "block-skipping"

	wa: ['a]

	--test-- "blk-sk1" 	--assert parse		[]			[to end]
	--test-- "blk-sk2" 	--assert parse		[]			[thru end]
	--test-- "blk-sk3" 	--assert parse		[a]			[to end]
	--test-- "blk-sk4" 	--assert not parse	[a]			[to 'a]
	--test-- "blk-sk5" 	--assert not parse	[a]			[to 'a end]
	--test-- "blk-sk6" 	--assert parse		[a]			[to 'a skip]
	--test-- "blk-sk7" 	--assert parse		[a]			[thru 'a]
	--test-- "blk-sk8" 	--assert parse		[a]			[thru 'a end]
	--test-- "blk-sk9" 	--assert not parse	[a]			[thru 'a skip]
	--test-- "blk-sk10"	--assert parse		[a b]		[to 'b skip]
	--test-- "blk-sk11"	--assert parse		[a b]		[thru 'b]
	--test-- "blk-sk12"	--assert parse		[a a a b]	[to 'b skip]
	--test-- "blk-sk13"	--assert parse		[a a b a]	[skip to 'b 2 skip]

	--test-- "blk-sk14"	--assert not parse	[a]			[to ['a]]
	--test-- "blk-sk15"	--assert not parse	[a]			[to ['a] end]
	--test-- "blk-sk16"	--assert parse		[a]			[to ['a] skip]
	--test-- "blk-sk17"	--assert parse		[a]			[thru ['a]]
	--test-- "blk-sk18"	--assert parse		[a]			[thru ['a] end]
	--test-- "blk-sk19"	--assert not parse	[a]			[thru ['a] skip]
	--test-- "blk-sk20"	--assert parse		[a b]		[to ['b] skip]
	--test-- "blk-sk21"	--assert parse		[a b]		[thru ['b]]
	--test-- "blk-sk22"	--assert parse		[a a a b]	[to ['b] skip]
	--test-- "blk-sk23"	--assert parse		[a a b a]	[skip to ['b] 2 skip]

	--test-- "blk-sk24"	--assert parse		[z z a b c]	[to ['c | 'b | 'a] 3 skip]
	--test-- "blk-sk25"	--assert parse		[z z a b c]	[to ['a | 'b | 'c] 3 skip]

	--test-- "blk-sk26"	--assert parse		[z z a b c]	[thru ['c | 'b | 'a] 2 skip]
	--test-- "blk-sk27"	--assert parse		[z z a b c]	[thru ['a | 'b | 'c] 2 skip]

	--test-- "blk-sk28"	--assert parse		[b b a a c]	[thru 2 'a 'c]
	--test-- "blk-sk29"	--assert parse		[b b a a c]	[thru 2 'a 'c]
	--test-- "blk-sk30"	--assert parse		[b b a a c]	[thru [2 'a] 'c]
	--test-- "blk-sk31"	--assert parse		[b b a a c]	[thru some 'a 'c]
	--test-- "blk-sk32"	--assert parse		[b b a a c]	[thru [some 'a] 'c]
	--test-- "blk-sk33"	--assert parse		[b b a a c]	[thru [some 'x | 2 'a] 'c]
	--test-- "blk-sk34"	--assert parse		[b b a a c]	[thru 2 wa 'c]
	--test-- "blk-sk35"	--assert parse		[b b a a c]	[thru some wa 'c]

	--test-- "blk-sk36"	--assert parse 		[1 "hello"]	[thru "hello"]

	--test-- "blk-sk37"
		res: 0
		--assert parse [1 "hello" a 1 2 3 b] [thru "hello" skip copy res to 'b skip]
		--assert res = [1 2 3]

===end-group===

===start-group=== "block-misc"

	--test-- "blk-m1"	--assert parse 		[]			[break]
	--test-- "blk-m2"	--assert not parse 	[a]			[break]
	--test-- "blk-m3"	--assert parse 		[a]			[[break 'b] 'a]
	--test-- "blk-m4"	--assert parse 		[a]			[['b | break] 'a]
	--test-- "blk-m5"	--assert parse 		[a a]		[some ['b | break] 2 'a]
	--test-- "blk-m6"	--assert parse 		[a a]		[some ['b | [break]] 2 'a]
	--test-- "blk-m7"	--assert not parse 	[a a]		[some ['b | 2 ['c | break]] 2 'a]

===end-group===

===start-group=== "string"

	--test-- "str-1" 	--assert parse		""			[]
	--test-- "str-2" 	--assert parse		"a"			[#"a"]
	--test-- "str-3" 	--assert parse		"a"			["a"]
	--test-- "str-4" 	--assert not parse	"a"			[#"b"]
	--test-- "str-5" 	--assert parse		"ab"		[#"a" #"b"]
	--test-- "str-6" 	--assert parse		"ab"		["ab"]
	--test-- "str-7" 	--assert parse		"a"			[[#"a"]]
	--test-- "str-8" 	--assert parse		"ab"		[[#"a"] "b"]
	--test-- "str-9" 	--assert parse		"ab"		[#"a" [#"b"]]
	--test-- "str-10"	--assert parse		"ab"		[[#"a"][#"b"]]

	--test-- "str-11"	--assert parse		"a"			[#"b" | #"a"]
	--test-- "str-12"	--assert not parse	"ab"		[#"b" | "a"]
	--test-- "str-13"	--assert parse		"a"			[[#"b" | #"a"]]
	--test-- "str-14"	--assert not parse	"ab"		[[#"b" | "a"]]
	--test-- "str-15"	--assert parse		"ab"		[["a" | #"b"][#"b" | "a"]]

	;--test-- "str-16"	--assert parse		"123"		[integer!]

	--test-- "str-20"
		res: 0
		--assert parse "" [(res: 1)]
		--assert res = 1

	--test-- "str-21"
		res: 0
		--assert parse "a" [#"a" (res: 1)]
		--assert res = 1

	--test-- "str-22"
		res: 0
		--assert not parse "a" [#"b" (res: 1)]
		--assert res = 0

	--test-- "str-23"
		res: 0
		--assert parse "" [[(res: 1)]]
		--assert res = 1

	--test-- "str-24"
		res: 0
		--assert parse "a" [[#"a" (res: 1)]]
		--assert res = 1

	--test-- "str-25"
		res: 0
		--assert not parse "a" [[#"b" (res: 1)]]
		--assert res = 0

	--test-- "str-26"
		res: 0
		--assert parse "ab" [#"a" (res: 1) [#"c" (res: 2) | #"b" (res: 3)]]
		--assert res = 3

	--test-- "str-27"
		res: 0
		--assert not parse "ab" [#"a" (res: 1) [#"c" (res: 2) | #"d" (res: 3)]]
		--assert res = 1

	--test-- "str-28"	--assert not parse		"aa"		[1 [#"a"]]
	--test-- "str-29"	--assert parse			"aa"		[2 [#"a"]]
	--test-- "str-30"	--assert not parse		"aa"		[3 [#"a"]]
	--test-- "str-31"	--assert not parse		"aa"		[1 1 [#"a"]]
	--test-- "str-32"	--assert parse			"aa"		[1 2 [#"a"]]
	--test-- "str-33"	--assert parse			"aa"		[2 2 [#"a"]]
	--test-- "str-34"	--assert parse			"aa"		[2 3 [#"a"]]
	--test-- "str-35"	--assert not parse		"aa"		[3 4 [#"a"]]

	--test-- "str-36"	--assert not parse		"aa"		[1 #"a"]
	--test-- "str-37"	--assert parse			"aa"		[2 #"a"]
	--test-- "str-38"	--assert not parse		"aa"		[3 #"a"]
	--test-- "str-39"	--assert not parse		"aa"		[1 1 #"a"]
	--test-- "str-40"	--assert parse			"aa"		[1 2 #"a"]
	--test-- "str-41"	--assert parse			"aa"		[2 2 #"a"]
	--test-- "str-42"	--assert parse			"aa"		[2 3 #"a"]
	--test-- "str-43"	--assert not parse		"aa"		[3 4 #"a"]

	--test-- "str-44"	--assert not parse		"aa"		[1 skip]
	--test-- "str-45"	--assert parse			"aa"		[2 skip]
	--test-- "str-46"	--assert not parse		"aa"		[3 skip]
	--test-- "str-47"	--assert not parse		"aa"		[1 1 skip]
	--test-- "str-48"	--assert parse			"aa"		[1 2 skip]
	--test-- "str-49"	--assert parse			"aa"		[2 2 skip]
	--test-- "str-50"	--assert parse			"aa"		[2 3 skip]
	--test-- "str-51"	--assert not parse		"aa"		[3 4 skip]

	--test-- "str-52"	--assert parse			"a"			[skip]
	--test-- "str-53"	--assert parse			"ab"		[skip skip]
	--test-- "str-54"	--assert parse			"ab"		[skip [skip]]
	--test-- "str-55"	--assert parse			"ab"		[[skip] [skip]]

	--test-- "str-56"	--assert parse			"aa"		[some [#"a"]]
	--test-- "str-57"	--assert not parse		"aa"		[some [#"a"] #"b"]

	--test-- "str-58"	--assert parse			"aababbba"	[some [skip]]
	--test-- "str-59"	--assert parse			"aababbba"	[some ["a" | "b"]]
	--test-- "str-60"	--assert not parse		"aababbba"	[some ["a" | #"c"]]

	--test-- "str-61"	--assert parse			"aa"		[any [#"a"]]
	--test-- "str-62"	--assert parse			"aa"		[some [#"a"] any [#"b"]]
	--test-- "str-63"	--assert parse			"aabb"		[2 #"a" 2 "b"]
	--test-- "str-64"	--assert not parse		"aabb"		[2 "a" 3 #"b"]
	--test-- "str-65"	--assert parse			"aabb"		[some #"a" some "b"]
	--test-- "str-66"	--assert not parse		"aabb"		[some "a" some #"c"]

	--test-- "str-67"
		p: none
		--assert parse "" [p:]
		--assert tail? p

	--test-- "str-68"
		p: none
		--assert parse "" [[[p:]]]
		--assert tail? p

	--test-- "str-69"
		p: none
		--assert parse "a" [p: #"a"]
		--assert p = "a"

	--test-- "str-70"
		p: none
		--assert parse "a" [#"a" p:]
		--assert tail? p

	--test-- "str-71"
		p: none
		--assert parse "a" [#"a" [p:]]
		--assert tail? p

	--test-- "str-72"
		p: none
		--assert not parse "ab" [#"a" p:]
		--assert p = "b"

	--test-- "str-73"
		p: none
		--assert parse "ab" [#"a" [p:][#"b" | #"c"]]
		--assert p = "b"

	--test-- "str-74"
		p: none
		--assert parse "aaabb" [3 #"a" p: 2 #"b" :p [2 "b"]]
		--assert p = "bb"

	--test-- "str-75"
	--assert parse "baaac" [skip some [#"a"] #"c"]

===end-group===

===start-group=== "string-end"

	--test-- "str-end-1" --assert parse 		"a" 	[#"a" end]
	--test-- "str-end-2" --assert not parse 	"ab" 	[#"a" end]
	--test-- "str-end-3" --assert parse 		"a" 	[skip end]
	--test-- "str-end-4" --assert not parse 	"ab"	[skip end]
	--test-- "str-end-5" --assert parse 		""		[end]

	--test-- "str-end-6"
		be6: 0
		--assert parse "" [end (be6: 1)]
		--assert be6 = 1

===end-group===

===start-group=== "string-words"

	wa: [#"a"]
	wb: [#"b"]
	wca: #"a"
	wcb: #"b"
	wra: [wa]
	wrb: [wb]
	wh: "hello"
	wrab: [#"a" | #"b"]
	wrba: [#"b" | #"a"]

	--test-- "str-w1" 	--assert parse 		"a"			[wa]
	--test-- "str-w2" 	--assert not parse 	"a"			[wb]
	--test-- "str-w3" 	--assert parse 		"ab"		[wa wb]
	--test-- "str-w5" 	--assert parse 		"a"			[wra]
	--test-- "str-w6" 	--assert parse 		"ab"		[wra #"b"]
	--test-- "str-w7" 	--assert parse 		"ab"		[#"a" wrb]
	--test-- "str-w8" 	--assert parse 		"ab"		[wra wrb]
	--test-- "str-w9" 	--assert parse 		"hello"		[wh]

	--test-- "str-w10"	--assert parse 		"a" 		[wcb | wca]
	--test-- "str-w11"	--assert not parse 	"ab"		[wb | wa]
	--test-- "str-w12"	--assert parse 		"a"			[[wcb | wca]]
	--test-- "str-w13"	--assert not parse 	"ab"		[wrba]
	--test-- "str-w14"	--assert parse 		"ab"		[wrab wrba]

	--test-- "str-w19"
		res: 0
		--assert parse "a" [wa (res: 1)]
		--assert res = 1

	--test-- "str-w20"
		res: 0
		--assert not parse "a" [wb (res: 1)]
		--assert res = 0

	--test-- "str-w21"
		res: 0
		wres: [(res: 1)]
		--assert parse "" [wres]
		--assert res = 1

	--test-- "str-w22"
		res: 0
		wres: [#"a" (res: 1)]
		--assert parse "a" [wres]
		--assert res = 1

	--test-- "str-w23"
		res: 0
		wres: [#"b" (res: 1)]
		--assert not parse "a" [wres]
		--assert res = 0

===end-group===

===start-group=== "string-extraction"

	wa: [#"a"]
	--test-- "str-ext1"
		res: 0
		--assert parse "a" [copy res skip]
		--assert res = "a"

	--test-- "str-ext2"
		res: 0
		--assert parse "a" [copy res #"a"]
		--assert res = "a"

	--test-- "str-ext4"
		res:  0
		res2: 0
		--assert parse "a" [copy res copy res2 #"a"]
		--assert res  = "a"
		--assert res2 = "a"

	--test-- "str-ext5"
		res: 0
		--assert parse "aa" [copy res 2 #"a"]
		--assert res = "aa"

	--test-- "str-ext6"
		res: 0
		--assert not parse "aa" [copy res 3 #"a"]
		--assert res = 0

	--test-- "str-ext7"
		res: 0
		--assert parse "a" [copy res [#"a"]]
		--assert res = "a"

	--test-- "str-ext8"
		res: 0
		--assert parse "a" [copy res wa]
		--assert res = "a"

	--test-- "str-ext9"
		res: 0
		--assert parse "aa" [copy res 2 wa]
		--assert res = "aa"

	--test-- "str-ext10"
		res: 0
		--assert parse "aab" [skip copy res #"a" skip]
		--assert res = "a"

	--test-- "str-ext11"
		res: 0
		--assert parse "aab" [skip copy res [#"a" | #"b"] skip]
		--assert res = "a"

	--test-- "str-ext12"
		res: 0
		--assert not parse "a" [copy res [#"c" | #"b"]]
		--assert res = 0

	--test-- "str-ext13"
		res: 0
		--assert parse "a" [set res skip]
		--assert res = #"a"

	--test-- "str-ext14"
		res: 0
		--assert parse "a" [set res #"a"]
		--assert res = #"a"

	--test-- "str-ext16"
		res:  0
		res2: 0
		--assert parse "a" [set res set res2 #"a"]
		--assert res  = #"a"
		--assert res2 = #"a"

	--test-- "str-ext17"
		res: 0
		--assert parse "aa" [set res 2 #"a"]
		--assert res = #"a"

	--test-- "str-ext18"
		res: 0
		--assert not parse "aa" [set res 3 #"a"]
		--assert res = 0

	--test-- "str-ext19"
		res: 0
		--assert parse "a" [set res [#"a"]]
		--assert res = #"a"

	--test-- "str-ext20"
		res: 0
		--assert parse "a" [set res wa]
		--assert res = #"a"

	--test-- "str-ext21"
		res: 0
		--assert parse "aa" [set res 2 wa]
		--assert res = #"a"

	--test-- "str-ext22"
		res: 0
		--assert parse "aab" [skip set res #"a" skip]
		--assert res = #"a"

	--test-- "str-ext23"
		res: 0
		--assert parse "aab" [skip set res [#"a" | #"b"] skip]
		--assert res = #"a"

	--test-- "str-ext24"
		res: 0
		--assert not parse "a" [set res [#"c" | #"b"]]
		--assert res = 0

	--test-- "str-ext25"
		res: 0
		--assert parse "baaac" [skip set res some #"a" #"c"]
		--assert res = #"a"

	--test-- "str-ext26"
		res: 0
		--assert parse "baaac" [skip set res some wa #"c"]
		--assert res = #"a"

===end-group===

===start-group=== "string-skipping"

	str: "Lorem ipsum dolor sit amet."
	wa: [#"a"]

	--test-- "str-sk1" 	--assert parse		""			[to end]
	--test-- "str-sk2" 	--assert parse		""			[thru end]
	--test-- "str-sk3" 	--assert parse		"a"			[to end]
	--test-- "str-sk4" 	--assert not parse	"a"			[to #"a"]
	--test-- "str-sk5" 	--assert not parse	"a"			[to #"a" end]
	--test-- "str-sk6" 	--assert parse		"a"			[to #"a" skip]
	--test-- "str-sk7" 	--assert parse		"a"			[thru #"a"]
	--test-- "str-sk8" 	--assert parse		"a"			[thru #"a" end]
	--test-- "str-sk9" 	--assert not parse	"a"			[thru #"a"skip]
	--test-- "str-sk10"	--assert parse		"ab"		[to #"a" 2 skip]
	--test-- "str-sk11"	--assert parse		"ab"		[thru #"a" skip]
	--test-- "str-sk12"	--assert parse		"aaab"		[to #"a" to end]
	--test-- "str-sk13"	--assert parse		"aaba"		[skip thru #"a" 2 skip]

	--test-- "str-sk14"	--assert not parse	"a"			[to [#"a"]]
	--test-- "str-sk15"	--assert not parse	"a"			[to [#"a"] end]
	--test-- "str-sk16"	--assert parse		"a"			[to [#"a"] skip]
	--test-- "str-sk17"	--assert parse		"a"			[thru [#"a"]]
	--test-- "str-sk18"	--assert parse		"a"			[thru [#"a"] end]
	--test-- "str-sk19"	--assert not parse	"a"			[thru [#"a"] skip]
	--test-- "str-sk20"	--assert parse		"ab"		[to [#"a"] 2 skip]
	--test-- "str-sk21"	--assert parse		"ab"		[thru [#"a"] skip]
	--test-- "str-sk22"	--assert parse		"aaab"		[to [#"a"] to end]
	--test-- "str-sk23"	--assert parse		"aaba"		[skip thru [#"a"] 2 skip]

	--test-- "str-sk24"	--assert parse		"zzabc"		[to [#"c" | #"b" | #"a"] 3 skip]
	--test-- "str-sk25"	--assert parse		"zzabc"		[to [#"a" | #"b" | #"c"] 3 skip]

	--test-- "str-sk26"	--assert parse		"zzabc"		[thru [#"c" | #"b" | #"a"] 2 skip]
	--test-- "str-sk27"	--assert parse		"zzabc"		[thru [#"a" | #"b" | #"c"] 2 skip]
	--test-- "str-sk28"	--assert parse		"bbaaac"	[thru 3 #"a" #"c"]
	--test-- "str-sk29"	--assert parse		"bbaaac"	[thru 3 "a" "c"]
	--test-- "str-sk30"	--assert parse		"bbaaac"	[thru 3 wa #"c"]
	--test-- "str-sk31"	--assert parse		"bbaaac"	[thru [3 "a"] "c"]
	--test-- "str-sk32"	--assert parse		"bbaaac"	[thru some "a" "c"]
	--test-- "str-sk33"	--assert parse		"bbaaac"	[thru [some #"a"] "c"]
	--test-- "str-sk34"	--assert parse		"bbaaac"	[thru [some #"x" | "aaa"] "c"]

	--test-- "str-sk35"	--assert parse 		str 		[thru "amet" skip]

	--test-- "str-sk36"
		res: 0
		--assert parse str [thru "ipsum" skip copy res to #" " to end]
		--assert res = "dolor"

	--test-- "str-sk37"
		res: 0
		--assert parse str [thru #"p" res: to end]
		--assert 9 = index? res

===end-group===

===start-group=== "string-misc"

	--test-- "str-m1"	--assert parse 		""			[break]
	--test-- "str-m2"	--assert not parse 	"a"			[break]
	--test-- "str-m3"	--assert parse 		"a"			[[break #"b"] #"a"]
	--test-- "str-m4"	--assert parse 		"a"			[[#"b" | break] #"a"]
	--test-- "str-m5"	--assert parse 		"aa"		[some [#"b" | break] 2 #"a"]
	--test-- "str-m6"	--assert parse 		"aa"		[some [#"b" | [break]] 2 #"a"]
	--test-- "str-m7"	--assert not parse 	"aa"		[some [#"b" | 2 [#"c" | break]] 2 #"a"]

===end-group===

~~~end-file~~~

Red [
	Title:	"Red PARSE test script"
	Author:	"Nenad Rakocevic"
	File:	%parse-test.reds
	Tabs:	4
	Rights:	"Copyright (C) 2011-2013 Nenad Rakocevic & Peter W A Wood. All rights reserved."
	License: "BSD-3 - https://github.com/dockimbel/Red/blob/origin/BSD-3-License.txt"
]

#include  %../../../../quick-test/quick-test.red

~~~start-file~~~ "parse"

===start-group=== "block"

	--test-- "blk-1" 	--assert parse 		[]			[]
	--test-- "blk-2" 	--assert parse 		[a]			['a]
	--test-- "blk-3" 	--assert not parse	[a]			['b]
	--test-- "blk-4" 	--assert parse 		[a b]		['a 'b]
	--test-- "blk-5" 	--assert parse 		[a #"b"]	['a #"b"]
	--test-- "blk-6" 	--assert parse 		[a]			[['a]]
	--test-- "blk-7" 	--assert parse 		[a b]		[['a] 'b]
	--test-- "blk-8" 	--assert parse 		[a b]		['a ['b]]
	--test-- "blk-9" 	--assert parse 		[a b]		[['a]['b]]
	--test-- "blk-10"	--assert parse 		["hello"]	["hello"]

	--test-- "blk-11"	--assert parse 		[#"a"] 		[#"b" | #"a"]
	--test-- "blk-12"	--assert not parse	[a b]		['b | 'a]
	--test-- "blk-13"	--assert parse 		[#"a"]		[[#"b" | #"a"]]
	--test-- "blk-14"	--assert not parse	[a b]		[['b | 'a]]
	--test-- "blk-15"	--assert parse 		[a b]		[['a | 'b]['b | 'a]]

	--test-- "blk-16"	--assert parse		[a 123]		['a integer!]
	--test-- "blk-17"	--assert not parse	[a 123]		['a char!]
	--test-- "blk-18"	--assert parse		[a 123]		[['a][integer!]]
	--test-- "blk-19"	--assert not parse	[a 123]		['a [char!]]

	--test-- "blk-20"
		res: 0
	--assert parse [] [(res: 1)]
	--assert res = 1

	--test-- "blk-21"
		res: 0
		--assert parse [a] ['a (res: 1)]
		--assert res = 1

	--test-- "blk-22"
		res: 0
		--assert not parse [a] ['b (res: 1)]
		--assert res = 0

	--test-- "blk-23"
		res: 0
		--assert parse [] [[(res: 1)]]
		--assert res = 1

	--test-- "blk-24"
		res: 0
		--assert parse [a] [['a (res: 1)]]
		--assert res = 1

	--test-- "blk-25"
		res: 0
		--assert not parse [a] [['b (res: 1)]]
		--assert res = 0

	--test-- "blk-26"
		res: 0
		--assert parse [a 123] ['a (res: 1) [char! (res: 2) | integer! (res: 3)]]
		--assert res = 3

	--test-- "blk-27"
		res: 0
		--assert not parse [a 123] ['a (res: 1) [char! (res: 2) | string! (res: 3)]]
		--assert res = 1

	--test-- "blk-28"	--assert not parse		[a a]		[1 ['a]]
	--test-- "blk-29"	--assert parse			[a a]		[2 ['a]]
	--test-- "blk-30"	--assert not parse		[a a]		[3 ['a]]
	--test-- "blk-31"	--assert not parse		[a a]		[1 1 ['a]]
	--test-- "blk-32"	--assert parse			[a a]		[1 2 ['a]]
	--test-- "blk-33"	--assert parse			[a a]		[2 2 ['a]]
	--test-- "blk-34"	--assert parse			[a a]		[2 3 ['a]]
	--test-- "blk-35"	--assert not parse		[a a]		[3 4 ['a]]

	--test-- "blk-36"	--assert not parse		[a a]		[1 'a]
	--test-- "blk-37"	--assert parse			[a a]		[2 'a]
	--test-- "blk-38"	--assert not parse		[a a]		[3 'a]
	--test-- "blk-39"	--assert not parse		[a a]		[1 1 'a]
	--test-- "blk-40"	--assert parse			[a a]		[1 2 'a]
	--test-- "blk-41"	--assert parse			[a a]		[2 2 'a]
	--test-- "blk-42"	--assert parse			[a a]		[2 3 'a]
	--test-- "blk-43"	--assert not parse		[a a]		[3 4 'a]

	--test-- "blk-44"	--assert not parse		[a a]		[1 skip]
	--test-- "blk-45"	--assert parse			[a a]		[2 skip]
	--test-- "blk-46"	--assert not parse		[a a]		[3 skip]
	--test-- "blk-47"	--assert not parse		[a a]		[1 1 skip]
	--test-- "blk-48"	--assert parse			[a a]		[1 2 skip]
	--test-- "blk-49"	--assert parse			[a a]		[2 2 skip]
	--test-- "blk-50"	--assert parse			[a a]		[2 3 skip]
	--test-- "blk-51"	--assert not parse		[a a]		[3 4 skip]

	--test-- "blk-52"	--assert parse			[a]			[skip]
	--test-- "blk-53"	--assert parse			[a b]		[skip skip]
	--test-- "blk-54"	--assert parse			[a b]		[skip [skip]]
	--test-- "blk-55"	--assert parse			[a b]		[[skip] [skip]]

	--test-- "blk-56"	--assert parse			[a a]		[some ['a]]
	--test-- "blk-57"	--assert not parse		[a a]		[some ['a] 'b]

	--test-- "blk-58"	--assert parse			[a a b a b b b a]	[some [skip]]
	--test-- "blk-59"	--assert parse			[a a b a b b b a]	[some ['a | 'b]]
	--test-- "blk-60"	--assert not parse 		[a a b a b b b a]	[some ['a | 'c]]

	--test-- "blk-61"	--assert parse 			[a a]		[any ['a]]
	--test-- "blk-62"	--assert parse			[a a]		[some ['a] any ['b]]
	--test-- "blk-63"	--assert parse			[a a b b]	[2 'a 2 'b]
	--test-- "blk-64"	--assert not parse		[a a b b]	[2 'a 3 'b]
	--test-- "blk-65"	--assert parse			[a a b b]	[some 'a some 'b]
	--test-- "blk-66"	--assert not parse		[a a b b]	[some 'a some 'c]

	--test-- "blk-67"
		p: none
		--assert parse [] [p:]
		--assert tail? p

	--test-- "blk-68"
		p: none
		--assert parse [] [[[p:]]]
		--assert tail? p

	--test-- "blk-69"
		p: none
		--assert parse [a] [p: 'a]
		--assert p = [a]

	--test-- "blk-70"
		p: none
		--assert parse [a] ['a p:]
		--assert tail? p

	--test-- "blk-71"
		p: none
		--assert parse [a] ['a [p:]]
		--assert tail? p

	--test-- "blk-72"
		p: none
		--assert not parse [a b] ['a p:]
		--assert p = [b]

	--test-- "blk-72"
		p: none
		--assert parse [a b] ['a [p:]['b | 'c]]
		--assert p = [b]

	--test-- "blk-73"
		p: none
		--assert parse [a a a b b] [3 'a p: 2 'b :p [2 'b]]
		--assert p = [b b]

	--test-- "blk-74"
	--assert parse [b a a a c][skip some ['a] 'c]

===end-group===

===start-group=== "block-end"

	--test-- "blk-end-1" --assert parse 		[a] 	['a end]
	--test-- "blk-end-2" --assert not parse 	[a b] 	['a end]
	--test-- "blk-end-3" --assert parse 		[a] 	[skip end]
	--test-- "blk-end-4" --assert not parse 	[a b]	[skip end]
	--test-- "blk-end-5" --assert parse 		[]		[end]

	--test-- "blk-end-6"
		be6: 0
		--assert parse [] [end (be6: 1)]
		--assert be6 = 1

===end-group===

===start-group=== "block-words"

	wa: ['a]
	wb: ['b]
	wca: #"a"
	wcb: #"b"
	wra: [wa]
	wrb: [wb]
	wh: "hello"
	wrab: ['a | 'b]
	wrba: ['b | 'a]

	--test-- "blk-w1" 	--assert parse 		[a]			[wa]
	--test-- "blk-w2" 	--assert not parse 	[a]			[wb]
	--test-- "blk-w3" 	--assert parse 		[a b]		[wa wb]
	--test-- "blk-w4" 	--assert parse 		[a #"b"]	[wa wcb]
	--test-- "blk-w5" 	--assert parse 		[a]			[wra]
	--test-- "blk-w6" 	--assert parse 		[a b]		[wra 'b]
	--test-- "blk-w7" 	--assert parse 		[a b]		['a wrb]
	--test-- "blk-w8" 	--assert parse 		[a b]		[wra wrb]
	--test-- "blk-w9" 	--assert parse 		["hello"]	[wh]

	--test-- "blk-w10"	--assert parse 		[#"a"] 		[wcb | wca]
	--test-- "blk-w11"	--assert not parse 	[a b]		[wb | wa]
	--test-- "blk-w12"	--assert parse 		[#"a"]		[[wcb | wca]]
	--test-- "blk-w13"	--assert not parse 	[a b]		[wrba]
	--test-- "blk-w14"	--assert parse 		[a b]		[wrab wrba]

	--test-- "blk-w15"	--assert parse		[a 123]		[wa integer!]
	--test-- "blk-w16"	--assert not parse	[a 123]		[wa char!]
	--test-- "blk-w17"	--assert parse		[a 123]		[wra [integer!]]
	--test-- "blk-w18"	--assert not parse	[a 123]		[wa  [char!]]

	--test-- "blk-w19"
		res: 0
		--assert parse [a] [wa (res: 1)]
		--assert res = 1

	--test-- "blk-w20"
		res: 0
		--assert not parse [a] [wb (res: 1)]
		--assert res = 0

	--test-- "blk-w21"
		res: 0
		wres: [(res: 1)]
		--assert parse [] [wres]
		--assert res = 1

	--test-- "blk-w22"
		res: 0
		wres: ['a (res: 1)]
		--assert parse [a] [wres]
		--assert res = 1

	--test-- "blk-w23"
		res: 0
		wres: ['b (res: 1)]
		--assert not parse [a] [wres]
		--assert res = 0

	--test-- "blk-w24"
		res: 0
		wres: [char! (res: 2) | integer! (res: 3)]
		--assert parse [a 123] [wa (res: 1) wres]
		--assert res = 3

	--test-- "blk-w25"
		res: 0
		wres: [char! (res: 2) | string! (res: 3)]
		--assert not parse [a 123] [wa (res: 1) wres]
		--assert res = 1

===end-group===

===start-group=== "block-extraction"

	wa: ['a]
	--test-- "blk-ext1"
		res: 0
		--assert parse [a][copy res skip]
		--assert res = [a]

	--test-- "blk-ext2"
		res: 0
		--assert parse [a][copy res 'a]
		--assert res = [a]

	--test-- "blk-ext3"
		res: 0
		--assert parse [a][copy res word!]
		--assert res = [a]

	--test-- "blk-ext4"
		res:  0
		res2: 0
		--assert parse [a][copy res copy res2 'a]
		--assert res  = [a]
		--assert res2 = [a]

	--test-- "blk-ext5"
		res: 0
		--assert parse [a a][copy res 2 'a]				;@@ a instead of 'a will crash!
		--assert res = [a a]

	--test-- "blk-ext6"
		res: 0
		--assert not parse [a a][copy res 3 'a]
		--assert res = 0

	--test-- "blk-ext7"
		res: 0
		--assert parse [a][copy res ['a]]
		--assert res = [a]

	--test-- "blk-ext8"
		res: 0
		--assert parse [a][copy res wa]
		--assert res = [a]

	--test-- "blk-ext9"
		res: 0
		--assert parse [a a][copy res 2 wa]
		--assert res = [a a]

	--test-- "blk-ext10"
		res: 0
		--assert parse [a a b][skip copy res 'a skip]
		--assert res = [a]

	--test-- "blk-ext11"
		res: 0
		--assert parse [a a b][skip copy res ['a | 'b] skip]
		--assert res = [a]

	--test-- "blk-ext12"
		res: 0
		--assert not parse [a][copy res ['c | 'b]]
		--assert res = 0

	--test-- "blk-ext13"
		res: 0
		--assert parse [a][set res skip]
		--assert res = 'a

	--test-- "blk-ext14"
		res: 0
		--assert parse [a][set res 'a]
		--assert res = 'a

	--test-- "blk-ext15"
		res: 0
		--assert parse [a][set res word!]
		--assert res = 'a

	--test-- "blk-ext16"
		res:  0
		res2: 0
		--assert parse [a][set res set res2 'a]
		--assert res  = 'a
		--assert res2 = 'a

	--test-- "blk-ext17"
		res: 0
		--assert parse [a a][set res 2 'a]				;@@ a instead of 'a will crash!
		--assert res = 'a

	--test-- "blk-ext18"
		res: 0
		--assert not parse [a a][set res 3 'a]
		--assert res = 0

	--test-- "blk-ext19"
		res: 0
		--assert parse [a][set res ['a]]
		--assert res = 'a

	--test-- "blk-ext20"
		res: 0
		--assert parse [a][set res wa]
		--assert res = 'a

	--test-- "blk-ext21"
		res: 0
		--assert parse [a a][set res 2 wa]
		--assert res = 'a

	--test-- "blk-ext22"
		res: 0
		--assert parse [a a b][skip set res 'a skip]
		--assert res = 'a

	--test-- "blk-ext23"
		res: 0
		--assert parse [a a b][skip set res ['a | 'b] skip]
		--assert res = 'a

	--test-- "blk-ext24"
		res: 0
		--assert not parse [a][set res ['c | 'b]]
		--assert res = 0

	--test-- "blk-ext25"
		res: 0
		--assert parse [b a a a c][skip set res some 'a 'c]
		--assert res = 'a

	--test-- "blk-ext26"
		res: 0
		--assert parse [b a a a c][skip set res some wa 'c]
		--assert res = 'a

===end-group===

===start-group=== "block-skipping"

	wa: ['a]

	--test-- "blk-sk1" 	--assert parse		[]			[to end]
	--test-- "blk-sk2" 	--assert parse		[]			[thru end]
	--test-- "blk-sk3" 	--assert parse		[a]			[to end]
	--test-- "blk-sk4" 	--assert not parse	[a]			[to 'a]
	--test-- "blk-sk5" 	--assert not parse	[a]			[to 'a end]
	--test-- "blk-sk6" 	--assert parse		[a]			[to 'a skip]
	--test-- "blk-sk7" 	--assert parse		[a]			[thru 'a]
	--test-- "blk-sk8" 	--assert parse		[a]			[thru 'a end]
	--test-- "blk-sk9" 	--assert not parse	[a]			[thru 'a skip]
	--test-- "blk-sk10"	--assert parse		[a b]		[to 'b skip]
	--test-- "blk-sk11"	--assert parse		[a b]		[thru 'b]
	--test-- "blk-sk12"	--assert parse		[a a a b]	[to 'b skip]
	--test-- "blk-sk13"	--assert parse		[a a b a]	[skip to 'b 2 skip]

	--test-- "blk-sk14"	--assert not parse	[a]			[to ['a]]
	--test-- "blk-sk15"	--assert not parse	[a]			[to ['a] end]
	--test-- "blk-sk16"	--assert parse		[a]			[to ['a] skip]
	--test-- "blk-sk17"	--assert parse		[a]			[thru ['a]]
	--test-- "blk-sk18"	--assert parse		[a]			[thru ['a] end]
	--test-- "blk-sk19"	--assert not parse	[a]			[thru ['a] skip]
	--test-- "blk-sk20"	--assert parse		[a b]		[to ['b] skip]
	--test-- "blk-sk21"	--assert parse		[a b]		[thru ['b]]
	--test-- "blk-sk22"	--assert parse		[a a a b]	[to ['b] skip]
	--test-- "blk-sk23"	--assert parse		[a a b a]	[skip to ['b] 2 skip]

	--test-- "blk-sk24"	--assert parse		[z z a b c]	[to ['c | 'b | 'a] 3 skip]
	--test-- "blk-sk25"	--assert parse		[z z a b c]	[to ['a | 'b | 'c] 3 skip]

	--test-- "blk-sk26"	--assert parse		[z z a b c]	[thru ['c | 'b | 'a] 2 skip]
	--test-- "blk-sk27"	--assert parse		[z z a b c]	[thru ['a | 'b | 'c] 2 skip]

	--test-- "blk-sk28"	--assert parse		[b b a a c]	[thru 2 'a 'c]
	--test-- "blk-sk29"	--assert parse		[b b a a c]	[thru 2 'a 'c]
	--test-- "blk-sk30"	--assert parse		[b b a a c]	[thru [2 'a] 'c]
	--test-- "blk-sk31"	--assert parse		[b b a a c]	[thru some 'a 'c]
	--test-- "blk-sk32"	--assert parse		[b b a a c]	[thru [some 'a] 'c]
	--test-- "blk-sk33"	--assert parse		[b b a a c]	[thru [some 'x | 2 'a] 'c]
	--test-- "blk-sk34"	--assert parse		[b b a a c]	[thru 2 wa 'c]
	--test-- "blk-sk35"	--assert parse		[b b a a c]	[thru some wa 'c]

	--test-- "blk-sk36"	--assert parse 		[1 "hello"]	[thru "hello"]

	--test-- "blk-sk37"
		res: 0
		--assert parse [1 "hello" a 1 2 3 b] [thru "hello" skip copy res to 'b skip]
		--assert res = [1 2 3]

===end-group===

===start-group=== "string"

	--test-- "str-1" 	--assert parse		""			[]
	--test-- "str-2" 	--assert parse		"a"			[#"a"]
	--test-- "str-3" 	--assert parse		"a"			["a"]
	--test-- "str-4" 	--assert not parse	"a"			[#"b"]
	--test-- "str-5" 	--assert parse		"ab"		[#"a" #"b"]
	--test-- "str-6" 	--assert parse		"ab"		["ab"]
	--test-- "str-7" 	--assert parse		"a"			[[#"a"]]
	--test-- "str-8" 	--assert parse		"ab"		[[#"a"] "b"]
	--test-- "str-9" 	--assert parse		"ab"		[#"a" [#"b"]]
	--test-- "str-10"	--assert parse		"ab"		[[#"a"][#"b"]]

	--test-- "str-11"	--assert parse		"a"			[#"b" | #"a"]
	--test-- "str-12"	--assert not parse	"ab"		[#"b" | "a"]
	--test-- "str-13"	--assert parse		"a"			[[#"b" | #"a"]]
	--test-- "str-14"	--assert not parse	"ab"		[[#"b" | "a"]]
	--test-- "str-15"	--assert parse		"ab"		[["a" | #"b"][#"b" | "a"]]

	;--test-- "str-16"	--assert parse		"123"		[integer!]

	--test-- "str-20"
		res: 0
		--assert parse "" [(res: 1)]
		--assert res = 1

	--test-- "str-21"
		res: 0
		--assert parse "a" [#"a" (res: 1)]
		--assert res = 1

	--test-- "str-22"
		res: 0
		--assert not parse "a" [#"b" (res: 1)]
		--assert res = 0

	--test-- "str-23"
		res: 0
		--assert parse "" [[(res: 1)]]
		--assert res = 1

	--test-- "str-24"
		res: 0
		--assert parse "a" [[#"a" (res: 1)]]
		--assert res = 1

	--test-- "str-25"
		res: 0
		--assert not parse "a" [[#"b" (res: 1)]]
		--assert res = 0

	--test-- "str-26"
		res: 0
		--assert parse "ab" [#"a" (res: 1) [#"c" (res: 2) | #"b" (res: 3)]]
		--assert res = 3

	--test-- "str-27"
		res: 0
		--assert not parse "ab" [#"a" (res: 1) [#"c" (res: 2) | #"d" (res: 3)]]
		--assert res = 1

	--test-- "str-28"	--assert not parse		"aa"		[1 [#"a"]]
	--test-- "str-29"	--assert parse			"aa"		[2 [#"a"]]
	--test-- "str-30"	--assert not parse		"aa"		[3 [#"a"]]
	--test-- "str-31"	--assert not parse		"aa"		[1 1 [#"a"]]
	--test-- "str-32"	--assert parse			"aa"		[1 2 [#"a"]]
	--test-- "str-33"	--assert parse			"aa"		[2 2 [#"a"]]
	--test-- "str-34"	--assert parse			"aa"		[2 3 [#"a"]]
	--test-- "str-35"	--assert not parse		"aa"		[3 4 [#"a"]]

	--test-- "str-36"	--assert not parse		"aa"		[1 #"a"]
	--test-- "str-37"	--assert parse			"aa"		[2 #"a"]
	--test-- "str-38"	--assert not parse		"aa"		[3 #"a"]
	--test-- "str-39"	--assert not parse		"aa"		[1 1 #"a"]
	--test-- "str-40"	--assert parse			"aa"		[1 2 #"a"]
	--test-- "str-41"	--assert parse			"aa"		[2 2 #"a"]
	--test-- "str-42"	--assert parse			"aa"		[2 3 #"a"]
	--test-- "str-43"	--assert not parse		"aa"		[3 4 #"a"]

	--test-- "str-44"	--assert not parse		"aa"		[1 skip]
	--test-- "str-45"	--assert parse			"aa"		[2 skip]
	--test-- "str-46"	--assert not parse		"aa"		[3 skip]
	--test-- "str-47"	--assert not parse		"aa"		[1 1 skip]
	--test-- "str-48"	--assert parse			"aa"		[1 2 skip]
	--test-- "str-49"	--assert parse			"aa"		[2 2 skip]
	--test-- "str-50"	--assert parse			"aa"		[2 3 skip]
	--test-- "str-51"	--assert not parse		"aa"		[3 4 skip]

	--test-- "str-52"	--assert parse			"a"			[skip]
	--test-- "str-53"	--assert parse			"ab"		[skip skip]
	--test-- "str-54"	--assert parse			"ab"		[skip [skip]]
	--test-- "str-55"	--assert parse			"ab"		[[skip] [skip]]

	--test-- "str-56"	--assert parse			"aa"		[some [#"a"]]
	--test-- "str-57"	--assert not parse		"aa"		[some [#"a"] #"b"]

	--test-- "str-58"	--assert parse			"aababbba"	[some [skip]]
	--test-- "str-59"	--assert parse			"aababbba"	[some ["a" | "b"]]
	--test-- "str-60"	--assert not parse		"aababbba"	[some ["a" | #"c"]]

	--test-- "str-61"	--assert parse			"aa"		[any [#"a"]]
	--test-- "str-62"	--assert parse			"aa"		[some [#"a"] any [#"b"]]
	--test-- "str-63"	--assert parse			"aabb"		[2 #"a" 2 "b"]
	--test-- "str-64"	--assert not parse		"aabb"		[2 "a" 3 #"b"]
	--test-- "str-65"	--assert parse			"aabb"		[some #"a" some "b"]
	--test-- "str-66"	--assert not parse		"aabb"		[some "a" some #"c"]

	--test-- "str-67"
		p: none
		--assert parse "" [p:]
		--assert tail? p

	--test-- "str-68"
		p: none
		--assert parse "" [[[p:]]]
		--assert tail? p

	--test-- "str-69"
		p: none
		--assert parse "a" [p: #"a"]
		--assert p = "a"

	--test-- "str-70"
		p: none
		--assert parse "a" [#"a" p:]
		--assert tail? p

	--test-- "str-71"
		p: none
		--assert parse "a" [#"a" [p:]]
		--assert tail? p

	--test-- "str-72"
		p: none
		--assert not parse "ab" [#"a" p:]
		--assert p = "b"

	--test-- "str-73"
		p: none
		--assert parse "ab" [#"a" [p:][#"b" | #"c"]]
		--assert p = "b"

	--test-- "str-74"
		p: none
		--assert parse "aaabb" [3 #"a" p: 2 #"b" :p [2 "b"]]
		--assert p = "bb"

	--test-- "str-75"
	--assert parse "baaac" [skip some [#"a"] #"c"]

===end-group===

===start-group=== "string-end"

	--test-- "str-end-1" --assert parse 		"a" 	[#"a" end]
	--test-- "str-end-2" --assert not parse 	"ab" 	[#"a" end]
	--test-- "str-end-3" --assert parse 		"a" 	[skip end]
	--test-- "str-end-4" --assert not parse 	"ab"	[skip end]
	--test-- "str-end-5" --assert parse 		""		[end]

	--test-- "str-end-6"
		be6: 0
		--assert parse "" [end (be6: 1)]
		--assert be6 = 1

===end-group===

===start-group=== "string-words"

	wa: [#"a"]
	wb: [#"b"]
	wca: #"a"
	wcb: #"b"
	wra: [wa]
	wrb: [wb]
	wh: "hello"
	wrab: [#"a" | #"b"]
	wrba: [#"b" | #"a"]

	--test-- "str-w1" 	--assert parse 		"a"			[wa]
	--test-- "str-w2" 	--assert not parse 	"a"			[wb]
	--test-- "str-w3" 	--assert parse 		"ab"		[wa wb]
	--test-- "str-w5" 	--assert parse 		"a"			[wra]
	--test-- "str-w6" 	--assert parse 		"ab"		[wra #"b"]
	--test-- "str-w7" 	--assert parse 		"ab"		[#"a" wrb]
	--test-- "str-w8" 	--assert parse 		"ab"		[wra wrb]
	--test-- "str-w9" 	--assert parse 		"hello"		[wh]

	--test-- "str-w10"	--assert parse 		"a" 		[wcb | wca]
	--test-- "str-w11"	--assert not parse 	"ab"		[wb | wa]
	--test-- "str-w12"	--assert parse 		"a"			[[wcb | wca]]
	--test-- "str-w13"	--assert not parse 	"ab"		[wrba]
	--test-- "str-w14"	--assert parse 		"ab"		[wrab wrba]

	--test-- "str-w19"
		res: 0
		--assert parse "a" [wa (res: 1)]
		--assert res = 1

	--test-- "str-w20"
		res: 0
		--assert not parse "a" [wb (res: 1)]
		--assert res = 0

	--test-- "str-w21"
		res: 0
		wres: [(res: 1)]
		--assert parse "" [wres]
		--assert res = 1

	--test-- "str-w22"
		res: 0
		wres: [#"a" (res: 1)]
		--assert parse "a" [wres]
		--assert res = 1

	--test-- "str-w23"
		res: 0
		wres: [#"b" (res: 1)]
		--assert not parse "a" [wres]
		--assert res = 0

===end-group===

===start-group=== "string-extraction"

	wa: [#"a"]
	--test-- "str-ext1"
		res: 0
		--assert parse "a" [copy res skip]
		--assert res = "a"

	--test-- "str-ext2"
		res: 0
		--assert parse "a" [copy res #"a"]
		--assert res = "a"

	--test-- "str-ext4"
		res:  0
		res2: 0
		--assert parse "a" [copy res copy res2 #"a"]
		--assert res  = "a"
		--assert res2 = "a"

	--test-- "str-ext5"
		res: 0
		--assert parse "aa" [copy res 2 #"a"]
		--assert res = "aa"

	--test-- "str-ext6"
		res: 0
		--assert not parse "aa" [copy res 3 #"a"]
		--assert res = 0

	--test-- "str-ext7"
		res: 0
		--assert parse "a" [copy res [#"a"]]
		--assert res = "a"

	--test-- "str-ext8"
		res: 0
		--assert parse "a" [copy res wa]
		--assert res = "a"

	--test-- "str-ext9"
		res: 0
		--assert parse "aa" [copy res 2 wa]
		--assert res = "aa"

	--test-- "str-ext10"
		res: 0
		--assert parse "aab" [skip copy res #"a" skip]
		--assert res = "a"

	--test-- "str-ext11"
		res: 0
		--assert parse "aab" [skip copy res [#"a" | #"b"] skip]
		--assert res = "a"

	--test-- "str-ext12"
		res: 0
		--assert not parse "a" [copy res [#"c" | #"b"]]
		--assert res = 0

	--test-- "str-ext13"
		res: 0
		--assert parse "a" [set res skip]
		--assert res = #"a"

	--test-- "str-ext14"
		res: 0
		--assert parse "a" [set res #"a"]
		--assert res = #"a"

	--test-- "str-ext16"
		res:  0
		res2: 0
		--assert parse "a" [set res set res2 #"a"]
		--assert res  = #"a"
		--assert res2 = #"a"

	--test-- "str-ext17"
		res: 0
		--assert parse "aa" [set res 2 #"a"]
		--assert res = #"a"

	--test-- "str-ext18"
		res: 0
		--assert not parse "aa" [set res 3 #"a"]
		--assert res = 0

	--test-- "str-ext19"
		res: 0
		--assert parse "a" [set res [#"a"]]
		--assert res = #"a"

	--test-- "str-ext20"
		res: 0
		--assert parse "a" [set res wa]
		--assert res = #"a"

	--test-- "str-ext21"
		res: 0
		--assert parse "aa" [set res 2 wa]
		--assert res = #"a"

	--test-- "str-ext22"
		res: 0
		--assert parse "aab" [skip set res #"a" skip]
		--assert res = #"a"

	--test-- "str-ext23"
		res: 0
		--assert parse "aab" [skip set res [#"a" | #"b"] skip]
		--assert res = #"a"

	--test-- "str-ext24"
		res: 0
		--assert not parse "a" [set res [#"c" | #"b"]]
		--assert res = 0

	--test-- "str-ext25"
		res: 0
		--assert parse "baaac" [skip set res some #"a" #"c"]
		--assert res = #"a"

	--test-- "str-ext26"
		res: 0
		--assert parse "baaac" [skip set res some wa #"c"]
		--assert res = #"a"

===end-group===

===start-group=== "string-skipping"

	str: "Lorem ipsum dolor sit amet."
	wa: [#"a"]

	--test-- "str-sk1" 	--assert parse		""			[to end]
	--test-- "str-sk2" 	--assert parse		""			[thru end]
	--test-- "str-sk3" 	--assert parse		"a"			[to end]
	--test-- "str-sk4" 	--assert not parse	"a"			[to #"a"]
	--test-- "str-sk5" 	--assert not parse	"a"			[to #"a" end]
	--test-- "str-sk6" 	--assert parse		"a"			[to #"a" skip]
	--test-- "str-sk7" 	--assert parse		"a"			[thru #"a"]
	--test-- "str-sk8" 	--assert parse		"a"			[thru #"a" end]
	--test-- "str-sk9" 	--assert not parse	"a"			[thru #"a"skip]
	--test-- "str-sk10"	--assert parse		"ab"		[to #"a" 2 skip]
	--test-- "str-sk11"	--assert parse		"ab"		[thru #"a" skip]
	--test-- "str-sk12"	--assert parse		"aaab"		[to #"a" to end]
	--test-- "str-sk13"	--assert parse		"aaba"		[skip thru #"a" 2 skip]

	--test-- "str-sk14"	--assert not parse	"a"			[to [#"a"]]
	--test-- "str-sk15"	--assert not parse	"a"			[to [#"a"] end]
	--test-- "str-sk16"	--assert parse		"a"			[to [#"a"] skip]
	--test-- "str-sk17"	--assert parse		"a"			[thru [#"a"]]
	--test-- "str-sk18"	--assert parse		"a"			[thru [#"a"] end]
	--test-- "str-sk19"	--assert not parse	"a"			[thru [#"a"] skip]
	--test-- "str-sk20"	--assert parse		"ab"		[to [#"a"] 2 skip]
	--test-- "str-sk21"	--assert parse		"ab"		[thru [#"a"] skip]
	--test-- "str-sk22"	--assert parse		"aaab"		[to [#"a"] to end]
	--test-- "str-sk23"	--assert parse		"aaba"		[skip thru [#"a"] 2 skip]

	--test-- "str-sk24"	--assert parse		"zzabc"		[to [#"c" | #"b" | #"a"] 3 skip]
	--test-- "str-sk25"	--assert parse		"zzabc"		[to [#"a" | #"b" | #"c"] 3 skip]

	--test-- "str-sk26"	--assert parse		"zzabc"		[thru [#"c" | #"b" | #"a"] 2 skip]
	--test-- "str-sk27"	--assert parse		"zzabc"		[thru [#"a" | #"b" | #"c"] 2 skip]
	--test-- "str-sk28"	--assert parse		"bbaaac"	[thru 3 #"a" #"c"]
	--test-- "str-sk29"	--assert parse		"bbaaac"	[thru 3 "a" "c"]
	--test-- "str-sk30"	--assert parse		"bbaaac"	[thru 3 wa #"c"]
	--test-- "str-sk31"	--assert parse		"bbaaac"	[thru [3 "a"] "c"]
	--test-- "str-sk32"	--assert parse		"bbaaac"	[thru some "a" "c"]
	--test-- "str-sk33"	--assert parse		"bbaaac"	[thru [some #"a"] "c"]
	--test-- "str-sk34"	--assert parse		"bbaaac"	[thru [some #"x" | "aaa"] "c"]

	--test-- "str-sk35"	--assert parse 		str 		[thru "amet" skip]

	--test-- "str-sk36"
		res: 0
		--assert parse str [thru "ipsum" skip copy res to #" " to end]
		--assert res = "dolor"

	--test-- "str-sk37"
		res: 0
		--assert parse str [thru #"p" res: to end]
		--assert 9 = index? res

===end-group===

~~~end-file~~~


datatype

datatype

Red [
  url: https://www.hackerrank.com/challenges/picking-numbers/problem
]

picking-numbers: function [a] [
  sort a
  p: copy reduce [first a none]
  len: 1x0
  max-len: 1
  foreach i next a [
    switch/default i - p/1 [
      0 [len/1: len/1 + 1]
      1 [len/2: len/2 + 1 p/2: i]
    ] [
      max-len: max len/1 + len/2 max-len
      either all [p/2 i - p/2 = 1] [
        p/1: p/2 p/2: i
        len/1: len/2 len/2: 1
      ] [
        p/1: i p/2: none
        len: 1x0
      ]
    ]
  ]
  max len/1 + len/2 max-len
]

print 4 = picking-numbers [1 2 2 3 3]
print 5 = picking-numbers [1 1 2 2 4 4 5 5 5]
print 3 = picking-numbers [4 6 5 3 3 1]
print 5 = picking-numbers [1 2 2 3 1 2]

Red [
  url: https://www.hackerrank.com/challenges/picking-numbers/problem
]

picking-numbers: function [a] [
  sort a
  p: copy reduce [first a none]
  len: copy [1 0]
  max-len: 1
  foreach i next a [
    switch/default i - p/1 [
      0 [len/1: len/1 + 1]
      1 [len/2: len/2 + 1 p/2: i]
    ] [
      max-len: max len/1 + len/2 max-len
      either all [p/2 i - p/2 = 1] [
        p/1: p/2 p/2: i
        len/1: len/2 len/2: 1
      ] [
        p/1: i p/2: none
        len/1: 1 len/2: 0
      ]
    ]
  ]
  max len/1 + len/2 max-len
]

print 4 = picking-numbers [1 2 2 3 3]
print 5 = picking-numbers [1 1 2 2 4 4 5 5 5]
print 3 = picking-numbers [4 6 5 3 3 1]
print 5 = picking-numbers [1 2 2 3 1 2]


FIX: fixed the misleading console startup banner.

Red [
	Title:	"Red console"
	Author: ["Nenad Rakocevic" "Kaj de Vos"]
	File: 	%console.red
	Tabs: 	4
	Rights: "Copyright (C) 2012-2013 Nenad Rakocevic. All rights reserved."
	License: {
		Distributed under the Boost Software License, Version 1.0.
		See https://github.com/dockimbel/Red/blob/master/BSL-License.txt
	}
]

#system-global [
	#either OS = 'Windows [
		#import [
			"kernel32.dll" stdcall [
				AttachConsole: 	 "AttachConsole" [
					processID		[integer!]
					return:			[integer!]
				]
				SetConsoleTitle: "SetConsoleTitleA" [
					title			[c-string!]
					return:			[integer!]
				]
				ReadConsole: 	 "ReadConsoleA" [
					consoleInput	[integer!]
					buffer			[byte-ptr!]
					charsToRead		[integer!]
					numberOfChars	[int-ptr!]
					inputControl	[int-ptr!]
					return:			[integer!]
				]
			]
		]
	][
		#switch OS [
			MacOSX [
				#define ReadLine-library "libreadline.dylib"
			]
			#default [
				#define ReadLine-library "libreadline.so.6"
				#define History-library  "libhistory.so.6"
			]
		]
		#import [
			ReadLine-library cdecl [
				read-line: "readline" [  ; Read a line from the console.
					prompt			[c-string!]
					return:			[c-string!]
				]
				rl-bind-key: "rl_bind_key" [
					key				[integer!]
					command			[integer!]
					return:			[integer!]
				]
				rl-insert:	 "rl_insert" [
					count			[integer!]
					key				[integer!]
					return:			[integer!]
				]
			]
			#if OS <> 'MacOSX [
				History-library cdecl [
					add-history: "add_history" [  ; Add line to the history.
						line		[c-string!]
					]
				]
			]
		]

		rl-insert-wrapper: func [
			[cdecl]
			count   [integer!]
			key	    [integer!]
			return: [integer!]
		][
			rl-insert count key
		]

	]
]

Windows?: system/platform = 'Windows

init-console: routine [
	str [string!]
	/local
		ret
][
	#either OS = 'Windows [
		;ret: AttachConsole -1
		;if zero? ret [print-line "ReadConsole failed!" halt]

		ret: SetConsoleTitle as c-string! string/rs-head str
		if zero? ret [print-line "SetConsoleTitle failed!" halt]
	][
		rl-bind-key as-integer tab as-integer :rl-insert-wrapper
	]
]

input: routine [
	prompt [string!]
	/local
		len ret str buffer line
][
	#either OS = 'Windows [
		len: 0
		buffer: allocate 128
		print as c-string! string/rs-head prompt
		ret: ReadConsole stdin buffer 127 :len null
		if zero? ret [print-line "ReadConsole failed!" halt]
		len: len + 1
		buffer/len: null-byte
		str: string/load as c-string! buffer len
;		free buffer
	][
		line: read-line as c-string! string/rs-head prompt
		if line = null [halt]  ; EOF

		 #if OS <> 'MacOSX [add-history line]

		str: string/load line  1 + length? line
;		free as byte-ptr! line
	]
	SET_RETURN(str)
]

count-delimiters: function [
	buffer	[string!]
	return: [block!]
][
	list: copy [0 0]
	c: none

	foreach c buffer [
		case [
			escaped? [
				escaped?: no
			]
			in-comment? [
				switch c [
					#"^/" [in-comment?: no]
				]
			]
			'else [
				switch c [
					#"^^" [escaped?: yes]
					#";"  [in-comment?: yes]
					#"["  [list/1: list/1 + 1]
					#"]"  [list/1: list/1 - 1]
					#"{"  [list/2: list/2 + 1]
					#"}"  [list/2: list/2 - 1]
				]
			]
		]
	]
	list
]

do-console: function [][
	buffer: make string! 10000
	prompt: red-prompt: "red>> "
	mode:  'mono

	switch-mode: [
		mode: case [
			cnt/1 > 0 ['block]
			cnt/2 > 0 ['string]
			'else 	  [
				prompt: red-prompt
				do eval
				'mono
			]
		]
		prompt: switch mode [
			block  ["[^-"]
			string ["{^-"]
			mono   [red-prompt]
		]
	]

	eval: [
		code: load/all buffer

		unless tail? code [
			set/any 'result do code

			unless unset? :result [
				if 67 = length? result: mold/part :result 67 [	;-- optimized for width = 72
					clear back tail result
					append result "..."
				]
				print ["==" result]
			]
		]
		clear buffer
	]

	while [true][
		unless tail? line: input prompt [
			append buffer line
			cnt: count-delimiters buffer

			either Windows? [
				remove skip tail buffer -2			;-- clear extra CR (Windows)
			][
				append buffer lf					;-- Unix
			]

			switch mode [
				block  [if cnt/1 <= 0 [do switch-mode]]
				string [if cnt/2 <= 0 [do switch-mode]]
				mono   [do either any [cnt/1 > 0 cnt/2 > 0][switch-mode][eval]]
			]
		]
	]
]

q: :quit

init-console "Red Console"

print {
-=== Red Console alpha version ===-
(only ASCII input supported)
}

do-console

Red [
	Title:	"Red console"
	Author: ["Nenad Rakocevic" "Kaj de Vos"]
	File: 	%console.red
	Tabs: 	4
	Rights: "Copyright (C) 2012-2013 Nenad Rakocevic. All rights reserved."
	License: {
		Distributed under the Boost Software License, Version 1.0.
		See https://github.com/dockimbel/Red/blob/master/BSL-License.txt
	}
]

#system-global [
	#either OS = 'Windows [
		#import [
			"kernel32.dll" stdcall [
				AttachConsole: 	 "AttachConsole" [
					processID		[integer!]
					return:			[integer!]
				]
				SetConsoleTitle: "SetConsoleTitleA" [
					title			[c-string!]
					return:			[integer!]
				]
				ReadConsole: 	 "ReadConsoleA" [
					consoleInput	[integer!]
					buffer			[byte-ptr!]
					charsToRead		[integer!]
					numberOfChars	[int-ptr!]
					inputControl	[int-ptr!]
					return:			[integer!]
				]
			]
		]
	][
		#switch OS [
			MacOSX [
				#define ReadLine-library "libreadline.dylib"
			]
			#default [
				#define ReadLine-library "libreadline.so.6"
				#define History-library  "libhistory.so.6"
			]
		]
		#import [
			ReadLine-library cdecl [
				read-line: "readline" [  ; Read a line from the console.
					prompt			[c-string!]
					return:			[c-string!]
				]
				rl-bind-key: "rl_bind_key" [
					key				[integer!]
					command			[integer!]
					return:			[integer!]
				]
				rl-insert:	 "rl_insert" [
					count			[integer!]
					key				[integer!]
					return:			[integer!]
				]
			]
			#if OS <> 'MacOSX [
				History-library cdecl [
					add-history: "add_history" [  ; Add line to the history.
						line		[c-string!]
					]
				]
			]
		]

		rl-insert-wrapper: func [
			[cdecl]
			count   [integer!]
			key	    [integer!]
			return: [integer!]
		][
			rl-insert count key
		]

	]
]

Windows?: system/platform = 'Windows

init-console: routine [
	str [string!]
	/local
		ret
][
	#either OS = 'Windows [
		;ret: AttachConsole -1
		;if zero? ret [print-line "ReadConsole failed!" halt]

		ret: SetConsoleTitle as c-string! string/rs-head str
		if zero? ret [print-line "SetConsoleTitle failed!" halt]
	][
		rl-bind-key as-integer tab as-integer :rl-insert-wrapper
	]
]

input: routine [
	prompt [string!]
	/local
		len ret str buffer line
][
	#either OS = 'Windows [
		len: 0
		buffer: allocate 128
		print as c-string! string/rs-head prompt
		ret: ReadConsole stdin buffer 127 :len null
		if zero? ret [print-line "ReadConsole failed!" halt]
		len: len + 1
		buffer/len: null-byte
		str: string/load as c-string! buffer len
;		free buffer
	][
		line: read-line as c-string! string/rs-head prompt
		if line = null [halt]  ; EOF

		 #if OS <> 'MacOSX [add-history line]

		str: string/load line  1 + length? line
;		free as byte-ptr! line
	]
	SET_RETURN(str)
]

count-delimiters: function [
	buffer	[string!]
	return: [block!]
][
	list: copy [0 0]
	c: none

	foreach c buffer [
		case [
			escaped? [
				escaped?: no
			]
			in-comment? [
				switch c [
					#"^/" [in-comment?: no]
				]
			]
			'else [
				switch c [
					#"^^" [escaped?: yes]
					#";"  [in-comment?: yes]
					#"["  [list/1: list/1 + 1]
					#"]"  [list/1: list/1 - 1]
					#"{"  [list/2: list/2 + 1]
					#"}"  [list/2: list/2 - 1]
				]
			]
		]
	]
	list
]

do-console: function [][
	buffer: make string! 10000
	prompt: red-prompt: "red>> "
	mode:  'mono

	switch-mode: [
		mode: case [
			cnt/1 > 0 ['block]
			cnt/2 > 0 ['string]
			'else 	  [
				prompt: red-prompt
				do eval
				'mono
			]
		]
		prompt: switch mode [
			block  ["[^-"]
			string ["{^-"]
			mono   [red-prompt]
		]
	]

	eval: [
		code: load/all buffer

		unless tail? code [
			set/any 'result do code

			unless unset? :result [
				if 67 = length? result: mold/part :result 67 [	;-- optimized for width = 72
					clear back tail result
					append result "..."
				]
				print ["==" result]
			]
		]
		clear buffer
	]

	while [true][
		unless tail? line: input prompt [
			append buffer line
			cnt: count-delimiters buffer

			either Windows? [
				remove skip tail buffer -2			;-- clear extra CR (Windows)
			][
				append buffer lf					;-- Unix
			]

			switch mode [
				block  [if cnt/1 <= 0 [do switch-mode]]
				string [if cnt/2 <= 0 [do switch-mode]]
				mono   [do either any [cnt/1 > 0 cnt/2 > 0][switch-mode][eval]]
			]
		]
	]
]

q: :quit

init-console "Red Console"

print {
-=== Red Console alpha version ===-
(only Latin-1 input supported)
}

do-console


FIX: very minor source code alignment improvement.

Red/System [
	Title:   "Red action functions"
	Author:  "Nenad Rakocevic"
	File: 	 %actions.reds
	Tabs:	 4
	Rights:  "Copyright (C) 2011-2012 Nenad Rakocevic. All rights reserved."
	License: {
		Distributed under the Boost Software License, Version 1.0.
		See https://github.com/dockimbel/Red/blob/master/BSL-License.txt
	}
]

actions: context [
	verbose: 0

	table: declare int-ptr!

	register: func [
		[variadic]
		count	[integer!]
		list	[int-ptr!]
		/local
			offset [integer!]
			index  [integer!]
	][
		offset: 0
		index:  1

		until [
			table/index: list/value
			index: index + 1
			list: list + 1
			count: count - 1
			zero? count
		]
		assert index = (ACTIONS_NB + 1)
	]

	get-action-ptr-from: func [
		type	[integer!]								;-- datatype ID
		action	[integer!]								;-- action ID
		return: [integer!]								;-- action pointer (datatype-dependent)
		/local
			index [integer!]
	][
		index: type << 8 + action
		index: action-table/index						;-- lookup action function pointer

		if zero? index [ERR_EXPECT_ARGUMENT(type 1)]
		index
	]

	;@@ temporary stack-oriented version kept until internal API fully changed
	get-action-ptr*: func [
		action	[integer!]								;-- action ID
		return: [integer!]								;-- action pointer (datatype-dependent)
		/local
			arg  [red-value!]
	][
		arg: stack/arguments
		get-action-ptr-from TYPE_OF(arg) action
	]

	get-action-ptr: func [
		value	[red-value!]							;-- any-type! value
		action	[integer!]								;-- action ID
		return: [integer!]								;-- action pointer (datatype-dependent)
	][
		get-action-ptr-from TYPE_OF(value) action
	]

	get-index-argument: func [
		return:	 [integer!]
		/local
			arg  [red-value!]
			int  [red-integer!]
			char [red-char!]
			bool [red-logic!]
	][
		arg: stack/arguments + 1
		switch TYPE_OF(arg) [
			TYPE_INTEGER [int:  as red-integer! arg int/value]
			TYPE_CHAR 	 [char: as red-char! 	arg char/value]
			TYPE_LOGIC	 [bool: as red-logic! 	arg 2 - as-integer bool/value]
			default		 [0]
		]
	]

	;--- Actions polymorphic calls ---

	make*: func [
		return:	 [red-value!]
	][
		stack/set-last make stack/arguments stack/arguments + 1
	]

	make: func [
		proto 	 [red-value!]
		spec	 [red-value!]
		return:	 [red-value!]
		/local
			dt	 [red-datatype!]
			int  [red-integer!]
			type [integer!]
			action-make
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/make"]]

		type: TYPE_OF(proto)
		if type = TYPE_DATATYPE [
			dt: as red-datatype! proto
			type: dt/value
		]

		action-make: as function! [
			proto 	 [red-value!]
			spec	 [red-value!]
			return:	 [red-value!]						;-- newly created value
		] get-action-ptr-from type ACT_MAKE

		action-make proto spec
	]

	random*: func [
		seed	[integer!]
		secure	[integer!]
		only	[integer!]
		return:	[red-value!]
	][
		random
			as red-value! stack/arguments
			as logic! seed + 1
			as logic! secure + 1
			as logic! only + 1
	]

	random: func [
		value   [red-value!]
		seed?	[logic!]
		secure? [logic!]
		only?	[logic!]
		return: [red-value!]
		/local
			action-random
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/random"]]

		action-random: as function! [
			value	[red-value!]
			seed?	[logic!]
			secure? [logic!]
			only?	[logic!]
			return: [red-value!]
		] get-action-ptr value ACT_RANDOM

		action-random value seed? secure? only?
	]

	reflect*: func [
		return: [red-block!]
	][
		reflect stack/arguments as red-word! stack/arguments + 1
	]

	reflect: func [
		value	[red-value!]
		field	[red-word!]
		return: [red-block!]
		/local
			action-reflect
	][
		action-reflect: as function! [
			value	[red-value!]
			field	[integer!]
			return:	[red-block!]
		] get-action-ptr-from TYPE_OF(value) ACT_REFLECT

		action-reflect value field/symbol
	]

	to*: func [
		return: [red-value!]
	][
		to as red-datatype! stack/arguments stack/arguments + 1
	]

	to: func [
		type	[red-datatype!]
		spec	[red-value!]
		return: [red-value!]
		/local
			action-to
	][
		if TYPE_OF(spec) = type/value [return stack/set-last spec]

		action-to: as function! [
			type	[red-datatype!]
			spec	[red-value!]
			return: [red-value!]
		] get-action-ptr-from TYPE_OF(spec) ACT_TO

		action-to type spec
	]

	form*: func [
		part	   [integer!]
		/local
			arg	   [red-value!]
			buffer [red-string!]
			int    [red-integer!]
			limit  [integer!]
	][
		arg: stack/arguments + part

		limit: either part >= 0 [
			int: as red-integer! arg
			int/value
		][0]

		stack/keep										;-- keep last value
		buffer: string/rs-make-at stack/push* 16		;@@ /part argument
		limit: form stack/arguments buffer arg limit

		if all [part >= 0 negative? limit][
			string/truncate-from-tail GET_BUFFER(buffer) limit
		]
		stack/set-last as red-value! buffer
	]

	form: func [
		value   [red-value!]							;-- FORM argument
		buffer  [red-string!]							;-- FORM buffer
		arg		[red-value!]							;-- max bytes count
		part	[integer!]
		return: [integer!]
		/local
			action-form
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/form"]]

		action-form: as function! [
			value	[red-value!]						;-- FORM argument
			buffer	[red-string!]						;-- FORM buffer
			arg		[red-value!]						;-- max bytes count
			part	[integer!]
			return: [integer!]							;-- remaining part count
		] get-action-ptr value ACT_FORM

		action-form value buffer arg part
	]

	mold*: func [
		only	[integer!]
		_all	[integer!]
		flat	[integer!]
		part	[integer!]
		/local
			arg	   [red-value!]
			buffer [red-string!]
			int    [red-integer!]
			limit  [integer!]
	][
		arg: stack/arguments + part

		limit: either part >= 0 [
			int: as red-integer! arg
			int/value
		][0]

		stack/keep										;-- keep last value
		buffer: string/rs-make-at stack/push* 16		;@@ /part argument
		limit: mold
			stack/arguments
			buffer
			as logic! only + 1
			as logic! _all + 1
			as logic! flat + 1
			arg
			limit
			0

		if all [part >= 0 negative? limit][
			string/truncate-from-tail GET_BUFFER(buffer) limit
		]
		stack/set-last as red-value! buffer
	]

	mold: func [
		value    [red-value!]							;-- MOLD argument
		buffer   [red-string!]							;-- MOLD buffer
		only?	 [logic!]
		all?	 [logic!]
		flat?	 [logic!]
		arg		 [red-value!]
		part     [integer!]								;-- max bytes count
		indent	 [integer!]
		return:  [integer!]
		/local
			action-mold
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/mold"]]

		action-mold: as function! [
			value	 [red-value!]						;-- FORM argument
			buffer	 [red-string!]						;-- FORM buffer
			only?	 [logic!]
			all?	 [logic!]
			flat?	 [logic!]
			part-arg [red-value!]
			part	 [integer!]							;-- max bytes count
			indent	 [integer!]
			return:  [integer!]							;-- remaining part count
		] get-action-ptr value ACT_MOLD

		action-mold value buffer only? all? flat? arg part indent
	]

	eval-path*: func [
		set?	[logic!]
		return:	[red-value!]
		/local
			value [red-value!]
	][
		value: either set? [stack/arguments + 2][null]
		stack/set-last eval-path
			stack/arguments
			stack/arguments + 1
			value
	]

	eval-path: func [
		parent	[red-value!]
		element	[red-value!]
		value	[red-value!]
		return:	[red-value!]
		/local
			action-path
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/eval-path"]]

		action-path: as function! [
			parent	[red-value!]
			element	[red-value!]
			value	[red-value!]
			return:	[red-value!]
		] get-action-ptr parent ACT_EVALPATH

		action-path parent element value
	]

	set-path*: func [][]

	compare*: func [
		op		[comparison-op!]
		return: [red-logic!]
		/local
			result [red-logic!]
	][
		result: as red-logic! stack/arguments
		result/value: compare stack/arguments stack/arguments + 1 op
		result/header: TYPE_LOGIC
		result
	]

	compare: func [
		value1  [red-value!]
		value2  [red-value!]
		op	    [comparison-op!]
		return: [logic!]
		/local
			action-compare value res
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/compare"]]

		action-compare: as function! [
			value1  [red-value!]						;-- first operand
			value2  [red-value!]						;-- second operand
			op	    [integer!]							;-- type of comparison
			return: [integer!]
		] get-action-ptr value1 ACT_COMPARE

		value: action-compare value1 value2 op
		if all [
			value = -2
			op <> COMP_EQUAL
			op <> COMP_STRICT_EQUAL
			op <> COMP_NOT_EQUAL
		][
			--NOT_IMPLEMENTED--
			value
		]
		switch op [
			COMP_EQUAL
			COMP_STRICT_EQUAL 	[res: value =  0]
			COMP_NOT_EQUAL 		[res: value <> 0]
			COMP_LESSER			[res: value <  0]
			COMP_LESSER_EQUAL	[res: value <= 0]
			COMP_GREATER		[res: value >  0]
			COMP_GREATER_EQUAL	[res: value >= 0]
		]
		res
	]

	compare-value: func [								;-- Compare function return integer!
		value1  [red-value!]
		value2  [red-value!]
		op		[comparison-op!]
		return: [integer!]
		/local
			action-compare res
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/compare-value"]]

		action-compare: as function! [
			value1  [red-value!]						;-- first operand
			value2  [red-value!]						;-- second operand
			op	    [integer!]							;-- type of comparison
			return: [integer!]
		] get-action-ptr value1 ACT_COMPARE

		switch TYPE_OF(value1) [
			TYPE_LOGIC	 [res: value1/data1 - value2/data1]
			TYPE_NATIVE
			TYPE_ACTION
			TYPE_FUNCTION
			TYPE_OP
			TYPE_ROUTINE [res: SIGN_COMPARE_RESULT(value1/data3 value2/data3)]
			TYPE_NONE
			TYPE_UNSET	 [res: 0]
			default		 [res: action-compare value1 value2 op]
		]
		res
	]

	absolute*: func [
		return:	[red-value!]
		/local
			action-absolute
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/absolute"]]

		action-absolute: as function! [
			return:	[red-value!]						;-- absoluted value
		] get-action-ptr* ACT_ABSOLUTE
		action-absolute
	]

	add*: func [
		return:	[red-value!]
		/local
			action-add
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/add"]]

		action-add: as function! [
			return:	[red-value!]						;-- addition resulting value
		] get-action-ptr* ACT_ADD
		action-add
	]

	divide*: func [
		return:	[red-value!]
		/local
			action-divide
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/divide"]]

		action-divide: as function! [
			return:	[red-value!]						;-- division resulting value
		] get-action-ptr* ACT_DIVIDE
		action-divide
	]

	multiply*: func [
		return:	[red-value!]
		/local
			action-multiply
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/multiply"]]

		action-multiply: as function! [
			return:	[red-value!]						;-- multiplication resulting value
		] get-action-ptr* ACT_MULTIPLY
		action-multiply
	]

	negate*: func [
		return:	[red-value!]
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/negate"]]

		negate-action stack/arguments
	]

	negate-action: func [								;-- negate is a Red/System keyword
		value	[red-value!]
		return:	[red-value!]
		/local
			action-negate
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/negate"]]

		action-negate: as function! [
			value	[red-value!]
			return:	[red-value!]						;-- negated value
		] get-action-ptr value ACT_NEGATE

		action-negate value
	]

	power*: func [
		return:	[red-value!]
		/local
			action-power
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/power"]]

		action-power: as function! [
			return:	[red-value!]						;-- addition resulting value
		] get-action-ptr* ACT_POWER
		action-power
	]

	remainder*: func [
		return:	  [red-value!]
		/local
			action-remainder
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/remainder"]]

		action-remainder: as function! [
			return:	  [red-value!]
		] get-action-ptr* ACT_REMAINDER
		action-remainder
	]

	round*: func [
		_to		  [integer!]
		even	  [integer!]
		down	  [integer!]
		half-down [integer!]
		floor	  [integer!]
		ceil	  [integer!]
		half-ceil [integer!]
		/local
			scale [red-value!]
	][
		scale: stack/arguments + _to
		round
			stack/arguments
			scale
			as logic! even	+ 1
			as logic! down	+ 1
			as logic! half-down + 1
			as logic! floor + 1
			as logic! ceil  + 1
			as logic! half-ceil + 1
	]

	round: func [
		value		[red-value!]
		scale		[red-value!]
		_even?		[logic!]
		down?		[logic!]
		half-down?	[logic!]
		floor?		[logic!]
		ceil?		[logic!]
		half-ceil?	[logic!]
		return:		[red-value!]
		/local
			action-round
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/round"]]

		action-round: as function! [
			value		[red-value!]
			scale		[red-value!]
			_even?		[logic!]
			down?		[logic!]
			half-down?	[logic!]
			floor?		[logic!]
			ceil?		[logic!]
			half-ceil?	[logic!]
			return:		[red-value!]
		] get-action-ptr value ACT_ROUND

		action-round value scale _even? down? half-down? floor? ceil? half-ceil?
	]

	subtract*: func [
		return:	[red-value!]
		/local
			action-subtract
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/subtract"]]

		action-subtract: as function! [
			return:	[red-value!]						;-- addition resulting value
		] get-action-ptr* ACT_SUBTRACT
		action-subtract
	]

	even?*: func [
		return:	[red-logic!]
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/even?"]]

		logic/box even? stack/arguments
	]

	even?: func [
		value	[red-value!]
		return: [logic!]
		/local
			action-even?
	][
		action-even?: as function! [
			value	[red-value!]
			return: [logic!]							;-- TRUE if value is even.
		] get-action-ptr value ACT_EVEN?

		action-even? value
	]

	odd?*: func [
		return:	[red-logic!]
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/odd?"]]

		logic/box odd? stack/arguments
	]

	odd?: func [
		value	[red-value!]
		return: [logic!]
		/local
			action-odd?
	][
		action-odd?: as function! [
			value	[red-value!]
			return: [logic!]							;-- TRUE if value is odd.
		] get-action-ptr value ACT_ODD?

		action-odd? value
	]

	and~*: func [
		return:	[red-value!]
		/local
			action-and~
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/and~"]]

		action-and~: as function! [
			return:	[red-value!]						;-- division resulting value
		] get-action-ptr* ACT_AND~
		action-and~
	]

	complement*: does [
		stack/set-last complement stack/arguments
	]

	complement: func [
		value	[red-value!]
		return:	[red-value!]
		/local
			action-complement
	][
		action-complement: as function! [
			value	[red-value!]
			return:	[red-value!]						;-- complemented value
		] get-action-ptr value ACT_COMPLEMENT

		action-complement value
	]

	or~*: func [
		return:	[red-value!]
		/local
			action-or~
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/or~"]]

		action-or~: as function! [
			return:	[red-value!]						;-- division resulting value
		] get-action-ptr* ACT_OR~
		action-or~
	]

	xor~*: func [
		return:	[red-value!]
		/local
			action-xor~
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/xor~"]]

		action-xor~: as function! [
			return:	[red-value!]						;-- division resulting value
		] get-action-ptr* ACT_XOR~
		action-xor~
	]

	append*: func [
		part  [integer!]
		only  [integer!]
		dup   [integer!]
	][
		; assert ANY-SERIES?(TYPE_OF(stack/arguments))
		insert
			as red-series! stack/arguments
			stack/arguments + 1
			stack/arguments + part
			as logic! only + 1
			stack/arguments + dup
			yes
	]

	at*: func [
		return:	[red-value!]
		/local
			action-at
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/at"]]

		action-at: as function! [
			return:	[red-value!]						;-- picked value from series
		] get-action-ptr* ACT_AT
		action-at
	]

	back*: func [
		return:	[red-value!]
		/local
			action-back
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/back"]]

		action-back: as function! [
			return:	[red-value!]						;-- picked value from series
		] get-action-ptr* ACT_BACK
		action-back
	]

	change*: func [][]

	clear*: func [
		return:	[red-value!]
		/local
			action-clear
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/clear"]]
		clear stack/arguments
	]

	clear: func [
		value	[red-value!]
		return:	[red-value!]
		/local
			action-clear
	][
		action-clear: as function! [
			value	[red-value!]
			return:	[red-value!]						;-- argument series
		] get-action-ptr value ACT_CLEAR

		action-clear value
	]

	copy*: func [
		part	[integer!]
		deep	[integer!]
		types	[integer!]
		return:	[red-value!]
	][
		stack/set-last copy
			as red-series! stack/arguments
			stack/push*
			stack/arguments + part
			as logic! deep + 1
			stack/arguments + types
	]

	copy: func [
		series  [red-series!]
		new		[red-value!]
		part	[red-value!]
		deep?	[logic!]
		types	[red-value!]
		return:	[red-value!]
		/local
			action-copy
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/copy"]]

		new/header: series/header

		action-copy: as function! [
			series  [red-series!]
			new		[red-value!]
			part	[red-value!]
			deep?	[logic!]
			types	[red-value!]
			return: [red-series!]
		] get-action-ptr as red-value! series ACT_COPY

		action-copy series new part deep? types
		new
	]

	find*: func [
		part	 [integer!]
		only	 [integer!]
		case-arg [integer!]
		any-arg  [integer!]
		with-arg [integer!]
		skip	 [integer!]
		last	 [integer!]
		reverse	 [integer!]
		tail	 [integer!]
		match	 [integer!]
	][
		; assert ANY-SERIES?(TYPE_OF(stack/arguments))
		stack/set-last find
			as red-series! stack/arguments
			stack/arguments + 1
			stack/arguments + part
			as logic! only + 1
			as logic! case-arg + 1
			as logic! any-arg + 1
			as red-string!  stack/arguments + with-arg
			as red-integer! stack/arguments + skip
			as logic! last + 1
			as logic! reverse + 1
			as logic! tail + 1
			as logic! match + 1
	]

	find: func [
		series   [red-series!]
		value    [red-value!]
		part	 [red-value!]
		only?	 [logic!]
		case?	 [logic!]
		any?	 [logic!]
		with-arg [red-string!]
		skip	 [red-integer!]
		last?	 [logic!]
		reverse? [logic!]
		tail?	 [logic!]
		match?	 [logic!]
		return:  [red-value!]
		/local
			action-find
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/find"]]

		action-find: as function! [
			series   [red-series!]
			value    [red-value!]
			part	 [red-value!]
			only?	 [logic!]
			case?	 [logic!]
			any?	 [logic!]
			with-arg [red-string!]
			skip	 [red-integer!]
			last?	 [logic!]
			reverse? [logic!]
			tail?	 [logic!]
			match?	 [logic!]
			return:  [red-value!]
		] get-action-ptr as red-value! series ACT_FIND

		action-find series value part only? case? any? with-arg skip last? reverse? tail? match?
	]

	head*: func [
		return:	[red-value!]
		/local
			action-head
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/head"]]

		action-head: as function! [
			return:	[red-value!]						;-- picked value from series
		] get-action-ptr* ACT_HEAD
		action-head
	]

	head?*: func [
		return:	[red-value!]
		/local
			action-head?
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/head?"]]

		action-head?: as function! [
			return:	[red-value!]						;-- picked value from series
		] get-action-ptr* ACT_HEAD?
		action-head?
	]

	index?*: func [
		return:	[red-value!]
		/local
			action-index?
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/index?"]]

		action-index?: as function! [
			return:	[red-value!]						;-- picked value from series
		] get-action-ptr* ACT_INDEX?
		action-index?
	]

	insert*: func [
		part  [integer!]
		only  [integer!]
		dup   [integer!]
	][
		; assert ANY-SERIES?(TYPE_OF(stack/arguments))
		insert
			as red-series! stack/arguments
			stack/arguments + 1
			stack/arguments + part
			as logic! only + 1
			stack/arguments + dup
			no
	]

	insert: func [
		series  [red-series!]
		value   [red-value!]
		part	[red-value!]
		only?	[logic!]
		dup		[red-value!]
		append? [logic!]
		return:	[red-value!]
		/local
			action-insert
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/insert"]]

		action-insert: as function! [
			series  [red-series!]
			value   [red-value!]
			part	[red-value!]
			only?	[logic!]
			dup		[red-value!]
			append? [logic!]
			return:	[red-value!]						;-- series after insertion position
		] get-action-ptr as red-value! series ACT_INSERT

		action-insert series value part only? dup append?
	]

	length?*: func [
		return:	[red-integer!]
		/local
			int	  [red-integer!]
			value [integer!]
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/length?"]]

		int: as red-integer! stack/arguments
		value: length? stack/arguments					;-- must be set before slot is modified
		either value = -1 [
			none/push-last
		][
			int/value:  value
			int/header: TYPE_INTEGER
		]
		int
	]

	length?: func [
		value	[red-value!]
		return: [integer!]
		/local
			action-length?
	][
		action-length?: as function! [
			value	[red-value!]
			return:	[integer!]							;-- length of series
		] get-action-ptr value ACT_LENGTH?

		action-length? value
	]

	next*: func [
		return:	[red-value!]
		/local
			action-next
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/next"]]

		action-next: as function! [
			return:	[red-value!]						;-- next value from series
		] get-action-ptr* ACT_NEXT
		action-next
	]

	pick*: func [
		return:	 [red-value!]
	][
		stack/set-last pick
			as red-series! stack/arguments
			get-index-argument
			stack/arguments + 1
	]

	pick: func [
		series	[red-series!]
		index	[integer!]
		boxed	[red-value!]							;-- boxed index value
		return:	[red-value!]
		/local
			action-pick
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/pick"]]

		action-pick: as function! [
			series	[red-series!]
			index	[integer!]
			boxed	[red-value!]						;-- boxed index value
			return:	[red-value!]						;-- picked value from series
		] get-action-ptr as red-value! series ACT_PICK

		action-pick series index boxed
	]

	poke*: func [
		return:	[red-value!]
	][
		poke
			as red-series! stack/arguments
			get-index-argument
			stack/arguments + 2
			stack/arguments + 1

		stack/set-last stack/arguments
	]

	poke: func [
		series	[red-series!]
		index	[integer!]								;-- unboxed value
		data	[red-value!]
		boxed	[red-value!]							;-- boxed index value
		/local
			action-poke
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/poke"]]

		action-poke: as function! [
			series	[red-series!]
			index	[integer!]
			data	[red-value!]
			boxed	[red-value!]
			return:	[red-value!]						;-- picked value from series
		] get-action-ptr as red-value! series ACT_POKE

		action-poke series index data boxed
	]

	remove*: func [
		part [integer!]
	][
		remove
			as red-series! stack/arguments
			stack/arguments + part
	]

	remove: func [
		series  [red-series!]
		part	[red-value!]
		return:	[red-value!]
		/local
			action-remove
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/remove"]]

		action-remove: as function! [
			series	[red-series!]
			part	[red-value!]
			return:	[red-value!]
		] get-action-ptr as red-value! series ACT_REMOVE

		action-remove series part
	]

	reverse*: func [
		part [integer!]
	][
		reverse
			as red-series! stack/arguments
			stack/arguments + part
	]

	reverse: func [
		series  [red-series!]
		part	[red-value!]
		return:	[red-value!]
		/local
			action-reverse
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/reverse"]]

		action-reverse: as function! [
			series	[red-series!]
			part	[red-value!]
			return:	[red-value!]
		] get-action-ptr as red-value! series ACT_REVERSE

		action-reverse series part
	]

	select*: func [
		part	 [integer!]
		only	 [integer!]
		case-arg [integer!]
		any-arg  [integer!]
		with-arg [integer!]
		skip	 [integer!]
		last	 [integer!]
		reverse	 [integer!]
	][
		; assert ANY-SERIES?(TYPE_OF(stack/arguments))
		stack/set-last select
			as red-series! stack/arguments
			stack/arguments + 1
			stack/arguments + part
			as logic! only + 1
			as logic! case-arg + 1
			as logic! any-arg + 1
			as red-string!  stack/arguments + with-arg
			as red-integer! stack/arguments + skip
			as logic! last + 1
			as logic! reverse + 1
	]

	select: func [
		series   [red-series!]
		value    [red-value!]
		part	 [red-value!]
		only?	 [logic!]
		case?	 [logic!]
		any?	 [logic!]
		with-arg [red-string!]
		skip	 [red-integer!]
		last?	 [logic!]
		reverse? [logic!]
		return:  [red-value!]
		/local
			action-select
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/select"]]

		action-select: as function! [
			series   [red-series!]
			value    [red-value!]
			part	 [red-value!]
			only?	 [logic!]
			case?	 [logic!]
			any?	 [logic!]
			with-arg [red-string!]
			skip	 [red-integer!]
			last?	 [logic!]
			reverse? [logic!]
			return:  [red-value!]
		] get-action-ptr as red-value! series ACT_SELECT

		action-select series value part only? case? any? with-arg skip last? reverse?
	]

	sort*: func [
		case-arg [integer!]
		skip-arg [integer!]
		compare  [integer!]
		part	 [integer!]
		all-arg  [integer!]
		reverse	 [integer!]
		stable	 [integer!]
	][
		; assert ANY-SERIES?(TYPE_OF(stack/arguments))
		stack/set-last sort
			as red-series!   stack/arguments
			as logic!		 case-arg + 1
			as red-integer!  stack/arguments + skip-arg
			as red-function! stack/arguments + compare
			stack/arguments + part
			as logic! all-arg + 1
			as logic! reverse + 1
			as logic! stable + 1
	]

	sort: func [
		series   [red-series!]
		case?    [logic!]
		skip	 [red-integer!]
		compare	 [red-function!]
		part	 [red-value!]
		all?	 [logic!]
		reverse? [logic!]
		stable?  [logic!]
		return:  [red-value!]
		/local
			action-sort
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/sort"]]

		action-sort: as function! [
			series   [red-series!]
			case?    [logic!]
			skip	 [red-integer!]
			compare	 [red-function!]
			part	 [red-value!]
			all?	 [logic!]
			reverse? [logic!]
			stable?  [logic!]
			return:  [red-value!]
		] get-action-ptr as red-value! series ACT_SORT

		action-sort series case? skip compare part all? reverse? stable?
	]

	skip*: func [
		return:	[red-value!]
		/local
			action-skip
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/skip"]]

		action-skip: as function! [
			return:	[red-value!]						;-- picked value from series
		] get-action-ptr* ACT_SKIP
		action-skip
	]

	swap*: func [
		return: [red-series!]
	][
		swap
			as red-series! stack/arguments
			as red-series! stack/arguments + 1
	]

	swap: func [
		series1 [red-series!]
		series2	[red-series!]
		return:	[red-series!]
		/local
			action-swap
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/swap"]]

		action-swap: as function! [
			series1	[red-series!]
			series2	[red-series!]
			return:	[red-series!]
		] get-action-ptr as red-value! series1 ACT_SWAP

		action-swap series1 series2
	]

	tail*: func [
		return:	[red-value!]
		/local
			action-tail
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/tail"]]

		action-tail: as function! [
			return:	[red-value!]						;-- picked value from series
		] get-action-ptr* ACT_TAIL
		action-tail
	]

	tail?*: func [
		return:	[red-value!]
		/local
			action-tail?
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/tail?"]]

		action-tail?: as function! [
			return:	[red-value!]						;-- picked value from series
		] get-action-ptr* ACT_TAIL?
		action-tail?
	]

	take*: func [
		part	[integer!]
		deep	[integer!]
		last	[integer!]
		return:	[red-value!]
	][
		stack/set-last take
			as red-series! stack/arguments
			stack/arguments + part
			as logic! deep + 1
			as logic! last + 1
	]

	take: func [
		series  [red-series!]
		part	[red-value!]
		deep?	[logic!]
		last?	[logic!]
		return:	[red-value!]
		/local
			action-take
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/take"]]

		action-take: as function! [
			series  [red-series!]
			part	[red-value!]
			deep?	[logic!]
			last?	[logic!]
			return: [red-value!]
		] get-action-ptr as red-value! series ACT_TAKE

		action-take series part deep? last?
	]

	trim*: func [
		head	[integer!]
		tail	[integer!]
		auto	[integer!]
		lines	[integer!]
		_all	[integer!]
		with-arg [integer!]
		return:	[red-series!]
	][
		trim
			as red-series! stack/arguments
			as logic! head  + 1
			as logic! tail  + 1
			as logic! auto  + 1
			as logic! lines + 1
			as logic! _all  + 1
			stack/arguments + with-arg
	]

	trim: func [
		series  [red-series!]
		head?	[logic!]
		tail?	[logic!]
		auto?	[logic!]
		lines?	[logic!]
		all?	[logic!]
		with-arg [red-value!]
		return:	[red-series!]
		/local
			action-trim
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/trim"]]

		action-trim: as function! [
			series  [red-series!]
			head?	[logic!]
			tail?	[logic!]
			auto?	[logic!]
			lines?	[logic!]
			all?	[logic!]
			with-arg [red-value!]
			return:	[red-series!]
		] get-action-ptr as red-value! series ACT_TRIM

		action-trim series head? tail? auto? lines? all? with-arg
	]

	create*: func [][]
	close*: func [][]
	delete*: func [][]
	modify*: func [][]
	open*: func [][]
	open?*: func [][]
	query*: func [][]
	read*: func [][]
	rename*: func [][]
	update*: func [][]
	write*: func [][]

	init: does [
		table: as int-ptr! allocate ACTIONS_NB * size? integer!

		register [
			;-- General actions --
			:make*
			:random*
			:reflect*
			:to*
			:form*
			:mold*
			:eval-path*
			null			;set-path
			:compare
			;-- Scalar actions --
			:absolute*
			:add*
			:divide*
			:multiply*
			:negate*
			:power*
			:remainder*
			:round*
			:subtract*
			:even?*
			:odd?*
			;-- Bitwise actions --
			:and~*
			:complement*
			:or~*
			:xor~*
			;-- Series actions --
			:append*
			:at*
			:back*
			null			;change
			:clear*
			:copy*
			:find*
			:head*
			:head?*
			:index?*
			:insert*
			:length?*
			:next*
			:pick*
			:poke*
			:remove*
			:reverse*
			:select*
			:sort*
			:skip*
			:swap*
			:tail*
			:tail?*
			:take*
			:trim*
			;-- I/O actions --
			null			;create
			null			;close
			null			;delete
			null			;modify
			null			;open
			null			;open?
			null			;query
			null			;read
			null			;rename
			null			;update
			null			;write
		]
	]
]