TESTS: uncommented test for issue #765

TESTS: uncommented test for issue #765

Red [
	Title:   "Red find test script"
	Author:  "Nenad Rakocevic & Peter W A Wood"
	File: 	 %find-test.red
	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~~~ "find"

===start-group=== "find"
	--test-- "find-1"
		--assert [1 2 3 4] = find [1 2 3 4] 1
	--test-- "find-2"
		--assert [2 3 4] = find [1 2 3 4] 2
	--test-- "find-3"
		--assert [4] = find [1 2 3 4] 4
	--test-- "find-4"
		--assert none = find [1 2 3 4] 0
	--test-- "find-5"
		--assert none = find [1 2 3 4] 5
	--test-- "find-6"
		--assert none = find [1 2 3 4] "1"
	--test-- "find-7"
		--assert "12345" = find "12345" #"1"
	;--test-- "find-8" 							;; unsupported case, it is unsure if it will be implemented or not
	;--assert "12345" = find "12345" 1			;; keeping it here commented for further reference.
	--test-- "find-9"
		--assert "12345" = find "12345" "1"
	--test-- "find-10"
		--assert "12345" = find "12345" "12"
	--test-- "find-11"
		--assert "2345" = find "12345" #"2"
	--test-- "find-12"
		--assert "5" = find "12345" #"5"
	--test-- "find-13"
		--assert none = find "12345" #"0"
	--test-- "find-14"
		--assert none = find "12345" #"6"
	--test-- "find-15"
		--assert [2 3] = find [1 2 3] [2 3]
	--test-- "find-16"
		--assert none = find [1 2 3] [3 2]
	--test-- "find-17"
		--assert [2 3] = find [1 2 2 3] [2 3]
	--test-- "find-18"
		--assert none = find [1 2] [2 3]
	--test-- "find-19"
		--assert "é" = find "abcdeé" "é"
	--test-- "find-20"
		--assert "eé" = find "abcdeé" "eé"
	--test-- "find-21"
		--assert none = find "abcdeé" "ée"
	--test-- "find-22"
		--assert "✐" = find "abcde✐" "✐"            ;; code point 10000 (decimal)
	--test-- "find-23"
		--assert none = find "abcde✐" "ed✐"
	--test-- "find-24"
		--assert "^(010000)" = find "abcde^(010000)" "^(010000)"
	--test-- "find-25"
		--assert none = find tail "123345" 1
	--test-- "find-26 -issue #765"
		--assert none = find tail [a b c d e] 'a

===end-group===

===start-group=== "find/part"
	--test-- "find/part-1"
		--assert none = find/part "1234" "1" 0
	--test-- "find/part-2"
		--assert "1234" = find/part "1234" "1" 1
	--test-- "find/part-3"
		--assert "234" = find/part "1234" "2" 2
	--test-- "find/part-4"
		--assert "234" = find/part "1234" "2" 4
	--test-- "find/part-5"
		--assert "234" = find/part "1234" "2" 5
	--test-- "find/part-6"
		--assert none = find/part "1234" "3" 2
	--test-- "find/part-7"
		--assert none = find/part [1 2 3 4] 1 0
	--test-- "find/part-8"
		--assert [1 2 3 4] = find/part [1 2 3 4] 1 1
	--test-- "find/part-9"
		--assert [2 3 4] = find/part [1 2 3 4] 2 2
	--test-- "find/part-10"
		--assert [2 3 4] = find/part [1 2 3 4] [2 3] 4
	--test-- "find/part-11"
		--assert none = find/part [1 2 3 4] [2 3] 2
	--test-- "find/part-12"
		--assert none = find/part [1 2 3 4] 3 2
	--test-- "find/part-13"
		--assert none = find/part "Χαῖρε, κόσμε!" "Χαῖ" 2
===end-group===

===start-group=== "find/only"
	--test-- "find/only-1"
		--assert [[2 3] 4] = find/only [1 [2 3] 4] [2 3]
	--test-- "find/only-2"
		--assert none = find/only [1 2 3 4] [2 3]
===end-group===

===start-group=== "find/case"
	--test-- "find/case-1"
		--assert "abcde" = find/case "Aabcde" "a"
	--test-- "find/case-2"
		--assert "Abcde" = find/case "aAbcde" "A"
	--test-- "find/case-3"
		--assert none = find/case "è" "E"
===end-group===

===start-group=== "find/any"      ; not yet implemented
	--test-- "find/any-1"
		;--assert "12345" = find/any "12345" "*"
	--test-- "find/any-2"
		;--assert "12345" = find/any "12345" "?"
	--test-- "find/any-3"
		;--assert "2345" = find/any "12345" "2?4"
	--test-- "find/any-4"
		;--assert "2345" = find/any "12345" "2*"
	--test-- "find/any-5"
		;--assert "e✐" = find/any "abcde✐" "e?"        ;; code point 10000 (decimal)
	--test-- "find/any-6"
		;--assert "e✐f" = find/any "abcde✐f" "?f"
	--test-- "find/any-7"
		;--assert "e✐" = find/any "abcde✐" "e*"
	--test-- "find/any-8"
		;--assert "abcde✐f" = find/any "abcde✐f" "*f"
	--test-- "find/any-9"
		;--assert "e^(010000)" = find/any "abcde^(010000)" "e?"
	--test-- "find/any-10"
		;--assert "e^(010000)f" = find/any "abcde^(010000)f" "?f"
	--test-- "find/any-11"
		;--assert "e^(010000)" = find/any "abcde^(010000)" "e*"
	--test-- "find/any-12"
		;--assert "abcde^(010000)f" = find/any "abcde^(010000)f" "*f"
===end-group===

===start-group=== "find/with"      ; not yet implemented
	--test-- "find/with-1"
		;--assert "12345" = find/with "12345" "^(FFFF)" "^(FFFE)^(FFFF)"
	--test-- "find/with-2"
		;--assert "12345" = find/with "12345" "^(FFFE)" "^(FFFE)^(FFFF)"
	--test-- "find/with-3"
		;--assert "2345" = find/with "12345" "2^(FFFE)3" "^(FFFE)^(FFFF)"
	--test-- "find/with-4"
		;--assert "2345" = find/with "12345" "2^(FFFF)" "^(FFFE)^(FFFF)"
	--test-- "find/with-5"
		;--assert "e✐" = find/with "abcde✐" "e^(FFFE)" "^(FFFE)^(FFFF)"
	--test-- "find/with-6"
		;--assert "e✐f" = find/with "abcde✐f" "^(FFFE)f" "^(FFFE)^(FFFF)"
	--test-- "find/with-7"
		;--assert "e✐" = find/with "abcde✐" "e^(FFFF)" "^(FFFE)^(FFFF)"
	--test-- "find/with-8"
		;--assert "abcde✐f" = find/with "abcde✐f" "^(FFFF)f" "^(FFFE)^(FFFF)"
	--test-- "find/with-9"
		;--assert "e^(010000)" = find/with "abcde^(010000)" "e^(FFFE)" "^(FFFE)^(FFFF)"
	--test-- "find/with-10"
		;--assert "e^(010000)f" = find/with "abcde^(010000)f" "^(FFFE)f" "^(FFFE)^(FFFF)"
	--test-- "find/with-11"
		;--assert "e^(010000)" = find/with "abcde^(010000)" "e^(FFFF)" "^(FFFE)^(FFFF)"
	--test-- "find/with-12"
		;--assert "abcde^(010000)f" = find/with "abcde^(010000)f" "^(FFFF)f" "^(FFFE)^(FFFF)"
===end-group===

===start-group=== "find/skip"
	--test-- "find/skip-1"
		--assert [6 7 8 9 0] = find/skip [1 2 3 4 5 1 6 6 6 6 1 2 3 4 5 6 7 8 9 0] 6 5
	--test-- "find/skip-2"
		--assert none = find/skip [1 2 3 4 5 1 6 6 6 6 1 2 3 4 5 1 2 3 4 5] 6 5
	--test-- "find/skip-3"
		--assert [6 7 8 9 0] = find/skip [1 2 3 4 5 6 6 6 6 6 1 2 3 4 5 6 7 8 9 0] [6 7] 5
	--test-- "find/skip-4"
		--assert none = find/skip [1 2 3 4 5 1 6 6 6 6 1 2 3 4 5 1 2 3 4 5] [6 7] 5
	--test-- "find/skip-5"
		--assert "67890" = find/skip "12345166661234567890" "6" 5
	--test-- "find/skip-6"
		--assert none = find/skip "12345166661234557890" "6" 5
===end-group===

===start-group=== "find/match"
	--test-- "find/match-1"
		--assert [and now] = find/match [here and now] 'here
	--test-- "find/match-2"
		--assert none = find/match [here and now] 'her
	--test-- "find/match-3"
		--assert none = find/match [her and now] 'here
	--test-- "find/match-4"
		--assert " and now" = find/match "here and now" "here"
	--test-- "find/match-5"
		--assert "andnow" = find/match "hereandnow" "here"
	--test-- "find/match-6"
		--assert none = find/match "her and now" "here"
	--test-- "find/match-7"
		--assert " and now" = find/match "here✐ and now" "here✐"
	--test-- "find/match-8"
		--assert "✐andnow" = find/match "here✐andnow" "here"
	--test-- "find/match-9"
		--assert none = find/match "her and now" "he✐r"
	--test-- "find/match-10"
		--assert none = find/match "here and now" "✐here"
	--test-- "find/match-11"
		--assert "^(010000)andnow" = find/match "here^(010000)andnow" "here"
	--test-- "find/match-12"
		--assert none = find/match "her and now" "here^(010000)"
	--test-- "find/match-13"
		--assert " and now" = find/match "here^(010000) and now" "here^(010000)"
	--test-- "find/match-14"
		--assert "andnow" = find/match "^(010000)hereandnow" "^(010000)here"
	--test-- "find/match-15"
		--assert none = find/match "her^(010000) and now" "here^(010000)"
	--test-- "find/match-16"
		--assert [and now] = find/match [he✐re and now] 'he✐re
===end-group===

===start-group=== "find/tail"
	--test-- "find/tail-1"
		--assert [and now] = find/tail [here and now] 'here
	--test-- "find/tail-2"
		--assert none = find/tail [here and now] 'her
	--test-- "find/tail-3"
		--assert none = find/tail [her and now] 'here
	--test-- "find/tail-4"
		--assert " and now" = find/tail "here and now" "here"
	--test-- "find/tail-5"
		--assert "andnow" = find/tail "hereandnow" "here"
	--test-- "find/tail-6"
		--assert none = find/tail "her and now" "here"
	--test-- "find/tail-7"
		--assert " and now" = find/tail "here✐ and now" "here✐"
	--test-- "find/tail-8"
		--assert "✐andnow" = find/tail "here✐andnow" "here"
	--test-- "find/tail-9"
		--assert none = find/tail "her and now" "he✐r"
	--test-- "find/tail-10"
		--assert none = find/tail "here and now" "✐here"
	--test-- "find/tail-11"
		--assert "^(010000)andnow" = find/tail "here^(010000)andnow" "here"
	--test-- "find/tail-12"
		--assert none = find/tail "her and now" "here^(010000)"
	--test-- "find/tail-13"
		--assert " and now" = find/tail "here^(010000) and now" "here^(010000)"
	--test-- "find/tail-14"
		--assert "andnow" = find/tail "^(010000)hereandnow" "^(010000)here"
	--test-- "find/tail-15"
		--assert none = find/tail "her^(010000) and now" "here^(010000)"
	--test-- "find/tail-16"
		--assert [and now] = find/tail [he✐re and now] 'he✐re
	--test-- "find/tail-17 issue #457"
		--assert "de" = find/tail "abcde" #"c"
	--test-- "find-tail-18"
		--assert "de" = find/tail "abc^^de" #"^^"

===end-group===

===start-group=== "find/last"
	--test-- "find/last-1"
		--assert [1] = find/last [1 1 1 1] 1
		--assert 4 = index? find/last [1 1 1 1] 1
	--test-- "find/last-2"
		--assert [2 1] = find/last [1 2 3 4 3 2 1] 2
	--test-- "find/last-3"
		--assert [3 3 2 1] = find/last [1 2 3 3 2 1] [3 3]
	--test-- "find/last-4"
		--assert "3321" = find/last "123321" "33"
	--test-- "find/last-5"
		--assert "321" = find/last "123321" "3"
	--test-- "find/last-6"
		--assert "1" = find/last "1111" "1"
	--test-- "find/last-7"
		--assert none = find/last "123" "34"
	--test-- "find/last-8"
		--assert "✐5678" = find/last "1234✐5678" "✐"
	--test-- "find/last-9"
		--assert "^(010000)5678" = find/last "1234^(010000)5678" "^(010000)"
===end-group===

===start-group=== "find/reverse"
	--test-- "find/reverse-1"
		--assert none = find/reverse [1 1 1 1] 1
	--test-- "find/reverse-2"
		--assert [2 1] = find/reverse tail [1 2 3 4 3 2 1] 2
	--test-- "find/reverse-3"
		--assert [3 3 2 1] = find/reverse tail [1 2 3 3 2 1] [3 3]
	--test-- "find/reverse-4"
		--assert "3321" = find/reverse back back back tail "123321" "33"
	--test-- "find/reverse-5"
		--assert "3321" = find/reverse back back back tail"123321" "3"
	--test-- "find/reverse-6"
		--assert "1" = find/reverse tail "1111" "1"
	--test-- "find/reverse-7"
		--assert none = find/reverse tail "123" "34"
	--test-- "find/reverse-8"
		--assert "✐5678" = find/reverse tail "1234✐5678" "✐"
	--test-- "find/reverse-9"
		--assert "^(010000)5678" = find/reverse tail "1234^(010000)5678" "^(010000)"
	--test-- "find/reverse-10 issue #505"
		--assert "ab" = find/reverse tail "ab" #"a"
		--assert "ab" = find/reverse tail "ab" "ab"
		--assert [a b] = find/reverse tail [a b] 'a
		--assert [a b] = find/reverse tail [a b] [a b]
===end-group===

===start-group=== "find/last/tail"
	--test-- "find/last/tail-1 issue #459"
		--assert [7 8] = find/last/tail [1 2 3 4 5 6 3 7 8] 3
	--test-- "find/last/tail-2 issue #459"
		--assert "78" = find/last/tail "123456378" #"3"
	--test-- "find/last/tail-3"
		--assert "78" = find/last/tail "123456378" "3"
===end-group===

~~~end-file~~~

Red [
	Title:   "Red find test script"
	Author:  "Nenad Rakocevic & Peter W A Wood"
	File: 	 %find-test.red
	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~~~ "find"

===start-group=== "find"
	--test-- "find-1"
		--assert [1 2 3 4] = find [1 2 3 4] 1
	--test-- "find-2"
		--assert [2 3 4] = find [1 2 3 4] 2
	--test-- "find-3"
		--assert [4] = find [1 2 3 4] 4
	--test-- "find-4"
		--assert none = find [1 2 3 4] 0
	--test-- "find-5"
		--assert none = find [1 2 3 4] 5
	--test-- "find-6"
		--assert none = find [1 2 3 4] "1"
	--test-- "find-7"
		--assert "12345" = find "12345" #"1"
	;--test-- "find-8" 							;; unsupported case, it is unsure if it will be implemented or not
	;--assert "12345" = find "12345" 1			;; keeping it here commented for further reference.
	--test-- "find-9"
		--assert "12345" = find "12345" "1"
	--test-- "find-10"
		--assert "12345" = find "12345" "12"
	--test-- "find-11"
		--assert "2345" = find "12345" #"2"
	--test-- "find-12"
		--assert "5" = find "12345" #"5"
	--test-- "find-13"
		--assert none = find "12345" #"0"
	--test-- "find-14"
		--assert none = find "12345" #"6"
	--test-- "find-15"
		--assert [2 3] = find [1 2 3] [2 3]
	--test-- "find-16"
		--assert none = find [1 2 3] [3 2]
	--test-- "find-17"
		--assert [2 3] = find [1 2 2 3] [2 3]
	--test-- "find-18"
		--assert none = find [1 2] [2 3]
	--test-- "find-19"
		--assert "é" = find "abcdeé" "é"
	--test-- "find-20"
		--assert "eé" = find "abcdeé" "eé"
	--test-- "find-21"
		--assert none = find "abcdeé" "ée"
	--test-- "find-22"
		--assert "✐" = find "abcde✐" "✐"            ;; code point 10000 (decimal)
	--test-- "find-23"
		--assert none = find "abcde✐" "ed✐"
	--test-- "find-24"
		--assert "^(010000)" = find "abcde^(010000)" "^(010000)"
	--test-- "find-25"
		--assert none = find tail "123345" 1
	--test-- "find-26 -issue #765"
		;;--assert none = find tail [a b c d e] 'a
		;; the above assert crashes the interpreter

===end-group===

===start-group=== "find/part"
	--test-- "find/part-1"
		--assert none = find/part "1234" "1" 0
	--test-- "find/part-2"
		--assert "1234" = find/part "1234" "1" 1
	--test-- "find/part-3"
		--assert "234" = find/part "1234" "2" 2
	--test-- "find/part-4"
		--assert "234" = find/part "1234" "2" 4
	--test-- "find/part-5"
		--assert "234" = find/part "1234" "2" 5
	--test-- "find/part-6"
		--assert none = find/part "1234" "3" 2
	--test-- "find/part-7"
		--assert none = find/part [1 2 3 4] 1 0
	--test-- "find/part-8"
		--assert [1 2 3 4] = find/part [1 2 3 4] 1 1
	--test-- "find/part-9"
		--assert [2 3 4] = find/part [1 2 3 4] 2 2
	--test-- "find/part-10"
		--assert [2 3 4] = find/part [1 2 3 4] [2 3] 4
	--test-- "find/part-11"
		--assert none = find/part [1 2 3 4] [2 3] 2
	--test-- "find/part-12"
		--assert none = find/part [1 2 3 4] 3 2
	--test-- "find/part-13"
		--assert none = find/part "Χαῖρε, κόσμε!" "Χαῖ" 2
===end-group===

===start-group=== "find/only"
	--test-- "find/only-1"
		--assert [[2 3] 4] = find/only [1 [2 3] 4] [2 3]
	--test-- "find/only-2"
		--assert none = find/only [1 2 3 4] [2 3]
===end-group===

===start-group=== "find/case"
	--test-- "find/case-1"
		--assert "abcde" = find/case "Aabcde" "a"
	--test-- "find/case-2"
		--assert "Abcde" = find/case "aAbcde" "A"
	--test-- "find/case-3"
		--assert none = find/case "è" "E"
===end-group===

===start-group=== "find/any"      ; not yet implemented
	--test-- "find/any-1"
		;--assert "12345" = find/any "12345" "*"
	--test-- "find/any-2"
		;--assert "12345" = find/any "12345" "?"
	--test-- "find/any-3"
		;--assert "2345" = find/any "12345" "2?4"
	--test-- "find/any-4"
		;assert "2345" = find/any "12345" "2*"
	--test-- "find/any-5"
		;assert "e✐" = find/any "abcde✐" "e?"        ;; code point 10000 (decimal)
	--test-- "find/any-6"
		;assert "e✐f" = find/any "abcde✐f" "?f"
	--test-- "find/any-7"
		;assert "e✐" = find/any "abcde✐" "e*"
	--test-- "find/any-8"
		;assert "abcde✐f" = find/any "abcde✐f" "*f"
	--test-- "find/any-9"
		;assert "e^(010000)" = find/any "abcde^(010000)" "e?"
	--test-- "find/any-10"
		;assert "e^(010000)f" = find/any "abcde^(010000)f" "?f"
	--test-- "find/any-11"
		;assert "e^(010000)" = find/any "abcde^(010000)" "e*"
	--test-- "find/any-12"
		;assert "abcde^(010000)f" = find/any "abcde^(010000)f" "*f"
===end-group===

===start-group=== "find/with"      ; not yet implemented
	--test-- "find/with-1"
		;--assert "12345" = find/with "12345" "^(FFFF)" "^(FFFE)^(FFFF)"
	--test-- "find/with-2"
		;--assert "12345" = find/with "12345" "^(FFFE)" "^(FFFE)^(FFFF)"
	--test-- "find/with-3"
		;--assert "2345" = find/with "12345" "2^(FFFE)3" "^(FFFE)^(FFFF)"
	--test-- "find/with-4"
		;assert "2345" = find/with "12345" "2^(FFFF)" "^(FFFE)^(FFFF)"
	--test-- "find/with-5"
		;assert "e✐" = find/with "abcde✐" "e^(FFFE)" "^(FFFE)^(FFFF)"
	--test-- "find/with-6"
		;assert "e✐f" = find/with "abcde✐f" "^(FFFE)f" "^(FFFE)^(FFFF)"
	--test-- "find/with-7"
		;assert "e✐" = find/with "abcde✐" "e^(FFFF)" "^(FFFE)^(FFFF)"
	--test-- "find/with-8"
		;assert "abcde✐f" = find/with "abcde✐f" "^(FFFF)f" "^(FFFE)^(FFFF)"
	--test-- "find/with-9"
		;assert "e^(010000)" = find/with "abcde^(010000)" "e^(FFFE)" "^(FFFE)^(FFFF)"
	--test-- "find/with-10"
		;assert "e^(010000)f" = find/with "abcde^(010000)f" "^(FFFE)f" "^(FFFE)^(FFFF)"
	--test-- "find/with-11"
		;assert "e^(010000)" = find/with "abcde^(010000)" "e^(FFFF)" "^(FFFE)^(FFFF)"
	--test-- "find/with-12"
		;assert "abcde^(010000)f" = find/with "abcde^(010000)f" "^(FFFF)f" "^(FFFE)^(FFFF)"
===end-group===

===start-group=== "find/skip"
	--test-- "find/skip-1"
		--assert [6 7 8 9 0] = find/skip [1 2 3 4 5 1 6 6 6 6 1 2 3 4 5 6 7 8 9 0] 6 5
	--test-- "find/skip-2"
		--assert none = find/skip [1 2 3 4 5 1 6 6 6 6 1 2 3 4 5 1 2 3 4 5] 6 5
	--test-- "find/skip-3"
		--assert [6 7 8 9 0] = find/skip [1 2 3 4 5 6 6 6 6 6 1 2 3 4 5 6 7 8 9 0] [6 7] 5
	--test-- "find/skip-4"
		--assert none = find/skip [1 2 3 4 5 1 6 6 6 6 1 2 3 4 5 1 2 3 4 5] [6 7] 5
	--test-- "find/skip-5"
		--assert "67890" = find/skip "12345166661234567890" "6" 5
	--test-- "find/skip-6"
		--assert none = find/skip "12345166661234557890" "6" 5
===end-group===

===start-group=== "find/match"
  --test-- "find/match-1"
  --assert [and now] = find/match [here and now] 'here
  --test-- "find/match-2"
  --assert none = find/match [here and now] 'her
  --test-- "find/match-3"
  --assert none = find/match [her and now] 'here
  --test-- "find/match-4"
  --assert " and now" = find/match "here and now" "here"
  --test-- "find/match-5"
  --assert "andnow" = find/match "hereandnow" "here"
  --test-- "find/match-6"
  --assert none = find/match "her and now" "here"
  --test-- "find/match-7"
  --assert " and now" = find/match "here✐ and now" "here✐"
  --test-- "find/match-8"
  --assert "✐andnow" = find/match "here✐andnow" "here"
  --test-- "find/match-9"
  --assert none = find/match "her and now" "he✐r"
  --test-- "find/match-10"
  --assert none = find/match "here and now" "✐here"
  --test-- "find/match-11"
  --assert "^(010000)andnow" = find/match "here^(010000)andnow" "here"
  --test-- "find/match-12"
  --assert none = find/match "her and now" "here^(010000)"
  --test-- "find/match-13"
  --assert " and now" = find/match "here^(010000) and now" "here^(010000)"
  --test-- "find/match-14"
  --assert "andnow" = find/match "^(010000)hereandnow" "^(010000)here"
  --test-- "find/match-15"
  --assert none = find/match "her^(010000) and now" "here^(010000)"
  --test-- "find/match-16"
  --assert [and now] = find/match [he✐re and now] 'he✐re
===end-group===

===start-group=== "find/tail"
  --test-- "find/tail-1"
  --assert [and now] = find/tail [here and now] 'here
  --test-- "find/tail-2"
  --assert none = find/tail [here and now] 'her
  --test-- "find/tail-3"
  --assert none = find/tail [her and now] 'here
  --test-- "find/tail-4"
  --assert " and now" = find/tail "here and now" "here"
  --test-- "find/tail-5"
  --assert "andnow" = find/tail "hereandnow" "here"
  --test-- "find/tail-6"
  --assert none = find/tail "her and now" "here"
  --test-- "find/tail-7"
  --assert " and now" = find/tail "here✐ and now" "here✐"
  --test-- "find/tail-8"
  --assert "✐andnow" = find/tail "here✐andnow" "here"
  --test-- "find/tail-9"
  --assert none = find/tail "her and now" "he✐r"
  --test-- "find/tail-10"
  --assert none = find/tail "here and now" "✐here"
  --test-- "find/tail-11"
  --assert "^(010000)andnow" = find/tail "here^(010000)andnow" "here"
  --test-- "find/tail-12"
  --assert none = find/tail "her and now" "here^(010000)"
  --test-- "find/tail-13"
  --assert " and now" = find/tail "here^(010000) and now" "here^(010000)"
  --test-- "find/tail-14"
  --assert "andnow" = find/tail "^(010000)hereandnow" "^(010000)here"
  --test-- "find/tail-15"
  --assert none = find/tail "her^(010000) and now" "here^(010000)"
  --test-- "find/tail-16"
  --assert [and now] = find/tail [he✐re and now] 'he✐re
  --test-- "find/tail-17 issue #457"
  --assert "de" = find/tail "abcde" #"c"
  --test-- "find-tail-18"
  --assert "de" = find/tail "abc^^de" #"^^"

===end-group===

===start-group=== "find/last"
  --test-- "find/last-1"
  --assert [1] = find/last [1 1 1 1] 1
  --assert 4 = index? find/last [1 1 1 1] 1
  --test-- "find/last-2"
  --assert [2 1] = find/last [1 2 3 4 3 2 1] 2
  --test-- "find/last-3"
  --assert [3 3 2 1] = find/last [1 2 3 3 2 1] [3 3]
  --test-- "find/last-4"
  --assert "3321" = find/last "123321" "33"
  --test-- "find/last-5"
  --assert "321" = find/last "123321" "3"
  --test-- "find/last-6"
  --assert "1" = find/last "1111" "1"
  --test-- "find/last-7"
  --assert none = find/last "123" "34"
  --test-- "find/last-8"
  --assert "✐5678" = find/last "1234✐5678" "✐"
  --test-- "find/last-9"
  --assert "^(010000)5678" = find/last "1234^(010000)5678" "^(010000)"
===end-group===

===start-group=== "find/reverse"
  --test-- "find/reverse-1"
  --assert none = find/reverse [1 1 1 1] 1
  --test-- "find/reverse-2"
  --assert [2 1] = find/reverse tail [1 2 3 4 3 2 1] 2
  --test-- "find/reverse-3"
  --assert [3 3 2 1] = find/reverse tail [1 2 3 3 2 1] [3 3]
  --test-- "find/reverse-4"
  --assert "3321" = find/reverse back back back tail "123321" "33"
  --test-- "find/reverse-5"
  --assert "3321" = find/reverse back back back tail"123321" "3"
  --test-- "find/reverse-6"
  --assert "1" = find/reverse tail "1111" "1"
  --test-- "find/reverse-7"
  --assert none = find/reverse tail "123" "34"
  --test-- "find/reverse-8"
  --assert "✐5678" = find/reverse tail "1234✐5678" "✐"
  --test-- "find/reverse-9"
  --assert "^(010000)5678" = find/reverse tail "1234^(010000)5678" "^(010000)"
  --test-- "find/reverse-10 issue #505"
  --assert "ab" = find/reverse tail "ab" #"a"
  --assert "ab" = find/reverse tail "ab" "ab"
  --assert [a b] = find/reverse tail [a b] 'a
  --assert [a b] = find/reverse tail [a b] [a b]
===end-group===

===start-group=== "find/last/tail"
	--test-- "find/last/tail-1 issue #459"
		--assert [7 8] = find/last/tail [1 2 3 4 5 6 3 7 8] 3
	--test-- "find/last/tail-2 issue #459"
		--assert "78" = find/last/tail "123456378" #"3"
	--test-- "find/last/tail-3"
		--assert "78" = find/last/tail "123456378" "3"
===end-group===

~~~end-file~~~


r414: Updating the link to screencast

r414: Updating the link to screencast

h1. Screencasts

<div class="screencast_image">
  !/images/documentation/5_minute_install.png!:http://cruisecontrolrb.com/5_minute_install.mov
</div>

h3. "5 Minute Install":http://cruisecontrolrb.com/5_minute_install.mov

This is a 5 minute video that takes you through the steps of getting cruise control up and running with a rails project.

h1. Screencasts

<div class="screencast_image">
  !/images/documentation/5_minute_install.png!:http://www.cruisecontrolrb.com.php5-1.websitetestlink.com/5_minute_install.mov
</div>

h3. "5 Minute Install":http://www.cruisecontrolrb.com.php5-1.websitetestlink.com/5_minute_install.mov

This is a 5 minute video that takes you through the steps of getting cruise control up and running with a rails project.


FIX: refinements not fully supported yet, so they are disabled from actions spec block for now.

Red [
	Title:   "Red base environment definitions"
	Author:  "Nenad Rakocevic"
	File: 	 %boot.red
	Rights:  "Copyright (C) 2011 Nenad Rakocevic. All rights reserved."
	License: {
		Distributed under the Boost Software License, Version 1.0.
		See https://github.com/dockimbel/Red/blob/master/red-system/runtime/BSL-License.txt
	}
]

;-- datatype! is not defined here for obvious circular reference issue

unset!:			make datatype! #get-definition TYPE_UNSET
none!:			make datatype! #get-definition TYPE_NONE
logic!:			make datatype! #get-definition TYPE_LOGIC
block!:			make datatype! #get-definition TYPE_BLOCK
string!:		make datatype! #get-definition TYPE_STRING
integer!:		make datatype! #get-definition TYPE_INTEGER
;symbol!:		make datatype! #get-definition TYPE_SYMBOL
;context!:		make datatype! #get-definition TYPE_CONTEXT
word!:			make datatype! #get-definition TYPE_WORD
error!:			make datatype! #get-definition TYPE_ERROR
typeset!:		make datatype! #get-definition TYPE_TYPESET

set-word!:		make datatype! #get-definition TYPE_SET_WORD
get-word!:		make datatype! #get-definition TYPE_GET_WORD
lit-word!:		make datatype! #get-definition TYPE_LIT_WORD
refinement!:	make datatype! #get-definition TYPE_REFINEMENT
binary!:		make datatype! #get-definition TYPE_BINARY
paren!:			make datatype! #get-definition TYPE_PAREN
char!:			make datatype! #get-definition TYPE_CHAR
issue!:			make datatype! #get-definition TYPE_ISSUE
path!:			make datatype! #get-definition TYPE_PATH
set-path!:		make datatype! #get-definition TYPE_SET_PATH
lit-path!:		make datatype! #get-definition TYPE_LIT_PATH
native!:		make datatype! #get-definition TYPE_NATIVE
action!:		make datatype! #get-definition TYPE_ACTION
op!:			make datatype! #get-definition TYPE_OP
function!:		make datatype! #get-definition TYPE_FUNCTION
closure!:		make datatype! #get-definition TYPE_CLOSURE
routine!:		make datatype! #get-definition TYPE_ROUTINE
object!:		make datatype! #get-definition TYPE_OBJECT
port!:			make datatype! #get-definition TYPE_PORT
bitset!:		make datatype! #get-definition TYPE_BITSET
float!:			make datatype! #get-definition TYPE_FLOAT

none:  			make none! 0
true:  			make logic! 1
false: 			make logic! 0

;------------------------------------------
;-				Actions					  -
;------------------------------------------

make: make action! [[									;-- this one works! ;-)
		type	 [any-type!]
		spec	 [any-type!]
		return:  [any-type!]
	]
	#get-definition ACT_MAKE
]

;random
;reflect
;to

form: make action! [[
		value	 [any-type!]
		return:	 [string!]
	]
	#get-definition ACT_FORM
]

mold: make action! [[
		value	 [any-type!]
		return:	 [string!]
	]
	#get-definition ACT_MOLD
]

;-- Scalar actions --

absolute: make action! [[
		value	 [number!]
		return:  [number!]
	]
	#get-definition ACT_ABSOLUTE
]

add: make action! [[
		value1	 [number!]
		value2	 [number!]
		return:  [number!]
	]
	#get-definition ACT_ADD
]

divide: make action! [[
		value1	 [number!]
		value2	 [number!]
		return:  [number!]
	]
	#get-definition ACT_DIVIDE
]

multiply: make action! [[
		value1	 [number!]
		value2	 [number!]
		return:  [number!]
	]
	#get-definition ACT_MULTIPLY
]

negate: make action! [[
		number 	 [number!]
		return:  [number!]
	]
	#get-definition ACT_NEGATE
]

power: make action! [[
		number	 [number!]
		exponent [number!]
		return:	 [number!]
	]
	#get-definition ACT_POWER
]

remainder: make action! [[
		value 	 [number!]
		return:  [number!]
	]
	#get-definition ACT_REMAINDER
]

round: make action! [[
		n		[number!]
		/to
		scale	[number!]
		/even
		/down
		/half-down
		/floor
		/ceiling
		/half-ceiling
	]
	#get-definition ACT_ROUND
]

subtract: make action! [[
		value1	 [number!]
		value2	 [number!]
		return:  [number!]
	]
	#get-definition ACT_SUBTRACT
]

even?: make action! [[
		number 	 [number!]
		return:  [number!]
	]
	#get-definition ACT_EVEN?
]

odd?: make action! [[
		number 	 [number!]
		return:  [number!]
	]
	#get-definition ACT_ODD?
]

;-- Bitwise actions --

;and~
;complement
;or~
;xor~

;-- Series actions --

append: make action! [[
		series	   [series!]
		value	   [any-value!]
		;/part
		;	length [number! series!]
		;/only
		;/dup
		;	count  [number!]
		return:    [series!]
	]
	#get-definition ACT_APPEND
]

at: make action! [[
		series	 [series!]
		index 	 [integer!]
		return:  [series!]
	]
	#get-definition ACT_AT
]

back: make action! [[
		series	 [series!]
		return:  [series!]
	]
	#get-definition ACT_BACK
]

;change
;clear
;copy
;find

head: make action! [[
		series	 [series!]
		return:  [series!]
	]
	#get-definition ACT_HEAD
]

head?: make action! [[
		series	 [series!]
		return:  [logic!]
	]
	#get-definition ACT_HEAD?
]

index-of: make action! [[
		series	 [series!]
		return:  [integer!]
	]
	#get-definition ACT_INDEX_OF
]

;insert

length-of: make action! [[
		series	 [series!]
		return:  [integer!]
	]
	#get-definition ACT_LENGTH_OF
]

next: make action! [[
		series	 [series!]
		return:  [series!]
	]
	#get-definition ACT_NEXT
]

pick: make action! [[
		series	 [series!]
		index 	 [integer!]
		return:  [any-value!]
	]
	#get-definition ACT_PICK
]

;poke
;remove
;reverse
;select
;sort

skip: make action! [[
		series	 [series!]
		offset 	 [integer!]
		return:  [series!]
	]
	#get-definition ACT_SKIP
]

;swap

tail: make action! [[
		series	 [series!]
		return:  [series!]
	]
	#get-definition ACT_TAIL
]

tail?: make action! [[
		series	 [series!]
		return:  [logic!]
	]
	#get-definition ACT_TAIL?
]

;take
;trim

;-- I/O actions --

;create
;close
;delete
;modify
;open
;open?
;query
;read
;rename
;update
;write

;------------------------------------------
;-				Natives					  -
;------------------------------------------

get: make native! [[
		word	[word!]
		/any
		return: [any-type!]
	]
	none
]

set: make native! [[
		word	[lit-word!]
		/any
		value	[any-type!]
		return: [any-type!]
	]
	none
]

print: make native! [[
		value	[any-type!]
	]
	none
]

equal?: make native! [[
		value1 [any-type!]
		value2 [any-type!]
	]
	none
]

not-equal?: make native! [[
		value1 [any-type!]
		value2 [any-type!]
	]
	none
]

strict-equal?: make native! [[
		value1 [any-type!]
		value2 [any-type!]
	]
	none
]

same?: make native! [[
		value1 [any-type!]
		value2 [any-type!]
	]
	none
]

lesser?: make native! [[
		value1 [any-type!]
		value2 [any-type!]
	]
	none
]

greater?: make native! [[
		value1 [any-type!]
		value2 [any-type!]
	]
	none
]

lesser-or-equal?: make native! [[
		value1 [any-type!]
		value2 [any-type!]
	]
	none
]

greater-or-equal?: make native! [[
		value1 [any-type!]
		value2 [any-type!]
	]
	none
]

;------------------------------------------
;-			   Operators				  -
;------------------------------------------

;-- #load temporary directive is used to workaround REBOL LOAD limitations on some words

#load set-word! "+"  make op! :add
#load set-word! "-"  make op! :subtract
#load set-word! "*"  make op! :multiply
#load set-word! "/"  make op! :divide
#load set-word! "="  make op! :equal?
#load set-word! "<>" make op! :not-equal?
#load set-word! "==" make op! :strict-equal?
#load set-word! "=?" make op! :same?
#load set-word! "<"  make op! :lesser?
#load set-word! ">"  make op! :greater?
#load set-word! "<=" make op! :lesser-or-equal?
#load set-word! ">=" make op! :greater-or-equal?

;------------------------------------------
;-				Others					  -
;------------------------------------------

yes: on: true
no: off: false
;empty?: :tail?

tab: #"^-"
cr: #"^M"
newline: lf: #"^/"
escape: #"^["
slash: #"/"

Red [
	Title:   "Red base environment definitions"
	Author:  "Nenad Rakocevic"
	File: 	 %boot.red
	Rights:  "Copyright (C) 2011 Nenad Rakocevic. All rights reserved."
	License: {
		Distributed under the Boost Software License, Version 1.0.
		See https://github.com/dockimbel/Red/blob/master/red-system/runtime/BSL-License.txt
	}
]

;-- datatype! is not defined here for obvious circular reference issue

unset!:			make datatype! #get-definition TYPE_UNSET
none!:			make datatype! #get-definition TYPE_NONE
logic!:			make datatype! #get-definition TYPE_LOGIC
block!:			make datatype! #get-definition TYPE_BLOCK
string!:		make datatype! #get-definition TYPE_STRING
integer!:		make datatype! #get-definition TYPE_INTEGER
;symbol!:		make datatype! #get-definition TYPE_SYMBOL
;context!:		make datatype! #get-definition TYPE_CONTEXT
word!:			make datatype! #get-definition TYPE_WORD
error!:			make datatype! #get-definition TYPE_ERROR
typeset!:		make datatype! #get-definition TYPE_TYPESET

set-word!:		make datatype! #get-definition TYPE_SET_WORD
get-word!:		make datatype! #get-definition TYPE_GET_WORD
lit-word!:		make datatype! #get-definition TYPE_LIT_WORD
refinement!:	make datatype! #get-definition TYPE_REFINEMENT
binary!:		make datatype! #get-definition TYPE_BINARY
paren!:			make datatype! #get-definition TYPE_PAREN
char!:			make datatype! #get-definition TYPE_CHAR
issue!:			make datatype! #get-definition TYPE_ISSUE
path!:			make datatype! #get-definition TYPE_PATH
set-path!:		make datatype! #get-definition TYPE_SET_PATH
lit-path!:		make datatype! #get-definition TYPE_LIT_PATH
native!:		make datatype! #get-definition TYPE_NATIVE
action!:		make datatype! #get-definition TYPE_ACTION
op!:			make datatype! #get-definition TYPE_OP
function!:		make datatype! #get-definition TYPE_FUNCTION
closure!:		make datatype! #get-definition TYPE_CLOSURE
routine!:		make datatype! #get-definition TYPE_ROUTINE
object!:		make datatype! #get-definition TYPE_OBJECT
port!:			make datatype! #get-definition TYPE_PORT
bitset!:		make datatype! #get-definition TYPE_BITSET
float!:			make datatype! #get-definition TYPE_FLOAT

none:  			make none! 0
true:  			make logic! 1
false: 			make logic! 0

;------------------------------------------
;-				Actions					  -
;------------------------------------------

make: make action! [[									;-- this one works! ;-)
		type	 [any-type!]
		spec	 [any-type!]
		return:  [any-type!]
	]
	#get-definition ACT_MAKE
]

;random
;reflect
;to

form: make action! [[
		value	 [any-type!]
		return:	 [string!]
	]
	#get-definition ACT_FORM
]

mold: make action! [[
		value	 [any-type!]
		return:	 [string!]
	]
	#get-definition ACT_MOLD
]

;-- Scalar actions --

absolute: make action! [[
		value	 [number!]
		return:  [number!]
	]
	#get-definition ACT_ABSOLUTE
]

add: make action! [[
		value1	 [number!]
		value2	 [number!]
		return:  [number!]
	]
	#get-definition ACT_ADD
]

divide: make action! [[
		value1	 [number!]
		value2	 [number!]
		return:  [number!]
	]
	#get-definition ACT_DIVIDE
]

multiply: make action! [[
		value1	 [number!]
		value2	 [number!]
		return:  [number!]
	]
	#get-definition ACT_MULTIPLY
]

negate: make action! [[
		number 	 [number!]
		return:  [number!]
	]
	#get-definition ACT_NEGATE
]

power: make action! [[
		number	 [number!]
		exponent [number!]
		return:	 [number!]
	]
	#get-definition ACT_POWER
]

remainder: make action! [[
		value 	 [number!]
		return:  [number!]
	]
	#get-definition ACT_REMAINDER
]

round: make action! [[
		n		[number!]
		/to
		scale	[number!]
		/even
		/down
		/half-down
		/floor
		/ceiling
		/half-ceiling
	]
	#get-definition ACT_ROUND
]

subtract: make action! [[
		value1	 [number!]
		value2	 [number!]
		return:  [number!]
	]
	#get-definition ACT_SUBTRACT
]

even?: make action! [[
		number 	 [number!]
		return:  [number!]
	]
	#get-definition ACT_EVEN?
]

odd?: make action! [[
		number 	 [number!]
		return:  [number!]
	]
	#get-definition ACT_ODD?
]

;-- Bitwise actions --

;and~
;complement
;or~
;xor~

;-- Series actions --

append: make action! [[
		series	   [series!]
		value	   [any-value!]
		/part
			length [number! series!]
		/only
		/dup
			count  [number!]
		return:    [series!]
	]
	#get-definition ACT_APPEND
]

at: make action! [[
		series	 [series!]
		index 	 [integer!]
		return:  [series!]
	]
	#get-definition ACT_AT
]

back: make action! [[
		series	 [series!]
		return:  [series!]
	]
	#get-definition ACT_BACK
]

;change
;clear
;copy
;find

head: make action! [[
		series	 [series!]
		return:  [series!]
	]
	#get-definition ACT_HEAD
]

head?: make action! [[
		series	 [series!]
		return:  [logic!]
	]
	#get-definition ACT_HEAD?
]

index-of: make action! [[
		series	 [series!]
		return:  [integer!]
	]
	#get-definition ACT_INDEX_OF
]

;insert

length-of: make action! [[
		series	 [series!]
		return:  [integer!]
	]
	#get-definition ACT_LENGTH_OF
]

next: make action! [[
		series	 [series!]
		return:  [series!]
	]
	#get-definition ACT_NEXT
]

pick: make action! [[
		series	 [series!]
		index 	 [integer!]
		return:  [any-value!]
	]
	#get-definition ACT_PICK
]

;poke
;remove
;reverse
;select
;sort

skip: make action! [[
		series	 [series!]
		offset 	 [integer!]
		return:  [series!]
	]
	#get-definition ACT_SKIP
]

;swap

tail: make action! [[
		series	 [series!]
		return:  [series!]
	]
	#get-definition ACT_TAIL
]

tail?: make action! [[
		series	 [series!]
		return:  [logic!]
	]
	#get-definition ACT_TAIL?
]

;take
;trim

;-- I/O actions --

;create
;close
;delete
;modify
;open
;open?
;query
;read
;rename
;update
;write

;------------------------------------------
;-				Natives					  -
;------------------------------------------

get: make native! [[
		word	[word!]
		/any
		return: [any-type!]
	]
	none
]

set: make native! [[
		word	[lit-word!]
		/any
		value	[any-type!]
		return: [any-type!]
	]
	none
]

print: make native! [[
		value	[any-type!]
	]
	none
]

equal?: make native! [[
		value1 [any-type!]
		value2 [any-type!]
	]
	none
]

not-equal?: make native! [[
		value1 [any-type!]
		value2 [any-type!]
	]
	none
]

strict-equal?: make native! [[
		value1 [any-type!]
		value2 [any-type!]
	]
	none
]

same?: make native! [[
		value1 [any-type!]
		value2 [any-type!]
	]
	none
]

lesser?: make native! [[
		value1 [any-type!]
		value2 [any-type!]
	]
	none
]

greater?: make native! [[
		value1 [any-type!]
		value2 [any-type!]
	]
	none
]

lesser-or-equal?: make native! [[
		value1 [any-type!]
		value2 [any-type!]
	]
	none
]

greater-or-equal?: make native! [[
		value1 [any-type!]
		value2 [any-type!]
	]
	none
]

;------------------------------------------
;-			   Operators				  -
;------------------------------------------

;-- #load temporary directive is used to workaround REBOL LOAD limitations on some words

#load set-word! "+"  make op! :add
#load set-word! "-"  make op! :subtract
#load set-word! "*"  make op! :multiply
#load set-word! "/"  make op! :divide
#load set-word! "="  make op! :equal?
#load set-word! "<>" make op! :not-equal?
#load set-word! "==" make op! :strict-equal?
#load set-word! "=?" make op! :same?
#load set-word! "<"  make op! :lesser?
#load set-word! ">"  make op! :greater?
#load set-word! "<=" make op! :lesser-or-equal?
#load set-word! ">=" make op! :greater-or-equal?

;------------------------------------------
;-				Others					  -
;------------------------------------------

yes: on: true
no: off: false
;empty?: :tail?

tab: #"^-"
cr: #"^M"
newline: lf: #"^/"
escape: #"^["
slash: #"/"


FIX: runtime lexer errors are now using the error system.

Red [
	Title:   "Red runtime lexer"
	Author:  "Nenad Rakocevic"
	File: 	 %lexer.red
	Tabs:	 4
	Rights:  "Copyright (C) 2014 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/lexer: context [

	make-number: routine [
		start  [string!]
		end	   [string!]
		float? [logic!]
		/local
			c	 [integer!]
			n	 [integer!]
			m	 [integer!]
			len  [integer!]
			p	 [byte-ptr!]
			neg? [logic!]
	][
		if float? [
			make-float start end							;-- decimal! escape path
			exit
		]
		str:  GET_BUFFER(start)
		unit: GET_UNIT(str)
		p:	  string/rs-head start
		len:  end/head - start/head
		neg?: no

		c: string/get-char p unit
		if any [
			c = as-integer #"+"
			c = as-integer #"-"
		][
			neg?: c = as-integer #"-"
			p: p + unit
			len: len - 1
		]
		n: 0
		until [
			c: (string/get-char p unit) - #"0"
			if c >= 0 [									;-- skip #"'"
				m: n * 10
				if m < n [SET_RETURN(none-value) exit]	;-- return NONE on overflow
				n: m

				if all [n = 2147483640 c = 8][
					integer/box 80000000h				;-- special exit trap for -2147483648
					exit
				]

				m: n + c
				if m < n [SET_RETURN(none-value) exit]	;-- return NONE on overflow
				n: m
			]
			p: p + unit
			len: len - 1
			zero? len
		]
		integer/box either neg? [0 - n][n]
	]

	make-float: routine [
		start [string!]
		end	  [string!]
		/local
			str  [series!]
			cp	 [integer!]
			unit [integer!]
			p	 [byte-ptr!]
			tail [byte-ptr!]
			cur	 [byte-ptr!]
			s0	 [byte-ptr!]
			byte [byte!]
	][
		str:  GET_BUFFER(start)
		unit: GET_UNIT(str)
		p:	  string/rs-head start
		tail: p + ((end/head - start/head) << (unit >> 1))
		cur:  p
		s0:   cur

		until [											;-- convert to ascii string
			cp: string/get-char p unit
			if cp <> as-integer #"'" [					;-- skip #"'"
				if cp = as-integer #"," [cp: as-integer #"."]
				cur/1: as-byte cp
				cur: cur + 1
			]
			p: p + unit
			p = tail
		]
		byte: cur/1										;-- store last byte
		cur/1: #"^@"									;-- replace the byte with null so to-float can use it as end of input
		float/box string/to-float s0
		cur/1: byte										;-- revert the byte back
	]

	make-hexa: routine [
		start	[string!]
		end		[string!]
		return: [integer!]
		/local
			s	  [series!]
			unit  [integer!]
			p	  [byte-ptr!]
			head  [byte-ptr!]
			p4	  [int-ptr!]
			n	  [integer!]
			power [integer!]
			cp	  [byte!]
	][
		s: GET_BUFFER(start)
		unit: GET_UNIT(s)

		p: (string/rs-head end) - unit
		head: string/rs-head start

		n: 0
		power: 0
		while [p >= head][
			cp: switch unit [
				Latin1 [p/value]
				UCS-2  [as-byte ((as-integer p/2) << 8 + p/1)]
				UCS-4  [p4: as int-ptr! p as-byte p4/value]
			]
			if cp <> #"0" [
				case [
					all [#"0" <= cp cp <= #"9"][cp: cp - #"0"]
					all [#"A" <= cp cp <= #"F"][cp: cp - #"A" + 10]
					all [#"a" <= cp cp <= #"f"][cp: cp - #"a" + 10]
				]
				n: n + ((as-integer cp) << power)
			]
			power: power + 4
			p: p - unit
		]
		n
	]

	make-char: routine [
		start	[string!]
		end		[string!]
		/local
			n	  [integer!]
			value [red-value!]
	][
		n: make-hexa start end
		value: as red-value! integer/box n
		set-type value TYPE_CHAR
	]

	push-path: routine [
		stack [block!]
		type  [datatype!]
		/local
			path [red-path!]
	][
		path: as red-path! block/make-at as red-block! ALLOC_TAIL(stack) 4
		path/header: switch type/value [
			TYPE_GET_WORD [TYPE_GET_PATH]
			TYPE_LIT_WORD [TYPE_LIT_PATH]
			default [TYPE_PATH]
		]
	]

	set-path: routine [
		stack [block!]
		/local
			path [red-path!]
	][
		path: as red-path! block/pick stack 1 null
		set-type as red-value! path TYPE_SET_PATH
	]

	make-word: routine [
		src   [string!]
		type  [datatype!]
	][
		set-type
			as red-value! word/box (symbol/make-alt src) ;-- word/box puts it in stack/arguments
			type/value
	]

	to-word: func [
		stack [block!]
		src   [string!]
		type  [datatype!]
	][
		store stack make-word src type
	]

	pop: function [stack [block!]][
		value: last stack
		remove back tail stack

		either any [1 < length? stack head? stack/1][
			append/only last stack :value
		][
			pos: back tail stack						;-- root storage and offset-ed series (/into option)
			pos/1: insert/only last stack :value
		]
	]

	store: function [stack [block!] value][
		either any [1 < length? stack head? stack/1][
			append last stack value
		][
			pos: back tail stack						;-- root storage and offset-ed series (/into option)
			pos/1: insert last stack value
		]
	]

	transcode: function [
		src	[string!]
		dst	[block! none!]
		/part
			length [integer! string!]
		return: [block!]
		/local
			new s e c hex pos value cnt type process
			digit hexa-upper hexa-lower hexa hexa-char not-word-char not-word-1st
			not-file-char not-str-char not-mstr-char caret-char
			non-printable-char integer-end ws-ASCII ws-U+2k control-char
	][
		cs:		[- - - - - - - - - - - - - - - -]		;-- memoized bitsets
		stack:	clear []
		count?:	yes										;-- if TRUE, lines counter is enabled
		line: 	1

		append/only stack any [dst make block! 4]

		make-string: [
			new: make type (index? e) - index? s
			parse/case copy/part s e [					;@@ add /part option to parse!
				any [
					escaped-char (append new value)
					| #"^^"								;-- trash single caret chars
					| set c skip (append new c)
				]
			]
			new
		]

		make-file: [
			new: make type (index? e) - index? s
			append new dehex copy/part s e
			new
		]

		if cs/1 = '- [
			cs/1:  charset "0123465798"					;-- digit
			cs/2:  charset "ABCDEF"						;-- hexa-upper
			cs/3:  charset "abcdef"						;-- hexa-lower
			cs/4:  union cs/1 cs/2						;-- hexa
			cs/5:  union cs/4 cs/3						;-- hexa-char
			cs/6:  charset {/\^^,[](){}"#%$@:;}			;-- not-word-char
			cs/7:  union union cs/6 cs/1 charset {'}	;-- not-word-1st
			cs/8:  charset {[](){}"@:;}					;-- not-file-char
			cs/9:  #"^""								;-- not-str-char
			cs/10: #"}"									;-- not-mstr-char
			cs/11: charset [#"^(40)" - #"^(5F)"]		;-- caret-char
			cs/12: charset [#"^(00)" - #"^(1F)"]		;-- non-printable-char
			cs/13: charset {^{"[]);}					;-- integer-end
			cs/14: charset " ^-^M"						;-- ws-ASCII, ASCII common whitespaces
			cs/15: charset [#"^(2000)" - #"^(200A)"]	;-- ws-U+2k, Unicode spaces in the U+2000-U+200A range
			cs/16: charset [#"^(00)" - #"^(1F)"] 		;-- ASCII control characters

		]
		set [
			digit hexa-upper hexa-lower hexa hexa-char not-word-char not-word-1st
			not-file-char not-str-char not-mstr-char caret-char
			non-printable-char integer-end ws-ASCII ws-U+2k control-char
		] cs

		;-- Whitespaces list from: http://en.wikipedia.org/wiki/Whitespace_character
		ws: [
			pos: #"^/" (
				if count? [
					line: line + 1
					;append/only lines to block! stack/tail?
				]
			)
			| ws-ASCII									;-- only the common whitespaces are matched
			| #"^(0085)"								;-- U+0085 (Newline)
			| #"^(00A0)"								;-- U+00A0 (No-break space)
			| #"^(1680)"								;-- U+1680 (Ogham space mark)
			| #"^(180E)"								;-- U+180E (Mongolian vowel separator)
			| ws-U+2k									;-- U+2000-U+200A range
			| #"^(2028)"								;-- U+2028 (Line separator)
			| #"^(2029)"								;-- U+2029 (Paragraph separator)
			| #"^(202F)"								;-- U+202F (Narrow no-break space)
			| #"^(205F)"								;-- U+205F (Medium mathematical space)
			| #"^(3000)"								;-- U+3000 (Ideographic space)
		]

		newline-char: [
			#"^/"
			| #"^(0085)"								;-- U+0085 (Newline)
			| #"^(2028)"								;-- U+2028 (Line separator)
			| #"^(2029)"								;-- U+2029 (Paragraph separator)
		]

		counted-newline: [pos: #"^/" (line: line + 1)]

		ws-no-count: [(count?: no) ws (count?: yes)]

		escaped-char: [
			"^^(" [
				[										;-- special case first
					"null" 	 (value: #"^(00)")
					| "back" (value: #"^(08)")
					| "tab"  (value: #"^(09)")
					| "line" (value: #"^(0A)")
					| "page" (value: #"^(0C)")
					| "esc"  (value: #"^(1B)")
					| "del"	 (value: #"^(7F)")
				]
				| pos: [1 6 hexa-char] e: (				;-- Unicode values allowed up to 10FFFFh
					value: make-char pos e
				)
			] #")"
			| #"^^" [
				[
					#"/" 	(value: #"^/")
					| #"-"	(value: #"^-")
					| #"?" 	(value: #"^(del)")			;@@FIXME
					| #"^^" (value: #"^^")				;-- caret escaping case
					| #"{"	(value: #"{")
					| #"}"	(value: #"}")
					| #"^""	(value: #"^"")
				]
				| pos: caret-char (value: pos/1 - 64)
			]
		]

		char-rule: [
			{#"} s: [
				 escaped-char
				| ahead [non-printable-char | not-str-char] break
				| skip (value: s/1)
			] {"}
		]

		line-string: [
			{"} s: any [
				{^^"}
				| ahead [#"^"" | newline-char] break
				| escaped-char
				| skip
			]
			e: {"}
		]

		nested-curly-braces: [
			(cnt: 1)
			any [
				counted-newline
				| "^^{"
				| "^^}"
				| #"{" (cnt: cnt + 1)
				| e: #"}" if (zero? cnt: cnt - 1) break
				| escaped-char
				| skip
			]
		]

		multiline-string: [
			#"{" s: nested-curly-braces (
				unless zero? cnt [cause-error 'syntax 'invalid [string! mold s]]
			)
		]

		string-rule: [(type: string!) line-string | multiline-string]

		file-rule: [
			#"%" [
				line-string (process: make-string type: file!)
				| s: any [ahead [not-file-char | ws-no-count] break | skip] e:
				  (process: make-file type: file!)
			]
		]

		url-rule: [
			#":" not [integer-end | ws-no-count | end]
			any [#"@" | #":" | ahead [not-file-char | ws-no-count] break | skip] e:
			(type: url! store stack do make-file)
		]

		symbol-rule: [
			some [ahead [not-word-char | ws-no-count | control-char] break | skip] e:
		]

		begin-symbol-rule: [							;-- 1st char in symbols is restricted
			[not ahead [not-word-1st | ws-no-count | control-char]]
			symbol-rule
		]

		path-rule: [
			ahead slash (								;-- path detection barrier
				push-path stack type					;-- create empty path
				to-word stack copy/part s e word!		;-- push 1st path element
			)
			some [
				slash
				s: [
					integer-number-rule			(store stack make-number s e no)
					| begin-symbol-rule			(to-word stack copy/part s e word!)
					| paren-rule
					| #":" s: begin-symbol-rule	(to-word stack copy/part s e get-word!)
					;@@ add more datatypes here
					| (cause-error 'syntax 'invalid [path! trim/tail back s])
					  reject
				]
				opt [#":" (set-path back tail stack)]
			] (pop stack)
		]

		word-rule: 	[
			#"%" ws-no-count (to-word stack "%" word!)	;-- special case for remainder op!
			| s: begin-symbol-rule (type: word!) [
					url-rule
					| path-rule							;-- path matched
					| opt [#":" (type: set-word!)]
					  (if type [to-word stack copy/part s e type])	;-- word or set-word matched
			  ]
		]

		get-word-rule: [
			#":" (type: get-word!) s: begin-symbol-rule [
				path-rule (type: get-path!)
				| (to-word stack copy/part s e type)	;-- get-word matched
			]
		]

		lit-word-rule: [
			#"'" (type: lit-word!) s: begin-symbol-rule [
				path-rule (type: lit-path!)				;-- path matched
				| (to-word stack copy/part s e type)	;-- lit-word matched
			]
		]

		issue-rule: [
			#"#" (type: issue!) s: symbol-rule
			(to-word stack copy/part s e type)
		]

		refinement-rule: [
			slash [
				some slash (type: word!) e:				;--  ///... case
				| ahead [not-word-char | ws-no-count | control-char] (type: word!) e: ;-- / case
				| symbol-rule (type: refinement! s: next s)
			]
			(to-word stack copy/part s e type)
		]

		hexa-rule: [2 8 hexa e: #"h"]

		integer-number-rule: [
			opt [#"-" | #"+"] digit any [digit | #"'" digit] e:
		]

		integer-rule: [
			float-special								;-- escape path for NaN, INFs
			| integer-number-rule
			  opt [float-number-rule | float-exp-rule e: (type: float!)]
			  ahead [integer-end | ws-no-count | end]
		]

		float-special: [
			s: opt [#"-"] "1.#" [
				[[#"N" | #"n"] [#"a" | #"A"] [#"N" | #"n"]]
				| [[#"I" | #"i"] [#"N" | #"n"] [#"F" | #"f"]]
			] e: (type: float!)
		]

		float-exp-rule: [[#"e" | #"E"] opt [#"-" | #"+"] 1 3 digit]

		float-number-rule: [
			[dot | comma] digit any [digit | #"'" digit]
			opt float-exp-rule e: (type: float!)
		]

		float-rule: [
			opt [#"-" | #"+"] float-number-rule
			ahead [integer-end | ws-no-count | end]
		]

		block-rule: [
			#"[" (append/only stack make block! 4)
			any-value
			#"]" (pop stack)
		]

		paren-rule: [
			#"(" (append/only stack make paren! 4)
			any-value
			#")" (pop stack)
		]

		escaped-rule: [
			"#[" pos: any ws [
				  "true"  			(value: true)
				| "false" 			(value: false)
				| [
					"none!"			(value: none!)
					| "logic!"		(value: logic!)
					| "block!"		(value: block!)
					| "integer!"	(value: integer!)
					| "word!"		(value: word!)
					| "set-word!"	(value: set-word!)
					| "get-word!"	(value: get-word!)
					| "lit-word!"	(value: lit-word!)
					| "refinement!"	(value: refinement!)
					;| "binary!"	(value: binary!)
					| "string!"		(value: string!)
					| "char!"		(value: char!)
					| "bitset!"		(value: bitset!)
					| "path!"		(value: path!)
					| "set-path!"	(value: set-path!)
					| "lit-path!"	(value: lit-path!)
					| "get-path!"	(value: get-path!)
					| "native!"		(value: native!)
					| "action!"		(value: action!)
					| "op!"			(value: op!)
					| "issue!"		(value: issue!)
					| "paren!"		(value: paren!)
					| "function!"	(value: function!)
					| "routine!"	(value: routine!)
				]
				| "none" 			(value: none)
			] pos: any ws #"]"
		]

		comment-rule: [#";" [to lf | to end]]

		wrong-delimiters: [
			pos: [
				  #"]" (value: #"[") | #")" (value: #"(")
				| #"[" (value: #"]") | #"(" (value: #")")
			] :pos
			(cause-error 'syntax 'missing [value pos])
		]

		literal-value: [
			pos: (e: none) s: [
				comment-rule
				| escaped-rule		(store stack value)
				| integer-rule		if (value: make-number s e type = float!) (store stack value)
				| float-rule		if (value: make-float s e) (store stack value)
				| hexa-rule			(store stack make-hexa s e)
				| word-rule
				| lit-word-rule
				| get-word-rule
				| refinement-rule
				| file-rule			(store stack value: do process)
				| char-rule			(store stack value)
				| issue-rule
				| block-rule
				| paren-rule
				| string-rule		(store stack do make-string)
				;| binary-rule	  	(stack/push load-binary s e)
			]
		]

		any-value: [pos: any [literal-value | ws]]

		red-rules: [any-value opt wrong-delimiters]

		unless either part [
			parse/case/part src red-rules length
		][
			parse/case src red-rules
		][
			cause-error 'syntax 'invalid ['value copy/part pos 20]
		]
		stack/1
	]
]

Red [
	Title:   "Red runtime lexer"
	Author:  "Nenad Rakocevic"
	File: 	 %lexer.red
	Tabs:	 4
	Rights:  "Copyright (C) 2014 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/lexer: context [

	make-number: routine [
		start  [string!]
		end	   [string!]
		float? [logic!]
		/local
			c	 [integer!]
			n	 [integer!]
			m	 [integer!]
			len  [integer!]
			p	 [byte-ptr!]
			neg? [logic!]
	][
		if float? [
			make-float start end							;-- decimal! escape path
			exit
		]
		str:  GET_BUFFER(start)
		unit: GET_UNIT(str)
		p:	  string/rs-head start
		len:  end/head - start/head
		neg?: no

		c: string/get-char p unit
		if any [
			c = as-integer #"+"
			c = as-integer #"-"
		][
			neg?: c = as-integer #"-"
			p: p + unit
			len: len - 1
		]
		n: 0
		until [
			c: (string/get-char p unit) - #"0"
			if c >= 0 [									;-- skip #"'"
				m: n * 10
				if m < n [SET_RETURN(none-value) exit]	;-- return NONE on overflow
				n: m

				if all [n = 2147483640 c = 8][
					integer/box 80000000h				;-- special exit trap for -2147483648
					exit
				]

				m: n + c
				if m < n [SET_RETURN(none-value) exit]	;-- return NONE on overflow
				n: m
			]
			p: p + unit
			len: len - 1
			zero? len
		]
		integer/box either neg? [0 - n][n]
	]

	make-float: routine [
		start [string!]
		end	  [string!]
		/local
			str  [series!]
			cp	 [integer!]
			unit [integer!]
			p	 [byte-ptr!]
			tail [byte-ptr!]
			cur	 [byte-ptr!]
			s0	 [byte-ptr!]
			byte [byte!]
	][
		str:  GET_BUFFER(start)
		unit: GET_UNIT(str)
		p:	  string/rs-head start
		tail: p + ((end/head - start/head) << (unit >> 1))
		cur:  p
		s0:   cur

		until [											;-- convert to ascii string
			cp: string/get-char p unit
			if cp <> as-integer #"'" [					;-- skip #"'"
				if cp = as-integer #"," [cp: as-integer #"."]
				cur/1: as-byte cp
				cur: cur + 1
			]
			p: p + unit
			p = tail
		]
		byte: cur/1										;-- store last byte
		cur/1: #"^@"									;-- replace the byte with null so to-float can use it as end of input
		float/box string/to-float s0
		cur/1: byte										;-- revert the byte back
	]

	make-hexa: routine [
		start	[string!]
		end		[string!]
		return: [integer!]
		/local
			s	  [series!]
			unit  [integer!]
			p	  [byte-ptr!]
			head  [byte-ptr!]
			p4	  [int-ptr!]
			n	  [integer!]
			power [integer!]
			cp	  [byte!]
	][
		s: GET_BUFFER(start)
		unit: GET_UNIT(s)

		p: (string/rs-head end) - unit
		head: string/rs-head start

		n: 0
		power: 0
		while [p >= head][
			cp: switch unit [
				Latin1 [p/value]
				UCS-2  [as-byte ((as-integer p/2) << 8 + p/1)]
				UCS-4  [p4: as int-ptr! p as-byte p4/value]
			]
			if cp <> #"0" [
				case [
					all [#"0" <= cp cp <= #"9"][cp: cp - #"0"]
					all [#"A" <= cp cp <= #"F"][cp: cp - #"A" + 10]
					all [#"a" <= cp cp <= #"f"][cp: cp - #"a" + 10]
				]
				n: n + ((as-integer cp) << power)
			]
			power: power + 4
			p: p - unit
		]
		n
	]

	make-char: routine [
		start	[string!]
		end		[string!]
		/local
			n	  [integer!]
			value [red-value!]
	][
		n: make-hexa start end
		value: as red-value! integer/box n
		set-type value TYPE_CHAR
	]

	push-path: routine [
		stack [block!]
		type  [datatype!]
		/local
			path [red-path!]
	][
		path: as red-path! block/make-at as red-block! ALLOC_TAIL(stack) 4
		path/header: switch type/value [
			TYPE_GET_WORD [TYPE_GET_PATH]
			TYPE_LIT_WORD [TYPE_LIT_PATH]
			default [TYPE_PATH]
		]
	]

	set-path: routine [
		stack [block!]
		/local
			path [red-path!]
	][
		path: as red-path! block/pick stack 1 null
		set-type as red-value! path TYPE_SET_PATH
	]

	make-word: routine [
		src   [string!]
		type  [datatype!]
	][
		set-type
			as red-value! word/box (symbol/make-alt src) ;-- word/box puts it in stack/arguments
			type/value
	]

	to-word: func [
		stack [block!]
		src   [string!]
		type  [datatype!]
	][
		store stack make-word src type
	]

	pop: function [stack [block!]][
		value: last stack
		remove back tail stack

		either any [1 < length? stack head? stack/1][
			append/only last stack :value
		][
			pos: back tail stack						;-- root storage and offset-ed series (/into option)
			pos/1: insert/only last stack :value
		]
	]

	store: function [stack [block!] value][
		either any [1 < length? stack head? stack/1][
			append last stack value
		][
			pos: back tail stack						;-- root storage and offset-ed series (/into option)
			pos/1: insert last stack value
		]
	]

	transcode: function [
		src	[string!]
		dst	[block! none!]
		/part
			length [integer! string!]
		return: [block!]
		/local
			new s e c hex pos value cnt type process
			digit hexa-upper hexa-lower hexa hexa-char not-word-char not-word-1st
			not-file-char not-str-char not-mstr-char caret-char
			non-printable-char integer-end ws-ASCII ws-U+2k control-char
	][
		cs:		[- - - - - - - - - - - - - - - -]		;-- memoized bitsets
		stack:	clear []
		count?:	yes										;-- if TRUE, lines counter is enabled
		line: 	1

		append/only stack any [dst make block! 4]

		make-string: [
			new: make type (index? e) - index? s
			parse/case copy/part s e [					;@@ add /part option to parse!
				any [
					escaped-char (append new value)
					| #"^^"								;-- trash single caret chars
					| set c skip (append new c)
				]
			]
			new
		]

		make-file: [
			new: make type (index? e) - index? s
			append new dehex copy/part s e
			new
		]

		if cs/1 = '- [
			cs/1:  charset "0123465798"					;-- digit
			cs/2:  charset "ABCDEF"						;-- hexa-upper
			cs/3:  charset "abcdef"						;-- hexa-lower
			cs/4:  union cs/1 cs/2						;-- hexa
			cs/5:  union cs/4 cs/3						;-- hexa-char
			cs/6:  charset {/\^^,[](){}"#%$@:;}			;-- not-word-char
			cs/7:  union union cs/6 cs/1 charset {'}	;-- not-word-1st
			cs/8:  charset {[](){}"@:;}					;-- not-file-char
			cs/9:  #"^""								;-- not-str-char
			cs/10: #"}"									;-- not-mstr-char
			cs/11: charset [#"^(40)" - #"^(5F)"]		;-- caret-char
			cs/12: charset [#"^(00)" - #"^(1F)"]		;-- non-printable-char
			cs/13: charset {^{"[]);}					;-- integer-end
			cs/14: charset " ^-^M"						;-- ws-ASCII, ASCII common whitespaces
			cs/15: charset [#"^(2000)" - #"^(200A)"]	;-- ws-U+2k, Unicode spaces in the U+2000-U+200A range
			cs/16: charset [#"^(00)" - #"^(1F)"] 		;-- ASCII control characters

		]
		set [
			digit hexa-upper hexa-lower hexa hexa-char not-word-char not-word-1st
			not-file-char not-str-char not-mstr-char caret-char
			non-printable-char integer-end ws-ASCII ws-U+2k control-char
		] cs

		;-- Whitespaces list from: http://en.wikipedia.org/wiki/Whitespace_character
		ws: [
			pos: #"^/" (
				if count? [
					line: line + 1
					;append/only lines to block! stack/tail?
				]
			)
			| ws-ASCII									;-- only the common whitespaces are matched
			| #"^(0085)"								;-- U+0085 (Newline)
			| #"^(00A0)"								;-- U+00A0 (No-break space)
			| #"^(1680)"								;-- U+1680 (Ogham space mark)
			| #"^(180E)"								;-- U+180E (Mongolian vowel separator)
			| ws-U+2k									;-- U+2000-U+200A range
			| #"^(2028)"								;-- U+2028 (Line separator)
			| #"^(2029)"								;-- U+2029 (Paragraph separator)
			| #"^(202F)"								;-- U+202F (Narrow no-break space)
			| #"^(205F)"								;-- U+205F (Medium mathematical space)
			| #"^(3000)"								;-- U+3000 (Ideographic space)
		]

		newline-char: [
			#"^/"
			| #"^(0085)"								;-- U+0085 (Newline)
			| #"^(2028)"								;-- U+2028 (Line separator)
			| #"^(2029)"								;-- U+2029 (Paragraph separator)
		]

		counted-newline: [pos: #"^/" (line: line + 1)]

		ws-no-count: [(count?: no) ws (count?: yes)]

		escaped-char: [
			"^^(" [
				[										;-- special case first
					"null" 	 (value: #"^(00)")
					| "back" (value: #"^(08)")
					| "tab"  (value: #"^(09)")
					| "line" (value: #"^(0A)")
					| "page" (value: #"^(0C)")
					| "esc"  (value: #"^(1B)")
					| "del"	 (value: #"^(7F)")
				]
				| pos: [1 6 hexa-char] e: (				;-- Unicode values allowed up to 10FFFFh
					value: make-char pos e
				)
			] #")"
			| #"^^" [
				[
					#"/" 	(value: #"^/")
					| #"-"	(value: #"^-")
					| #"?" 	(value: #"^(del)")			;@@FIXME
					| #"^^" (value: #"^^")				;-- caret escaping case
					| #"{"	(value: #"{")
					| #"}"	(value: #"}")
					| #"^""	(value: #"^"")
				]
				| pos: caret-char (value: pos/1 - 64)
			]
		]

		char-rule: [
			{#"} s: [
				 escaped-char
				| ahead [non-printable-char | not-str-char] break
				| skip (value: s/1)
			] {"}
		]

		line-string: [
			{"} s: any [
				{^^"}
				| ahead [#"^"" | newline-char] break
				| escaped-char
				| skip
			]
			e: {"}
		]

		nested-curly-braces: [
			(cnt: 1)
			any [
				counted-newline
				| "^^{"
				| "^^}"
				| #"{" 	  (cnt: cnt + 1)
				| e: #"}" if (zero? cnt: cnt - 1) break
				| escaped-char
				| skip
			]
		]

		multiline-string: [#"{" s: nested-curly-braces]

		string-rule: [(type: string!) line-string | multiline-string]

		file-rule: [
			#"%" [
				line-string (process: make-string type: file!)
				| s: any [ahead [not-file-char | ws-no-count] break | skip] e:
				  (process: make-file type: file!)
			]
		]

		url-rule: [
			#":" not [integer-end | ws-no-count | end]
			any [#"@" | #":" | ahead [not-file-char | ws-no-count] break | skip] e:
			(type: url! store stack do make-file)
		]

		symbol-rule: [
			some [ahead [not-word-char | ws-no-count | control-char] break | skip] e:
		]

		begin-symbol-rule: [							;-- 1st char in symbols is restricted
			[not ahead [not-word-1st | ws-no-count | control-char]]
			symbol-rule
		]

		path-rule: [
			ahead slash (								;-- path detection barrier
				push-path stack type					;-- create empty path
				to-word stack copy/part s e word!		;-- push 1st path element
			)
			some [
				slash
				s: [
					integer-number-rule			(store stack make-number s e no)
					| begin-symbol-rule			(to-word stack copy/part s e word!)
					| paren-rule
					| #":" s: begin-symbol-rule	(to-word stack copy/part s e get-word!)
					;@@ add more datatypes here
					| (type: none print ["*** Syntax Error: invalid path value at:" back s])
					  reject
				]
				opt [#":" (set-path back tail stack)]
			] (pop stack)
		]

		word-rule: 	[
			#"%" ws-no-count (to-word stack "%" word!)	;-- special case for remainder op!
			| s: begin-symbol-rule (type: word!) [
					url-rule
					| path-rule							;-- path matched
					| opt [#":" (type: set-word!)]
					  (if type [to-word stack copy/part s e type])	;-- word or set-word matched
			  ]
		]

		get-word-rule: [
			#":" (type: get-word!) s: begin-symbol-rule [
				path-rule (type: get-path!)
				| (to-word stack copy/part s e type)	;-- get-word matched
			]
		]

		lit-word-rule: [
			#"'" (type: lit-word!) s: begin-symbol-rule [
				path-rule (type: lit-path!)				;-- path matched
				| (to-word stack copy/part s e type)	;-- lit-word matched
			]
		]

		issue-rule: [
			#"#" (type: issue!) s: symbol-rule
			(to-word stack copy/part s e type)
		]

		refinement-rule: [
			slash [
				some slash (type: word!) e:				;--  ///... case
				| ahead [not-word-char | ws-no-count | control-char] (type: word!) e: ;-- / case
				| symbol-rule (type: refinement! s: next s)
			]
			(to-word stack copy/part s e type)
		]

		hexa-rule: [2 8 hexa e: #"h"]

		integer-number-rule: [
			opt [#"-" | #"+"] digit any [digit | #"'" digit] e:
		]

		integer-rule: [
			float-special								;-- escape path for NaN, INFs
			| integer-number-rule
			  opt [float-number-rule | float-exp-rule e: (type: float!)]
			  ahead [integer-end | ws-no-count | end]
		]

		float-special: [
			s: opt [#"-"] "1.#" [
				[[#"N" | #"n"] [#"a" | #"A"] [#"N" | #"n"]]
				| [[#"I" | #"i"] [#"N" | #"n"] [#"F" | #"f"]]
			] e: (type: float!)
		]

		float-exp-rule: [[#"e" | #"E"] opt [#"-" | #"+"] 1 3 digit]

		float-number-rule: [
			[dot | comma] digit any [digit | #"'" digit]
			opt float-exp-rule e: (type: float!)
		]

		float-rule: [
			opt [#"-" | #"+"] float-number-rule
			ahead [integer-end | ws-no-count | end]
		]

		block-rule: [
			#"[" (append/only stack make block! 4)
			any-value
			#"]" (pop stack)
		]

		paren-rule: [
			#"(" (append/only stack make paren! 4)
			any-value
			#")" (pop stack)
		]

		escaped-rule: [
			"#[" pos: any ws [
				  "true"  			(value: true)
				| "false" 			(value: false)
				| [
					"none!"			(value: none!)
					| "logic!"		(value: logic!)
					| "block!"		(value: block!)
					| "integer!"	(value: integer!)
					| "word!"		(value: word!)
					| "set-word!"	(value: set-word!)
					| "get-word!"	(value: get-word!)
					| "lit-word!"	(value: lit-word!)
					| "refinement!"	(value: refinement!)
					;| "binary!"	(value: binary!)
					| "string!"		(value: string!)
					| "char!"		(value: char!)
					| "bitset!"		(value: bitset!)
					| "path!"		(value: path!)
					| "set-path!"	(value: set-path!)
					| "lit-path!"	(value: lit-path!)
					| "get-path!"	(value: get-path!)
					| "native!"		(value: native!)
					| "action!"		(value: action!)
					| "op!"			(value: op!)
					| "issue!"		(value: issue!)
					| "paren!"		(value: paren!)
					| "function!"	(value: function!)
					| "routine!"	(value: routine!)
				]
				| "none" 			(value: none)
			] pos: any ws #"]"
		]

		comment-rule: [#";" [to lf | to end]]

		wrong-delimiters: [
			pos: [
				  #"]" (value: #"[") | #")" (value: #"(")
				| #"[" (value: #"]") | #"(" (value: #")")
			] :pos
			(print ["missing matching" value])
		]

		literal-value: [
			pos: (e: none) s: [
				comment-rule
				| escaped-rule		(store stack value)
				| integer-rule		if (value: make-number s e type = float!) (store stack value)
				| float-rule		if (value: make-float s e) (store stack value)
				| hexa-rule			(store stack make-hexa s e)
				| word-rule
				| lit-word-rule
				| get-word-rule
				| refinement-rule
				| file-rule			(store stack value: do process)
				| char-rule			(store stack value)
				| issue-rule
				| block-rule
				| paren-rule
				| string-rule		(store stack do make-string)
				;| binary-rule	  	(stack/push load-binary s e)
			]
		]

		any-value: [pos: any [literal-value | ws]]

		red-rules: [any-value opt wrong-delimiters]

		unless either part [
			parse/case/part src red-rules length
		][
			parse/case src red-rules
		][
			print ["*** Syntax Error: invalid Red value at:" copy/part pos 20]
		]
		stack/1
	]
]


FIX: stack unrolling multiple bugs. Fixes the EXIT/RETURN issues revealed by newly added function tests.

Red/System [
	Title:   "Red execution stack functions"
	Author:  "Nenad Rakocevic"
	File: 	 %stack.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
	}
]

stack: context [										;-- call stack
	verbose: 0

	#define MARK_STACK(type) [
		func [
			fun [red-word!]
		][
			#if debug? = yes [if verbose > 0 [print-line "stack/mark"]]

			if ctop = c-end [
				print-line ["^/*** Error: call stack overflow!^/"]
				halt
			]
			ctop/1: type or (fun/symbol << 8)
			ctop/2: as-integer arguments
			arguments: top								;-- top of stack becomes frame base
			ctop: ctop + 2

			#if debug? = yes [if verbose > 1 [dump]]
		]
	]

	;-- header flags
	#enum flags! [
		FLAG_FUNCTION:	80000000h						;-- function! call
		FLAG_NATIVE:	40000000h						;-- native! or action! call
		FLAG_ROUTINE:	20000000h						;--	<reserved>
		FLAG_TRY:		10000000h						;--	TRY native
		FLAG_CATCH:		08000000h						;-- CATCH native
		FLAG_THROW_ATR:	04000000h						;-- Throw function attribut
		FLAG_CATCH_ATR:	02000000h						;--	Catch function attribut
	]

	arg-stk:  block/make-in root 1024					;-- argument stack (should never be relocated)
	call-stk: block/make-in root 512					;-- call stack (should never be relocated)

	set-flag arg-stk/node flag-series-fixed or flag-series-nogc
	set-flag call-stk/node flag-series-fixed or flag-series-nogc

	;-- Shortcuts for stack buffers simpler and faster access
	;-- (stack buffers are not resizable with such approach
	;-- this can be made more flexible (but slower) if necessary
	;-- in the future)

	args-series:  GET_BUFFER(arg-stk)
	calls-series: GET_BUFFER(call-stk)

	a-end: as cell!    (as byte-ptr! args-series)  + args-series/size
	c-end: as int-ptr! (as byte-ptr! calls-series) + calls-series/size

	arguments:	args-series/tail
	bottom:  	args-series/offset
	top:	 	args-series/tail
	cbottom: 	as int-ptr! calls-series/offset
	ctop:	 	as int-ptr! calls-series/tail

	reset: func [
		return:  [cell!]
		/local
			s	 [series!]
	][
		#if debug? = yes [if verbose > 0 [print-line "stack/reset"]]

		top: arguments									;-- overwrite last value
		arguments
	]

	keep: func [
		return:  [cell!]
		/local
			s	 [series!]
	][
		#if debug? = yes [if verbose > 0 [print-line "stack/keep"]]

		top: arguments + 1								;-- keep last value in arguments slot
		arguments
	]

	mark-native: MARK_STACK(FLAG_NATIVE)
	mark-func:	 MARK_STACK(FLAG_FUNCTION)
	mark-try:	 MARK_STACK(FLAG_TRY)
	mark-catch:	 MARK_STACK(FLAG_CATCH)

	unwind: does [
		#if debug? = yes [if verbose > 0 [print-line "stack/unwind"]]

		assert cbottom <= ctop
		ctop: ctop - 2

		either ctop = cbottom [
			arguments: bottom
			top: bottom
		][
			top: arguments + 1							;-- keep last value on stack
			arguments: as red-value! ctop/2
		]

		#if debug? = yes [if verbose > 1 [dump]]
	]

	unwind-last: func [
		return:  [red-value!]
		/local
			last [red-value!]
	][
		#if debug? = yes [if verbose > 0 [print-line "stack/unwind-last"]]

		last: arguments
		unwind
		copy-cell last arguments
	]

	unroll: func [
		flags	 [integer!]
		/local
			last [red-value!]
	][
		#if debug? = yes [if verbose > 0 [print-line "stack/unroll"]]

		last: arguments
		assert cbottom < ctop
		until [
			ctop: ctop - 2
			any [
				flags and ctop/1 = flags
				ctop <= cbottom
			]
		]
		ctop: ctop + 2									;-- ctop points past the current call frame
		copy-cell last as red-value! ctop/2
	]

	set-last: func [
		last	[red-value!]
		return: [red-value!]
	][
		#if debug? = yes [if verbose > 0 [print-line "stack/set-last"]]

		copy-cell last arguments
	]

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

		cell: top
		top: top + 1
		if top >= a-end [
			print-line ["^/*** Error: arguments stack overflow!^/"]
			halt
		]
		cell
	]

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

		copy-cell value top
		push*
	]

	pop: func [
		positions [integer!]
	][
		top: top - positions
	]

	#if debug? = yes [
		dump: does [									;-- debug purpose only
			print-line "^/---- Argument stack ----"
			dump-memory
				as byte-ptr! bottom
				4
				(as-integer top + 1 - bottom) >> 4
			print-line ["arguments: " arguments]
			print-line ["top: " top]

			print-line "^/---- Call stack ----"
			dump-memory
				as byte-ptr! cbottom
				4
			(as-integer ctop + 2 - cbottom) >> 4

			print-line ["ctop: " ctop]
		]
	]
]

Red/System [
	Title:   "Red execution stack functions"
	Author:  "Nenad Rakocevic"
	File: 	 %stack.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
	}
]

stack: context [										;-- call stack
	verbose: 0

	#define MARK_STACK(type) [
		func [
			fun [red-word!]
		][
			#if debug? = yes [if verbose > 0 [print-line "stack/mark"]]

			if ctop = c-end [
				print-line ["^/*** Error: call stack overflow!^/"]
				halt
			]
			ctop/1: type or (fun/symbol << 8)
			ctop/2: as-integer arguments
			arguments: top								;-- top of stack becomes frame base
			ctop: ctop + 2

			#if debug? = yes [if verbose > 1 [dump]]
		]
	]

	;-- header flags
	#enum flags! [
		FLAG_FUNCTION:	80000000h						;-- function! call
		FLAG_NATIVE:	40000000h						;-- native! or action! call
		FLAG_ROUTINE:	20000000h						;--	<reserved>
		FLAG_TRY:		10000000h						;--	TRY native
		FLAG_CATCH:		08000000h						;-- CATCH native
		FLAG_THROW_ATR:	04000000h						;-- Throw function attribut
		FLAG_CATCH_ATR:	02000000h						;--	Catch function attribut
	]

	arg-stk:  block/make-in root 1024					;-- argument stack (should never be relocated)
	call-stk: block/make-in root 512					;-- call stack (should never be relocated)

	set-flag arg-stk/node flag-series-fixed or flag-series-nogc
	set-flag call-stk/node flag-series-fixed or flag-series-nogc

	;-- Shortcuts for stack buffers simpler and faster access
	;-- (stack buffers are not resizable with such approach
	;-- this can be made more flexible (but slower) if necessary
	;-- in the future)

	args-series:  GET_BUFFER(arg-stk)
	calls-series: GET_BUFFER(call-stk)

	a-end: as cell!    (as byte-ptr! args-series)  + args-series/size
	c-end: as int-ptr! (as byte-ptr! calls-series) + calls-series/size

	arguments:	args-series/tail
	bottom:  	args-series/offset
	top:	 	args-series/tail
	cbottom: 	as int-ptr! calls-series/offset
	ctop:	 	as int-ptr! calls-series/tail

	reset: func [
		return:  [cell!]
		/local
			s	 [series!]
	][
		#if debug? = yes [if verbose > 0 [print-line "stack/reset"]]

		top: arguments									;-- overwrite last value
		arguments
	]

	keep: func [
		return:  [cell!]
		/local
			s	 [series!]
	][
		#if debug? = yes [if verbose > 0 [print-line "stack/keep"]]

		top: arguments + 1								;-- keep last value in arguments slot
		arguments
	]

	mark-native: MARK_STACK(FLAG_NATIVE)
	mark-func:	 MARK_STACK(FLAG_FUNCTION)
	mark-try:	 MARK_STACK(FLAG_TRY)
	mark-catch:	 MARK_STACK(FLAG_CATCH)

	unwind: does [
		#if debug? = yes [if verbose > 0 [print-line "stack/unwind"]]

		assert cbottom <= ctop
		ctop: ctop - 2

		either ctop = cbottom [
			arguments: bottom
			top: bottom
		][
			top: arguments + 1							;-- keep last value on stack
			arguments: as red-value! ctop/2
		]

		#if debug? = yes [if verbose > 1 [dump]]
	]

	unwind-last: func [
		return:  [red-value!]
		/local
			last [red-value!]
	][
		#if debug? = yes [if verbose > 0 [print-line "stack/unwind-last"]]

		last: arguments
		unwind
		copy-cell last arguments
	]

	unroll: func [
		flags	 [integer!]
		/local
			last [red-value!]
	][
		#if debug? = yes [if verbose > 0 [print-line "stack/unroll"]]

		last: arguments
		assert cbottom < ctop
		until [
			ctop: ctop - 2
			any [
				zero? (flags and ctop/1)
				cbottom <= ctop
			]
		]
		ctop: ctop + 2
		unwind
		copy-cell last arguments
	]

	set-last: func [
		last	[red-value!]
		return: [red-value!]
	][
		#if debug? = yes [if verbose > 0 [print-line "stack/set-last"]]

		copy-cell last arguments
	]

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

		cell: top
		top: top + 1
		if top >= a-end [
			print-line ["^/*** Error: arguments stack overflow!^/"]
			halt
		]
		cell
	]

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

		copy-cell value top
		push*
	]

	pop: func [
		positions [integer!]
	][
		top: top - positions
	]

	#if debug? = yes [
		dump: does [									;-- debug purpose only
			print-line "^/---- Argument stack ----"
			dump-memory
				as byte-ptr! bottom
				4
				(as-integer top + 1 - bottom) >> 4
			print-line ["arguments: " arguments]
			print-line ["top: " top]

			print-line "^/---- Call stack ----"
			dump-memory
				as byte-ptr! cbottom
				4
			(as-integer ctop + 1 - cbottom) >> 4

			print-line ["ctop: " ctop]
		]
	]
]