FIX: issue #1217 (Compile time lexer accepts #"<tab>", and run time lexer refuses it)

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

system/lexer: context [

	make-tuple: routine [
		start  [string!]
		end	   [string!]
		/local
			c	 [integer!]
			n	 [integer!]
			m	 [integer!]
			len  [integer!]
			unit [integer!]
			size [integer!]
			p	 [byte-ptr!]
			tp	 [byte-ptr!]
			ret  [red-value!]
	][
		str:  GET_BUFFER(start)
		unit: GET_UNIT(str)
		p:	  string/rs-head start
		len:  end/head - start/head
		ret: stack/arguments
		tp: (as byte-ptr! ret) + 4

		n: 0
		size: 0
		until [
			c: string/get-char p unit
			either c = as-integer #"." [
				size: size + 1
				tp/size: as byte! n
				n: 0
			][
				m: n * 10
				n: m
				m: n + c - #"0"
				n: m
			]
			p: p + unit
			len: len - 1
			zero? len
		]
		size: size + 1									;-- last number
		tp/size: as byte! n
		ret/header: TYPE_TUPLE or (size << 19)
		ret
	]

	make-number: routine [
		start  [string!]
		end	   [string!]
		type   [datatype!]
		/local
			c	 [integer!]
			n	 [integer!]
			m	 [integer!]
			len  [integer!]
			unit [integer!]
			p	 [byte-ptr!]
			neg? [logic!]
	][
		if type/value <> TYPE_INTEGER [
			make-float start end type					;-- 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!]
		type  [datatype!]
		/local
			str  [series!]
			cp	 [integer!]
			unit [integer!]
			p	 [byte-ptr!]
			tail [byte-ptr!]
			cur	 [byte-ptr!]
			s0	 [byte-ptr!]
			byte [byte!]
			f	 [float!]
	][
		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
		f: string/to-float s0
		either type/value = TYPE_FLOAT [float/box f][percent/box f / 100.0]
		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]
		]
		path/args: null
	]

	set-path: routine [
		stack [block!]
		/local
			path [red-path!]
	][
		path: as red-path! block/pick stack 1 null
		path/args: 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
			four half non-zero
	][
		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 [							;-- non-printable-char
				#"^(00)" - #"^(08)"						;-- (exclude TAB)
				#"^(0A)" - #"^(1F)"
			]
			cs/13: charset {^{"[]);x}					;-- 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
			cs/17: charset "01234"						;-- four
			cs/18: charset "012345"						;-- half
		    cs/19: charset "123456789"					;-- non-zero
		]
		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
			four half non-zero
		] cs

		byte: [
			"25" half
			| "2" four digit
			| "1" digit digit
			| non-zero digit
			| digit
		]

		;-- 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: [2 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]
				  (cause-error 'syntax 'invalid [char! mold skip s -2])
				  reject
				| skip (value: s/1)
			][
				{"}
				| (cause-error 'syntax 'invalid [char! mold skip s -2])
			]
		]

		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 type)
					| 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/lines copy back s])
					  reject
				]
				opt [#":" (set-path back tail stack)]
			] (pop stack)
		]

		word-rule: 	[
			#"%" [ws-no-count | end] (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
			]
			opt [#":" (cause-error 'syntax 'invalid [type trim/lines copy back s])]
		]

		issue-rule: [
			#"#" (type: issue!) s: symbol-rule (
				if (index? s) = index? e [
					cause-error 'syntax 'invalid [mold type trim/lines copy skip s -4]
				]
				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"]

		tuple-value-rule: [
			byte 2 11 [dot byte] e: (type: tuple!)
		]

		tuple-rule: [
			tuple-value-rule
			ahead [integer-end | ws-no-count | end]
		]

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

		integer-rule: [
			float-special (value: make-number s e type)	;-- escape path for NaN, INFs
			| integer-number-rule
			  opt [float-number-rule | float-exp-rule e: (type: float!)]
			  opt [#"%" (type: percent!)]
			  ahead [integer-end | ws-no-count | end]
			  (value: make-number s e type)
			  opt [
				#"x" (value2: 0x0 value2/x: value)
				s: integer-number-rule
				(value2/y: make-number s e type value: value2)
			  ]
		]

		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
			opt [#"%" (type: percent!)]
			ahead [integer-end | ws-no-count | end]
		]

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

		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 [trim/lines copy skip pos -3 value])
		]

		literal-value: [
			pos: (e: none) s: [
				comment-rule
				| escaped-rule		(store stack value)
				| integer-rule		if (value) (store stack value)
				| float-rule		if (value: make-float s e type) (store stack value)
				| tuple-rule		(store stack make-tuple s e)
				| 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)
				| block-rule
				| paren-rule
				| string-rule		(store stack do make-string)
				;| binary-rule	  	(stack/push load-binary s e)
				| map-rule
				| issue-rule
			]
		]

		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-2015 Nenad Rakocevic. All rights reserved."
	License: {
		Distributed under the Boost Software License, Version 1.0.
		See https://github.com/red/red/blob/master/BSL-License.txt
	}
]

system/lexer: context [

	make-tuple: routine [
		start  [string!]
		end	   [string!]
		/local
			c	 [integer!]
			n	 [integer!]
			m	 [integer!]
			len  [integer!]
			unit [integer!]
			size [integer!]
			p	 [byte-ptr!]
			tp	 [byte-ptr!]
			ret  [red-value!]
	][
		str:  GET_BUFFER(start)
		unit: GET_UNIT(str)
		p:	  string/rs-head start
		len:  end/head - start/head
		ret: stack/arguments
		tp: (as byte-ptr! ret) + 4

		n: 0
		size: 0
		until [
			c: string/get-char p unit
			either c = as-integer #"." [
				size: size + 1
				tp/size: as byte! n
				n: 0
			][
				m: n * 10
				n: m
				m: n + c - #"0"
				n: m
			]
			p: p + unit
			len: len - 1
			zero? len
		]
		size: size + 1									;-- last number
		tp/size: as byte! n
		ret/header: TYPE_TUPLE or (size << 19)
		ret
	]

	make-number: routine [
		start  [string!]
		end	   [string!]
		type   [datatype!]
		/local
			c	 [integer!]
			n	 [integer!]
			m	 [integer!]
			len  [integer!]
			unit [integer!]
			p	 [byte-ptr!]
			neg? [logic!]
	][
		if type/value <> TYPE_INTEGER [
			make-float start end type					;-- 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!]
		type  [datatype!]
		/local
			str  [series!]
			cp	 [integer!]
			unit [integer!]
			p	 [byte-ptr!]
			tail [byte-ptr!]
			cur	 [byte-ptr!]
			s0	 [byte-ptr!]
			byte [byte!]
			f	 [float!]
	][
		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
		f: string/to-float s0
		either type/value = TYPE_FLOAT [float/box f][percent/box f / 100.0]
		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]
		]
		path/args: null
	]

	set-path: routine [
		stack [block!]
		/local
			path [red-path!]
	][
		path: as red-path! block/pick stack 1 null
		path/args: 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
			four half non-zero
	][
		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 {^{"[]);x}					;-- 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
			cs/17: charset "01234"						;-- four
			cs/18: charset "012345"						;-- half
		    cs/19: charset "123456789"					;-- non-zero
		]
		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
			four half non-zero
		] cs

		byte: [
			"25" half
			| "2" four digit
			| "1" digit digit
			| non-zero digit
			| digit
		]

		;-- 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: [2 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 type)
					| 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/lines copy back s])
					  reject
				]
				opt [#":" (set-path back tail stack)]
			] (pop stack)
		]

		word-rule: 	[
			#"%" [ws-no-count | end] (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
			]
			opt [#":" (cause-error 'syntax 'invalid [type trim/lines copy back s])]
		]

		issue-rule: [
			#"#" (type: issue!) s: symbol-rule (
				if (index? s) = index? e [
					cause-error 'syntax 'invalid [mold type trim/lines copy skip s -4]
				]
				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"]

		tuple-value-rule: [
			byte 2 11 [dot byte] e: (type: tuple!)
		]

		tuple-rule: [
			tuple-value-rule
			ahead [integer-end | ws-no-count | end]
		]

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

		integer-rule: [
			float-special (value: make-number s e type)	;-- escape path for NaN, INFs
			| integer-number-rule
			  opt [float-number-rule | float-exp-rule e: (type: float!)]
			  opt [#"%" (type: percent!)]
			  ahead [integer-end | ws-no-count | end]
			  (value: make-number s e type)
			  opt [
				#"x" (value2: 0x0 value2/x: value)
				s: integer-number-rule
				(value2/y: make-number s e type value: value2)
			  ]
		]

		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
			opt [#"%" (type: percent!)]
			ahead [integer-end | ws-no-count | end]
		]

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

		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 [trim/lines copy skip pos -3 value])
		]

		literal-value: [
			pos: (e: none) s: [
				comment-rule
				| escaped-rule		(store stack value)
				| integer-rule		if (value) (store stack value)
				| float-rule		if (value: make-float s e type) (store stack value)
				| tuple-rule		(store stack make-tuple s e)
				| 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)
				| block-rule
				| paren-rule
				| string-rule		(store stack do make-string)
				;| binary-rule	  	(stack/push load-binary s e)
				| map-rule
				| issue-rule
			]
		]

		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
	]
]


TESTS: bugfix in unicode unit tests.

TESTS: bugfix in unicode unit tests.

Red/System [
	Title:   "Red/System runtime tools test"
	Author:  "Nenad Rakocevic & Peter W A Wood"
	File: 	 %unicode-test.reds
	Rights:  "Copyright (C) 2012 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.reds
#include %../../../runtime/red.reds

~~~start-file~~~ "unicode"

===start-group=== "load-utf8 iso-8559 only"

with red [
  lui-func: func [
    utf8-str        [c-string!]
    return:         [c-string!]
    /local
      n             [node!]
      s             [series!]
      str           [c-string!]
  ][

    n: unicode/load-utf8 utf8-str 1 + system/words/length? utf8-str
    s: as series! n/value
    str: as c-string! s/offset
    str
  ]
]

--test-- "lui1"
  lius1:  lui-func "a"
--assert lius1/1 = #"a"

--test-- "lui2"
lius2:  lui-func "^(01)a^(7F)"
--assert lius2/1 = #"^(01)"
--assert lius2/2 = #"a"
--assert lius2/3 = #"^(7F)"

--test-- "lui3"
lius3:  lui-func "^(01)a^(7F)^(C2)^(80)^(C3)^(BF)"
--assert lius3/1 = #"^(01)"
--assert lius3/2 = #"a"
--assert lius3/3 = #"^(7F)"
--assert lius3/4 = #"^(80)"
--assert lius3/5 = #"^(FF)"

===end-group===

===start-group=== "load-utf8 UCS-2 only"
--test-- "luu21"
luu21:  lui-func "^(C4)^(80)^(C4)^(BF)^(C5)^(80)^(C5)^(BF)"
--assert luu21/1 = #"^(00)"
--assert luu21/2 = #"^(01)"
--assert luu21/3 = #"^(3F)"
--assert luu21/4 = #"^(01)"
--assert luu21/5 = #"^(40)"
--assert luu21/6 = #"^(01)"
--assert luu21/7 = #"^(7F)"
--assert luu21/8 = #"^(01)"

--test-- "luu22"
luu22:  lui-func "^(EF)^(BF)^(BF)^(DF)^(BF)^(E0)^(A0)^(80)"
--assert luu22/1 = #"^(FF)"
--assert luu22/2 = #"^(FF)"
--assert luu22/3 = #"^(FF)"
--assert luu22/4 = #"^(07)"
--assert luu22/5 = #"^(00)"
--assert luu22/6 = #"^(08)"

===end-group===

===start-group=== "load-utf8 UCS-4 only"
--test-- "luu41"
luu41:  lui-func "^(F0)^(90)^(80)^(80)"
--assert luu41/1 = #"^(00)"
--assert luu41/2 = #"^(00)"
--assert luu41/3 = #"^(01)"
--assert luu41/4 = #"^(00)"

--test-- "luu42"
luu42: lui-func "^(F4)^(8F)^(BF)^(BF)"
--assert luu42/1 = #"^(FF)"
--assert luu42/2 = #"^(FF)"
--assert luu42/3 = #"^(10)"
--assert luu42/4 = #"^(00)"

--test-- "luu43"
luu43: lui-func "^(F0)^(90)^(80)^(80)^(F4)^(8F)^(BF)^(BF)"
--assert luu43/1 = #"^(00)"
--assert luu43/2 = #"^(00)"
--assert luu43/3 = #"^(01)"
--assert luu43/4 = #"^(00)"
--assert luu43/5 = #"^(FF)"
--assert luu43/6 = #"^(FF)"
--assert luu43/7 = #"^(10)"
--assert luu43/8 = #"^(00)"

--test-- "luu44"
luu44: lui-func "^(F4)^(80)^(80)^(80)"
--assert luu44/1 = #"^(00)"
--assert luu44/2 = #"^(00)"
--assert luu44/3 = #"^(10)"
--assert luu44/4 = #"^(00)"

===end-group===

===start-group=== "load-utf8 ISO-8859 -> UCS2"
--test-- "luiu21"
luiu21: lui-func "a^(EF)^(BF)^(BF)"
--assert luiu21/1 = #"^(61)"
--assert luiu21/2 = #"^(00)"
--assert luiu21/3 = #"^(FF)"
--assert luiu21/4 = #"^(FF)"
===end-group===

===start-group=== "load-utf8 ISO-8859 -> UCS4"
--test-- "luiu41"
luiu41: lui-func "a^(F4)^(80)^(80)^(80)"
--assert luiu41/1 = #"^(61)"
--assert luiu41/2 = #"^(00)"
--assert luiu41/3 = #"^(00)"
--assert luiu41/4 = #"^(00)"
--assert luiu41/5 = #"^(00)"
--assert luiu41/6 = #"^(00)"
--assert luiu41/7 = #"^(10)"
--assert luiu41/8 = #"^(00)"
===end-group===

===start-group=== "load-utf8 ISO-8859 -> UCS2 -> UCS4"
--test-- "luiu241"
luiu241: lui-func "a^(EF)^(BF)^(BF)^(F4)^(80)^(80)^(80)"
--assert luiu241/1  = #"^(61)"
--assert luiu241/2  = #"^(00)"
--assert luiu241/3  = #"^(00)"
--assert luiu241/4  = #"^(00)"
--assert luiu241/5  = #"^(FF)"
--assert luiu241/6  = #"^(FF)"
--assert luiu241/7  = #"^(00)"
--assert luiu241/8  = #"^(00)"
--assert luiu241/9  = #"^(00)"
--assert luiu241/10 = #"^(00)"
--assert luiu241/11 = #"^(10)"
--assert luiu241/12 = #"^(00)"
===end-group===

~~~end-file~~~

Red/System [
	Title:   "Red/System runtime tools test"
	Author:  "Nenad Rakocevic & Peter W A Wood"
	File: 	 %unicode-test.reds
	Rights:  "Copyright (C) 2012 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.reds
#include %../../../runtime/red.reds

~~~start-file~~~ "unicode"

===start-group=== "load-utf8 iso-8559 only"

with red [
  lui-func: func [
    utf8-str        [c-string!]
    return:         [c-string!]
    /local
      n             [node!]
      s             [series!]
      str           [c-string!]
  ][

    n: unicode/load-utf8 utf8-str size? utf8-str
    s: as series! n/value
    str: as c-string! s/offset
    str
  ]
]

--test-- "lui1"
  lius1:  lui-func "a"
--assert lius1/1 = #"a"

--test-- "lui2"
lius2:  lui-func "^(01)a^(7F)"
--assert lius2/1 = #"^(01)"
--assert lius2/2 = #"a"
--assert lius2/3 = #"^(7F)"

--test-- "lui3"
lius3:  lui-func "^(01)a^(7F)^(C2)^(80)^(C3)^(BF)"
--assert lius3/1 = #"^(01)"
--assert lius3/2 = #"a"
--assert lius3/3 = #"^(7F)"
--assert lius3/4 = #"^(80)"
--assert lius3/5 = #"^(FF)"

===end-group===

===start-group=== "load-utf8 UCS-2 only"
--test-- "luu21"
luu21:  lui-func "^(C4)^(80)^(C4)^(BF)^(C5)^(80)^(C5)^(BF)"
--assert luu21/1 = #"^(00)"
--assert luu21/2 = #"^(01)"
--assert luu21/3 = #"^(3F)"
--assert luu21/4 = #"^(01)"
--assert luu21/5 = #"^(40)"
--assert luu21/6 = #"^(01)"
--assert luu21/7 = #"^(7F)"
--assert luu21/8 = #"^(01)"

--test-- "luu22"
luu22:  lui-func "^(EF)^(BF)^(BF)^(DF)^(BF)^(E0)^(A0)^(80)"
--assert luu22/1 = #"^(FF)"
--assert luu22/2 = #"^(FF)"
--assert luu22/3 = #"^(FF)"
--assert luu22/4 = #"^(07)"
--assert luu22/5 = #"^(00)"
--assert luu22/6 = #"^(08)"

===end-group===

===start-group=== "load-utf8 UCS-4 only"
--test-- "luu41"
luu41:  lui-func "^(F0)^(90)^(80)^(80)"
--assert luu41/1 = #"^(00)"
--assert luu41/2 = #"^(00)"
--assert luu41/3 = #"^(01)"
--assert luu41/4 = #"^(00)"

--test-- "luu42"
luu42: lui-func "^(F4)^(8F)^(BF)^(BF)"
--assert luu42/1 = #"^(FF)"
--assert luu42/2 = #"^(FF)"
--assert luu42/3 = #"^(10)"
--assert luu42/4 = #"^(00)"

--test-- "luu43"
luu43: lui-func "^(F0)^(90)^(80)^(80)^(F4)^(8F)^(BF)^(BF)"
--assert luu43/1 = #"^(00)"
--assert luu43/2 = #"^(00)"
--assert luu43/3 = #"^(01)"
--assert luu43/4 = #"^(00)"
--assert luu43/5 = #"^(FF)"
--assert luu43/6 = #"^(FF)"
--assert luu43/7 = #"^(10)"
--assert luu43/8 = #"^(00)"

--test-- "luu44"
luu44: lui-func "^(F4)^(80)^(80)^(80)"
--assert luu44/1 = #"^(00)"
--assert luu44/2 = #"^(00)"
--assert luu44/3 = #"^(10)"
--assert luu44/4 = #"^(00)"

===end-group===

===start-group=== "load-utf8 ISO-8859 -> UCS2"
--test-- "luiu21"
luiu21: lui-func "a^(EF)^(BF)^(BF)"
--assert luiu21/1 = #"^(61)"
--assert luiu21/2 = #"^(00)"
--assert luiu21/3 = #"^(FF)"
--assert luiu21/4 = #"^(FF)"
===end-group===

===start-group=== "load-utf8 ISO-8859 -> UCS4"
--test-- "luiu41"
luiu41: lui-func "a^(F4)^(80)^(80)^(80)"
--assert luiu41/1 = #"^(61)"
--assert luiu41/2 = #"^(00)"
--assert luiu41/3 = #"^(00)"
--assert luiu41/4 = #"^(00)"
--assert luiu41/5 = #"^(00)"
--assert luiu41/6 = #"^(00)"
--assert luiu41/7 = #"^(10)"
--assert luiu41/8 = #"^(00)"
===end-group===

===start-group=== "load-utf8 ISO-8859 -> UCS2 -> UCS4"
--test-- "luiu241"
luiu241: lui-func "a^(EF)^(BF)^(BF)^(F4)^(80)^(80)^(80)"
--assert luiu241/1  = #"^(61)"
--assert luiu241/2  = #"^(00)"
--assert luiu241/3  = #"^(00)"
--assert luiu241/4  = #"^(00)"
--assert luiu241/5  = #"^(FF)"
--assert luiu241/6  = #"^(FF)"
--assert luiu241/7  = #"^(00)"
--assert luiu241/8  = #"^(00)"
--assert luiu241/9  = #"^(00)"
--assert luiu241/10 = #"^(00)"
--assert luiu241/11 = #"^(10)"
--assert luiu241/12 = #"^(00)"
===end-group===

~~~end-file~~~


FEAT: added refinements evaluation support to interpreter.

Tested ok with all function types.

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

#define EVAL_CHECK_INPUT [
	if pc >= end [
		print-line "*** Interpreter Error: missing argument..."
		halt
	]
]

#define EVAL_FETCH_ARGUMENT [
	EVAL_CHECK_INPUT
	if verbose > 0 [log "fetching argument"]
	stack/push pc
	pc: pc + 1
	count: count + 1
]

interpreter: context [
	verbose: 0

	return-type: -1										;-- return type for routine calls

	log: func [msg [c-string!]][
		print "eval: "
		print-line msg
	]

	find-refinement?: func [
		ref		[red-word!]
		path	[red-path!]
		slot	[red-word!]
		end		[red-value!]
		return: [logic!]
	][
		while [slot < end][
			if TYPE_OF(slot) <> TYPE_WORD [
				print-line "*** Error: function call with non-word refinement!"
				halt
			]
			if (symbol/resolve slot/symbol) = (symbol/resolve ref/symbol) [
				return yes
			]
			slot: slot + 1
		]
		no
	]

	exec-routine: func [
		fun	 [red-routine!]
		/local
			native [red-native!]
			arg	   [red-value!]
			bool   [red-logic!]
			int	   [red-integer!]
			s	   [series!]
			ret	   [integer!]
			count  [integer!]
			call
	][
		s: as series! fun/more/value
		native: as red-native! s/offset + 2
		call: as function! [return: [integer!]] native/code
		count: (routine/get-arity fun) - 1				;-- zero-based stack access

		while [count >= 0][
			arg: stack/arguments + count
			switch TYPE_OF(arg) [
				TYPE_LOGIC	 [push logic/get arg]
				TYPE_INTEGER [push integer/get arg]
				default		 [push arg]
			]
			count: count - 1
		]
		either positive? return-type [
			ret: call
			switch return-type [
				TYPE_LOGIC	[
					bool: as red-logic! stack/arguments
					bool/header: TYPE_LOGIC
					bool/value: ret <> 0
				]
				TYPE_INTEGER [
					int: as red-integer! stack/arguments
					int/header: TYPE_INTEGER
					int/value: ret
				]
				default [assert false]					;-- should never happen
			]
		][
			call
		]
	]

	eval-infix: func [
		value 	  [red-value!]
		pc		  [red-value!]
		end		  [red-value!]
		sub?	  [logic!]
		return:   [red-value!]
		/local
			op	  [red-op!]
			call-op
	][
		if verbose > 0 [log "infix detected!"]

		stack/mark-native as red-word! pc + 1
		eval-expression pc end yes yes
		pc: pc + 2										;-- skip both left operand and operator
		pc: eval-expression pc end no yes				;-- eval right operand
		op: as red-op! value
		call-op: as function! [] op/code
		call-op
		either sub? [stack/unwind][stack/unwind-last]

		if verbose > 0 [
			value: stack/arguments
			print-line ["eval: op return type: " TYPE_OF(value)]
		]
		pc
	]

	eval-arguments: func [
		native 	[red-native!]
		pc		[red-value!]
		end	  	[red-value!]
		path	[red-path!]
		pos 	[red-value!]
		return: [red-value!]
		/local
			fun	  	  [red-function!]
			function? [logic!]
			routine?  [logic!]
			value	  [red-value!]
			tail	  [red-value!]
			dt		  [red-datatype!]
			path-end  [red-value!]
			s		  [series!]
			required? [logic!]
			ref?	  [logic!]
			index	  [integer!]
			count	  [integer!]
			prev	  [integer!]
			size	  [integer!]
			ref-array [int-ptr!]
			call
	][
		routine?:  TYPE_OF(native) = TYPE_ROUTINE
		function?: any [routine? TYPE_OF(native) = TYPE_FUNCTION]

		s: as series! either function? [
			fun: as red-function! native
			fun/spec/node/value
		][
			native/spec/value
		]
		value: s/offset
		tail:  s/tail

		unless null? path [
			path-end: block/rs-tail as red-block! path
			if pos + 1 = path-end [path: null]			;-- no refinement following the function
		]												;-- so, process it as a non-path call

		count:  	 0									;-- nb of fetched arguments (used as offset)
		index: 	 	 1
		return-type: -1
		ref?:		 no
		required?:	 yes								;-- yes: processing mandatory args, no: optonal args

		size: as-integer tail - value
		ref-array: system/stack/top - size
		system/stack/top: ref-array						;-- reserve space on native stack for refs array

		while [value < tail][
			if verbose > 0 [print-line ["eval: spec entry type: " TYPE_OF(value)]]
			switch TYPE_OF(value) [
				TYPE_WORD [
					unless required? [
						either ref? [
							unless function? [
								prev: index - 1			;-- overwrite previous entry if it was a ref marker
								either negative? ref-array/prev [
									ref-array/prev: count
									index: prev
								][
									ref-array/index: count
								]

							]
						][
							either function? [
								none/push
							][
								ref-array/index: -1
							]
						]
						index: index + 1
					]
					if any [required? ref?][
						EVAL_CHECK_INPUT
						if verbose > 0 [log "evaluating argument"]
						pc: eval-expression pc end no yes	;-- eval argument
						count: count + 1
					]
				]
				TYPE_LIT_WORD [EVAL_FETCH_ARGUMENT]
				TYPE_GET_WORD [EVAL_FETCH_ARGUMENT]
				TYPE_REFINEMENT [
					if required? [required?: no]		;-- no more mandatory arguments

					ref?: either null? path [no][
						find-refinement? as red-word! value path as red-word! pos path-end
					]

					either function? [
						logic/push ref?
					][
						ref-array/index: either ref? [count][-1]
						index: index + 1
					]
				]
				TYPE_SET_WORD [
					if routine? [
						value: block/pick (as red-block! value + 1) 1
						assert TYPE_OF(value) = TYPE_WORD
						dt: as red-datatype! _context/get as red-word! value
						assert TYPE_OF(dt) = TYPE_DATATYPE
						return-type: dt/value
					]
				]
				default [0]								;-- ignore other values
			]
			value: value + 1
		]

		unless function? [
			system/stack/top: ref-array					;-- reset native stack to our custom arguments frame
			call: as function! [] native/code			;-- direct call for actions/natives
			call
		]
		pc
	]

	eval-path-element: func [
		slot     [red-value!]
		head     [red-value!]
		tail     [red-value!]
		result   [red-value!]
		alt-slot [red-value!]							;-- alternative element (computed from paren)
		set?     [logic!]
		return:  [red-value!]
		/local
			value  [red-value!]
			int	   [red-integer!]
	][
		value: case [
			TYPE_OF(slot) = TYPE_GET_WORD [_context/get as red-word! slot]
			null? alt-slot 				  [slot]
			true		   				  [alt-slot]
		]
		switch TYPE_OF(value) [
			TYPE_WORD [
				either slot = head [
					result: _context/get as red-word! value
					switch TYPE_OF(result) [
						TYPE_ACTION						;@@ replace with TYPE_ANY_FUNCTION
						TYPE_NATIVE
						TYPE_ROUTINE
						TYPE_FUNCTION [
							return result
						]
						TYPE_BLOCK 						;@@ replace with TYPE_SERIES
						TYPE_PATH
						TYPE_LIT_PATH
						TYPE_GET_PATH
						TYPE_SET_PATH
						TYPE_STRING [

						]
						;TYPE_OBJECT
						;TYPE_PORT [
						;
						;]
						default [
							;; TBD raise an error
						]
					]
				][
					result: either all [set? slot + 1 = tail][
						value: actions/find as red-series! result value null no no no null null no no no no
						actions/poke as red-series! value 2 stack/arguments
						stack/arguments
					][
						actions/select as red-series! result value null no no no null null no no
					]
				]
			]
			TYPE_PAREN [
				stack/mark-native words/_body			;@@ ~paren
				eval as red-block! value				;-- eval paren content
				stack/unwind
				result: eval-path-element slot head tail result stack/top - 1 set?
			]
			TYPE_INTEGER [
				int: as red-integer! value
				result: either all [set? slot + 1 = tail][
					actions/poke as red-series! result int/value stack/arguments
					stack/arguments
				][
					actions/pick as red-series! result int/value
				]
			]
			TYPE_STRING [
				--NOT_IMPLEMENTED--
			]
		]
		result
	]

	eval-path: func [
		value   [red-value!]
		pc		[red-value!]							;-- path to evaluate
		end		[red-value!]
		set?	[logic!]
		return: [red-value!]
		/local
			path   [red-path!]
			head   [red-value!]
			tail   [red-value!]
			slot   [red-value!]
			result [red-value!]
			saved  [red-value!]
	][
		if verbose > 0 [print-line "eval: path"]

		path:  as red-path! value
		head:  block/rs-head as red-block! path
		tail:  block/rs-tail as red-block! path
		slot:  head
		saved: stack/top

		if TYPE_OF(slot) <> TYPE_WORD [
			print-line "*** Error: path value must start with a word!"
			halt
		]

		result: null

		while [slot < tail][
			if verbose > 1 [print-line ["slot type: " TYPE_OF(slot)]]

			result: eval-path-element slot head tail result null set?

			switch TYPE_OF(result) [
				TYPE_ACTION						;@@ replace with TYPE_ANY_FUNCTION
				TYPE_NATIVE
				TYPE_ROUTINE
				TYPE_FUNCTION [
					pc: eval-code result pc end yes path slot
					return pc
				]
				default [0]
			]
			slot: slot + 1
		]

		stack/top: saved
		stack/push result
		pc
	]

	eval-code: func [
		value	[red-value!]
		pc		[red-value!]
		end		[red-value!]
		sub?	[logic!]
		path	[red-path!]
		slot 	[red-value!]
		return: [red-value!]
		/local
			fun	   [red-function!]
			native [red-native!]
			s	   [series!]
			call
	][
		switch TYPE_OF(value) [
			TYPE_ACTION
			TYPE_NATIVE [
				if verbose > 0 [log "pushing action/native frame"]
				stack/mark-native as red-word! pc
				pc: eval-arguments as red-native! value pc end path slot 	;-- fetch args and exec
				either sub? [stack/unwind][stack/unwind-last]

				if verbose > 0 [
					value: stack/arguments
					print-line ["eval: action/native return type: " TYPE_OF(value)]
				]
			]
			TYPE_ROUTINE [
				if verbose > 0 [log "pushing routine frame"]
				stack/mark-native as red-word! pc
				pc: eval-arguments as red-native! value pc end path slot
				exec-routine as red-routine! value
				either sub? [stack/unwind][stack/unwind-last]

				if verbose > 0 [
					value: stack/arguments
					print-line ["eval: routine return type: " TYPE_OF(value)]
				]
			]
			TYPE_FUNCTION [
				if verbose > 0 [log "pushing function frame"]
				stack/mark-func as red-word! pc	;@@
				pc: eval-arguments as red-native! value pc end path slot
				fun: as red-function! value
				s: as series! fun/more/value
				;eval as red-block! s/offset	;@@ eval body version (add an option for that)
				native: as red-native! s/offset + 2
				call: as function! [] native/code
				call
				either sub? [stack/unwind][stack/unwind-last]

				if verbose > 0 [
					value: stack/arguments
					print-line ["eval: function return type: " TYPE_OF(value)]
				]
			]
		]
		pc
	]

	eval-expression: func [
		pc		  [red-value!]
		end	  	  [red-value!]
		infix	  [logic!]								;-- TRUE => don't check for infix
		sub?	  [logic!]
		return:   [red-value!]
		/local
			next  [red-word!]
			value [red-value!]
			w	  [red-word!]
	][
		next: as red-word! pc + 1

		if all [
			not infix
			next < end
			TYPE_OF(next) = TYPE_WORD
		][
			value: _context/get next
			if TYPE_OF(value) = TYPE_OP [
				return eval-infix value pc end sub?
			]
		]

		if verbose > 0 [print-line ["eval: fetching value of type " TYPE_OF(pc)]]

		switch TYPE_OF(pc) [
			TYPE_PAREN [
				stack/mark-native as red-word! pc		;@@ ~paren
				eval as red-block! pc
				either sub? [stack/unwind][stack/unwind-last]
				pc: pc + 1
			]
			TYPE_SET_WORD [
				stack/mark-native as red-word! pc		;@@ ~set
				word/push as red-word! pc
				pc: pc + 1
				pc: eval-expression pc end no yes
				word/set
				either sub? [stack/unwind][stack/unwind-last]

				if verbose > 0 [
					value: stack/arguments
					print-line ["eval: set-word return type: " TYPE_OF(value)]
				]
			]
			TYPE_SET_PATH [
				value: pc
				pc: pc + 1
				pc: eval-expression pc end no yes		;-- yes: push value on top of stack
				pc: eval-path value pc end yes
			]
			TYPE_GET_WORD [
				word/get as red-word! pc
				pc: pc + 1
			]
			TYPE_LIT_WORD [
				w: word/push as red-word! pc			;-- push lit-word! on stack
				w/header: TYPE_WORD						;-- set correct value type on stack
				pc: pc + 1
			]
			TYPE_WORD [
				value: _context/get as red-word! pc
				pc: pc + 1

				switch TYPE_OF(value) [
					TYPE_ACTION							;@@ replace with TYPE_ANY_FUNCTION
					TYPE_NATIVE
					TYPE_ROUTINE
					TYPE_FUNCTION [
						pc: eval-code value pc end sub? null null
					]
					default [
						if verbose > 0 [log "getting word value"]
						either sub? [
							stack/push value			;-- nested expression: push value
						][
							stack/set-last value		;-- root expression: return value
						]

						if verbose > 0 [
							value: stack/arguments
							print-line ["eval: word return type: " TYPE_OF(value)]
						]
					]
				]
			]
			TYPE_PATH [
				value: pc
				pc: pc + 1
				pc: eval-path value pc end no
			]
			TYPE_LIT_PATH [
				value: stack/push pc
				value/header: TYPE_PATH
				pc: pc + 1
			]
			TYPE_OP [
				--NOT_IMPLEMENTED--						;-- op used in prefix mode
			]
			default [
				either sub? [
					stack/push pc						;-- nested expression: push value
				][
					stack/set-last pc					;-- root expression: return value
				]
				pc: pc + 1
			]
		]
		pc
	]

	eval-next: func [
		value	[red-value!]
		tail	[red-value!]
		sub?	[logic!]
		return: [red-value!]							;-- return start of next expression
	][
		stack/mark-native words/_body					;-- outer stack frame
		value: eval-expression value tail no sub?
		either sub? [stack/unwind][stack/unwind-last]
		value
	]

	eval: func [
		code	  [red-block!]
		/local
			value [red-value!]
			tail  [red-value!]
	][
		value: block/rs-head code
		tail:  block/rs-tail code
		if value = tail [
			stack/set-last unset-value
			exit
		]

		stack/mark-native words/_body					;-- outer stack frame

		while [value < tail][
			if verbose > 0 [log "root loop..."]
			value: eval-expression value tail no no
			if value + 1 < tail [stack/reset]
		]

		stack/unwind-last
	]

]

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

#define EVAL_CHECK_INPUT [
	if pc >= end [
		print-line "*** Interpreter Error: missing argument..."
		halt
	]
]

#define EVAL_ARGUMENT [
	EVAL_CHECK_INPUT
	if verbose > 0 [log "evaluating argument"]
	pc: eval-expression pc end no yes					;-- eval argument
	count: count + 1
]

#define EVAL_FETCH_ARGUMENT [
	EVAL_CHECK_INPUT
	if verbose > 0 [log "fetching argument"]
	stack/push pc
	pc: pc + 1
	count: count + 1
]

interpreter: context [
	verbose: 0

	ref-array: as int-ptr! allocate 64 * size? integer!	;-- for natives/actions refinements handling
	offset: 0											;-- refinements counter for last call
	count:  0											;-- arguments counter for last call
	return-type: -1										;-- return type for routine calls

	log: func [msg [c-string!]][
		print "eval: "
		print-line msg
	]

	exec: func [
		native	  [red-native!]							;-- works for action! too
		/local
			index [integer!]
			call
	][
		call: as function! [] native/code
		index: 0
		if positive? offset [
			until [
				system/words/push ref-array/index
				index: index + 1
				offset: offset - 1
				zero? offset
			]
		]
		call
	]

	exec-routine: func [
		routine [red-routine!]
		/local
			native [red-native!]
			arg	   [red-value!]
			bool   [red-logic!]
			int	   [red-integer!]
			s	   [series!]
			ret	   [integer!]
			call
	][
		s: as series! routine/more/value
		native: as red-native! s/offset + 2
		call: as function! [return: [integer!]] native/code
		count: count - 1								;-- zero-based stack access

		while [count >= 0][
			arg: stack/arguments + count
			switch TYPE_OF(arg) [
				TYPE_LOGIC	 [push logic/get arg]
				TYPE_INTEGER [push integer/get arg]
				default		 [push arg]
			]
			count: count - 1
		]
		either positive? return-type [
			ret: call
			switch return-type [
				TYPE_LOGIC	[
					bool: as red-logic! stack/arguments
					bool/header: TYPE_LOGIC
					bool/value: ret <> 0
				]
				TYPE_INTEGER [
					int: as red-integer! stack/arguments
					int/header: TYPE_INTEGER
					int/value: ret
				]
				default [assert true]					;-- should never happen
			]
		][
			call
		]
	]

	eval-infix: func [
		value 	  [red-value!]
		pc		  [red-value!]
		end		  [red-value!]
		sub?	  [logic!]
		return:   [red-value!]
		/local
			op	  [red-op!]
			call-op
	][
		if verbose > 0 [log "infix detected!"]

		stack/mark-native as red-word! pc + 1
		eval-expression pc end yes yes
		pc: pc + 2										;-- skip both left operand and operator
		pc: eval-expression pc end no yes				;-- eval right operand
		op: as red-op! value
		call-op: as function! [] op/code
		call-op
		either sub? [stack/unwind][stack/unwind-last]

		if verbose > 0 [
			value: stack/arguments
			print-line ["eval: op return type: " TYPE_OF(value)]
		]
		pc
	]

	eval-arguments: func [
		native 	[red-native!]
		pc		[red-value!]
		end	  	[red-value!]
		return: [red-value!]
		/local
			fun	  	  [red-function!]
			function? [logic!]
			routine?  [logic!]
			value	  [red-value!]
			tail	  [red-value!]
			dt		  [red-datatype!]
			s		  [series!]
			ref?	  [logic!]
	][
		function?: TYPE_OF(native) = TYPE_FUNCTION
		routine?:  TYPE_OF(native) = TYPE_ROUTINE

		s: as series! either any [function? routine?][
			fun: as red-function! native
			fun/spec/node/value
		][
			native/spec/value
		]
		value: s/offset
		tail:  s/tail

		count:  	 0
		offset: 	 0
		return-type: -1
		ref?:		 no

		while [value < tail][
			if verbose > 0 [print-line ["eval: spec entry type: " TYPE_OF(value)]]
			switch TYPE_OF(value) [
				TYPE_WORD [
					either zero? offset [
						EVAL_ARGUMENT
					][
						either ref? [
							either any [function? routine?][
								none/push
							][
								ref-array/offset: count
								EVAL_ARGUMENT
							]
						][
							either any [function? routine?][
								none/push
							][
								ref-array/offset: -1
							]
						]
						offset: offset + 1
					]
				]
				TYPE_LIT_WORD [EVAL_FETCH_ARGUMENT]
				TYPE_GET_WORD [EVAL_FETCH_ARGUMENT]
				TYPE_REFINEMENT [
					ref?: no							;@@ set it correctly once path supported
					either any [function? routine?][
						;TBD: check here if refinement is used
						logic/push false
						offset: 1
					][
						ref-array/offset: -1
						offset: offset + 1
					]
				]
				TYPE_SET_WORD [
					if routine? [
						value: block/pick (as red-block! value + 1) 1
						assert TYPE_OF(value) = TYPE_WORD
						dt: as red-datatype! _context/get as red-word! value
						assert TYPE_OF(dt) = TYPE_DATATYPE
						return-type: dt/value
					]
					return pc
				]
				default [0]
			]
			value: value + 1
		]
		pc
	]

	eval-path-element: func [
		slot     [red-value!]
		head     [red-value!]
		tail     [red-value!]
		result   [red-value!]
		alt-slot [red-value!]							;-- alternative element (computed from paren)
		set?     [logic!]
		return:  [red-value!]
		/local
			value  [red-value!]
			int	   [red-integer!]
	][
		value: case [
			TYPE_OF(slot) = TYPE_GET_WORD [_context/get as red-word! slot]
			null? alt-slot 				  [slot]
			true		   				  [alt-slot]
		]
		switch TYPE_OF(value) [
			TYPE_WORD [
				either slot = head [
					result: _context/get as red-word! value
					switch TYPE_OF(result) [
						TYPE_ACTION						;@@ replace with TYPE_ANY_FUNCTION
						TYPE_NATIVE
						TYPE_ROUTINE
						TYPE_FUNCTION [

						]
						TYPE_BLOCK 						;@@ replace with TYPE_SERIES
						TYPE_PATH
						TYPE_LIT_PATH
						TYPE_GET_PATH
						TYPE_SET_PATH
						TYPE_STRING [

						]
						;TYPE_OBJECT
						;TYPE_PORT [
						;
						;]
					]
				][
					result: either all [set? slot + 1 = tail][
						value: actions/find as red-series! result value null no no no null null no no no no
						actions/poke as red-series! value 2 stack/arguments
						stack/arguments
					][
						actions/select as red-series! result value null no no no null null no no
					]
				]
			]
			TYPE_PAREN [
				stack/mark-native words/_body			;@@ ~paren
				eval as red-block! value				;-- eval paren content
				stack/unwind
				result: eval-path-element slot head tail result stack/top - 1 set?
			]
			TYPE_INTEGER [
				int: as red-integer! value
				result: either all [set? slot + 1 = tail][
					actions/poke as red-series! result int/value stack/arguments
					stack/arguments
				][
					actions/pick as red-series! result int/value
				]
			]
			TYPE_STRING [
				--NOT_IMPLEMENTED--
			]
		]
		result
	]

	eval-path: func [
		pc	 [red-value!]								;-- path to evaluate
		set? [logic!]
		/local
			path   [red-path!]
			head   [red-value!]
			tail   [red-value!]
			slot   [red-value!]
			result [red-value!]
			saved  [red-value!]
	][
		if verbose > 0 [print-line "eval: path"]

		path:  as red-path! pc
		head:  block/rs-head as red-block! path
		tail:  block/rs-tail as red-block! path
		slot:  head
		saved: stack/top

		if TYPE_OF(slot) <> TYPE_WORD [
			print-line "*** Error: path value must start with a word!"
			halt
		]

		result: null

		while [slot < tail][
			if verbose > 1 [print-line ["slot type: " TYPE_OF(slot)]]

			result: eval-path-element slot head tail result null set?
			slot: slot + 1
		]

		stack/top: saved
		stack/push result
	]

	eval-expression: func [
		pc		  [red-value!]
		end	  	  [red-value!]
		infix	  [logic!]								;-- TRUE => don't check for infix
		sub?	  [logic!]
		return:   [red-value!]
		/local
			next  [red-word!]
			value [red-value!]
			fun	  [red-function!]
			w	  [red-word!]
			s	  [series!]
	][
		next: as red-word! pc + 1

		if all [
			not infix
			next < end
			TYPE_OF(next) = TYPE_WORD
		][
			value: _context/get next
			if TYPE_OF(value) = TYPE_OP [
				return eval-infix value pc end sub?
			]
		]

		if verbose > 0 [print-line ["eval: fetching value of type " TYPE_OF(pc)]]

		switch TYPE_OF(pc) [
			TYPE_PAREN [
				stack/mark-native as red-word! pc		;@@ ~paren
				eval as red-block! pc
				either sub? [stack/unwind][stack/unwind-last]
				pc: pc + 1
			]
			TYPE_SET_WORD [
				stack/mark-native as red-word! pc		;@@ ~set
				word/push as red-word! pc
				pc: pc + 1
				pc: eval-expression pc end no yes
				word/set
				either sub? [stack/unwind][stack/unwind-last]

				if verbose > 0 [
					value: stack/arguments
					print-line ["eval: set-word return type: " TYPE_OF(value)]
				]
			]
			TYPE_SET_PATH [
				value: pc
				pc: pc + 1
				pc: eval-expression pc end no yes		;-- yes: push value on top of stack
				eval-path value yes
			]
			TYPE_GET_WORD [
				word/get as red-word! pc
				pc: pc + 1
			]
			TYPE_LIT_WORD [
				w: word/push as red-word! pc			;-- push lit-word! on stack
				w/header: TYPE_WORD						;-- set correct value type on stack
				pc: pc + 1
			]
			TYPE_WORD [
				value: _context/get as red-word! pc
				pc: pc + 1

				switch TYPE_OF(value) [
					TYPE_ACTION
					TYPE_NATIVE [
						if verbose > 0 [log "pushing action/native frame"]
						stack/mark-native as red-word! pc
						pc: eval-arguments as red-native! value pc end
						exec as red-native! value
						either sub? [stack/unwind][stack/unwind-last]

						if verbose > 0 [
							value: stack/arguments
							print-line ["eval: action/native return type: " TYPE_OF(value)]
						]
					]
					TYPE_ROUTINE [
						if verbose > 0 [log "pushing routine frame"]
						stack/mark-native as red-word! pc
						pc: eval-arguments as red-native! value pc end
						exec-routine as red-routine! value
						either sub? [stack/unwind][stack/unwind-last]

						if verbose > 0 [
							value: stack/arguments
							print-line ["eval: routine return type: " TYPE_OF(value)]
						]
					]
					TYPE_FUNCTION [
						if verbose > 0 [log "pushing function frame"]
						stack/mark-func as red-word! pc	;@@
						pc: eval-arguments as red-native! value pc end
						fun: as red-function! value
						s: as series! fun/more/value
						;eval as red-block! s/offset	;@@ eval body version (add an option for that)
						exec as red-native! s/offset + 2
						either sub? [stack/unwind][stack/unwind-last]

						if verbose > 0 [
							value: stack/arguments
							print-line ["eval: function return type: " TYPE_OF(value)]
						]
					]
					default [
						if verbose > 0 [log "getting word value"]
						either sub? [
							stack/push value			;-- nested expression: push value
						][
							stack/set-last value		;-- root expression: return value
						]

						if verbose > 0 [
							value: stack/arguments
							print-line ["eval: word return type: " TYPE_OF(value)]
						]
					]
				]
			]
			TYPE_PATH [
				eval-path pc no
				pc: pc + 1
			]
			TYPE_LIT_PATH [
				value: stack/push pc
				value/header: TYPE_PATH
				pc: pc + 1
			]
			TYPE_OP [
				--NOT_IMPLEMENTED--						;-- op used in prefix mode
			]
			default [
				either sub? [
					stack/push pc						;-- nested expression: push value
				][
					stack/set-last pc					;-- root expression: return value
				]
				pc: pc + 1
			]
		]
		pc
	]

	eval-next: func [
		value	[red-value!]
		tail	[red-value!]
		sub?	[logic!]
		return: [red-value!]							;-- return start of next expression
	][
		stack/mark-native words/_body					;-- outer stack frame
		value: eval-expression value tail no sub?
		either sub? [stack/unwind][stack/unwind-last]
		value
	]

	eval: func [
		code	  [red-block!]
		/local
			value [red-value!]
			tail  [red-value!]
	][
		value: block/rs-head code
		tail:  block/rs-tail code
		if value = tail [
			stack/set-last unset-value
			exit
		]

		stack/mark-native words/_body					;-- outer stack frame

		while [value < tail][
			if verbose > 0 [log "root loop..."]
			value: eval-expression value tail no no
			if value + 1 < tail [stack/reset]
		]

		stack/unwind-last
	]

]


TESTS: Added a couple of system/words test to nmespace tests

Red/System [
	Title:   "Red/System null test script"
	Author:  "Nenad Rakocevic & Peter W A Wood"
	File: 	 %namespace-test.reds
	Rights:  "Copyright (C) 2011 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.reds

~~~start-file~~~ "namespace"

    nmsp1: context [
      i: 123
      f: 1.23
      f32: as float32! 2.46
      l: true
      s: "my string"
      fn: func [pi [pointer! [integer!]] return: [integer!]] [pi/value: 789 789]
      fn2: func [
        i [integer!]
        return: [integer!]
      ][ 2 * i]
      st: declare struct! [
        a [integer!]
        b [integer!]
      ]
    ]

    i: 987
	ctx: context [
		i: 123
		j: "test"
		foo: func [return: [integer!]][
			i: i + 1
			i
		]
		--test-- "in-ns1"
		--assert 124 = foo
	]

===start-group=== "basic"

  --test-- "ns1"
  --assert 123 = nmsp1/i
  --test-- "ns2"
  --assert 1.23 = nmsp1/f
  --test-- "ns3"
  --assert (as float32! 2.46) = nmsp1/f32
  --test-- "ns4"
  --assert nmsp1/l
  --test-- "ns5"
  --assert nmsp1/s/1 = #"m"
  --assert nmsp1/s/2 = #"y"
  --assert nmsp1/s/3 = #" "
  --assert nmsp1/s/4 = #"s"
  --assert nmsp1/s/5 = #"t"
  --assert nmsp1/s/6 = #"r"
  --assert nmsp1/s/7 = #"i"
  --assert nmsp1/s/8 = #"n"
  --assert nmsp1/s/9 = #"g"
  --test-- "ns6"
    nmsp1/s: "hello"
  --assert 5 = length? nmsp1/s
  --test-- "ns7"
    ns1-b-i: 0
  --assert 789 = nmsp1/fn :ns1-b-i
  --test-- "ns8"
    ns1-b-i: 4
  --assert 8 = nmsp1/fn2 ns1-b-i
  --test-- "ns9"
    nmsp1/st/a: 1
  --assert nmsp1/st/a = 1
  --test-- "ns10"
  --assert ctx/j/1 = #"t"
  --test-- "ns11"
  --assert ctx/foo = 125
  --test-- "ns12"
    ctx/i: ctx/i + 1
  --assert ctx/i = 126
  --assert i = 987
  --test-- "ns13"
    ns13i: 1
    ns13i-nsp: context [
      ns13i: 2
      get-ns13i: func [return: [integer!]] [ns13i]
    ]
  --assert 2 = ns13i-nsp/get-ns13i

===end-group===

===start-group=== "hiding"
    i: 321
    f: 3.21
    f32: as float32! 6.42
    l: false
    s: "not my string"
    fn: func [pi [pointer! [integer!]]] [pi/value: 987]
    fn2: func[
        i [integer!]
        return: [integer!]
      ][ 3 * i]
    st: declare struct! [
        a [integer!]
        b [integer!]
    ]

  --test-- "nmh1"
    nmsp1/i: 789
  --assert i = 321
  --test-- "nmh2"
    nmsp1/f: 7.89
  --assert f = 3.21
  --test-- "nmh3"
    nmsp1/f32: as float32! 7.89
  --assert nmsp1/f32 = as float32! 7.89
  --test-- "nmh4"
    nmsp1/s: "str"
  --assert 13 = length? s
  --test-- "nmh5"
    nmh5-i: 1
    nmsp1/fn :nmh5-i
  --assert 789 = nmh5-i
  --test-- "nmh6"
    nmh6-i: 1
    fn :nmh6-i
  --assert 987 = nmh6-i
  --test-- "nmh7"
    nmh7-i: 2
  --assert 4 = nmsp1/fn2 nmh7-i
  --assert 6 = fn2 nmh7-i
  --test-- "nmh8"
    st/a: 1
    st/b: 2
    nmsp1/st/a: 100
    nmsp1/st/b: 200
  --assert 1 = st/a
  --assert 2 = st/b

===end-group===

===start-group=== "initialisation"
    nmsp2: context [
      i: 2
      j: 3
      k: 0
      s: "12345"
      st: declare struct! [
        a [integer!]
        b [c-string!]
        c [float!]
        d [integer!]
      ]

      k: i * j
      s/1: #"h"
      s/2: #"e"
      s/3: #"l"
      s/4: #"l"
      s/5: #"o"
      st/a: 1
      st/b: "hello"
      st/c: 12345.678
      st/d: 1
      until [
        i: i * j
        j: j - 1
        j < 1
      ]
    ]
  --test-- "nmi1"
  --assert nmsp2/i = 12
  --test-- "nmi2"
  --assert nmsp2/j = 0
  --test-- "nmi3"
  --assert nmsp2/k = 6
  --test-- "nmi4"
  --assert nmsp2/s/1 = #"h"
  --assert nmsp2/s/2 = #"e"
  --assert nmsp2/s/3 = #"l"
  --assert nmsp2/s/4 = #"l"
  --assert nmsp2/s/5 = #"o"
  --test-- "nmi5"
  --assert nmsp2/st/a = 1
  --test-- "nmi6"
  --assert nmsp2/st/b/1 = #"h"
  --assert nmsp2/st/b/2 = #"e"
  --assert nmsp2/st/b/3 = #"l"
  --assert nmsp2/st/b/4 = #"l"
  --assert nmsp2/st/b/5 = #"o"
  --test-- "nmi7"
  --assert nmsp2/st/c = 12345.678
  --test-- "nmi8"
  --assert nmsp2/st/d = 1

===end-group===

===start-group=== "multiple"
    nmspa: context [
      i: 1
    ]
    nmspb: context [
      i: 2
    ]
    nmspc: context [
      i: 3
    ]
    nmspd: context [
      i: 4
    ]
    nmspe: context [
      i: 5
    ]
    nmspf: context [
      i: 6
    ]
    nmspg: context [
      i: 7
    ]
    nmsph: context [
      i: 8
    ]
    nmspi: context [
      i: 9
    ]
    nmspj: context [
      i: 10
    ]
    nmspk: context [
      i: 11
    ]
  --test-- "nmm1"
  --assert nmspa/i = 1
  --assert nmspb/i = 2
  --assert nmspc/i = 3
  --assert nmspd/i = 4
  --assert nmspe/i = 5
  --assert nmspf/i = 6
  --assert nmspg/i = 7
  --assert nmsph/i = 8
  --assert nmspi/i = 9
  --assert nmspj/i = 10
  --assert nmspk/i = 11

===end-group===

===start-group=== "global access"
  --test-- "nmga1"
    i2: 0
    j: 3
    nmsp3: context [
      i: 2
      k: i * j
      i2: 4
    ]
  --assert nmsp3/k = 6
  --assert nmsp3/i2 = 4
  --assert i2 = 0
  --test-- "nmga2"
      j3: 1
    nmsp4: context [
      i3: 2
      k3: i3 * j3
      i4: 4
    ]
    i4: 0
    j3: 3
  --assert nmsp4/k3 = 2
  --assert i4 = 0
===end-group===

===start-group=== "pointers"
  --test-- "nmp1"
    i: 12345
    nmsp5: context [
      pi: declare pointer! [integer!]
    ]
    nmsp5/pi: :i
  --assert nmsp5/pi/value = 12345
  ; --test-- "nmp2"						;-- getting a pointer on a variable in a context using a path
  ;   pi: declare pointer! [integer!]	;-- is not a supported feature. Use a local function to
  ;   nmsp6: context [					;-- get such pointer.
  ;     i: 12345
  ;   ]
  ;   pi: :nmsp6/i
  ; --assert pi/value = 12345
  --test-- "nmp3"
    nmsp6a: context [
      i: 67890
      get-addr-i: func [
        return: [pointer! [integer!]]
      ][
        :i
      ]
    ]
    pinmp3: declare pointer! [integer!]
    pinmp3: nmsp6a/get-addr-i
  --assert 67890 = pinmp3/value

===end-group===

===start-group=== "nesting"
  --test-- "nmm1"
    nmsp7: context [
      i: 0
      nmsp7-1: context [
        i: 1
        j: i * nmsp7/i
        nmsp7-2: context [
          i: 2
          j: i * nmsp7/i
          k: i * nmsp7/nmsp7-1/i
          nmsp7-3: context [
            i: 3
            j: i * nmsp7/i
            k: i * nmsp7/nmsp7-1/i
            l: i * nmsp7/nmsp7-1/nmsp7-2/i
          ]
          --assert i = 2
          --assert j = 0
          --assert k = 2
		  --assert nmsp7/i = 0
		  --assert nmsp7/nmsp7-1/i = 1
		  --assert nmsp7/nmsp7-1/j = 0
        ]
        --assert i = 1
        --assert j = 0
        --assert nmsp7/i = 0
      ]
      --assert i = 0
    ]
  --assert nmsp7/i = 0
  --assert nmsp7/nmsp7-1/i = 1
  --assert nmsp7/nmsp7-1/j = 0
  --assert nmsp7/nmsp7-1/nmsp7-2/i = 2
  --assert nmsp7/nmsp7-1/nmsp7-2/j = 0
  --assert nmsp7/nmsp7-1/nmsp7-2/k = 2
  --assert nmsp7/nmsp7-1/nmsp7-2/nmsp7-3/i = 3
  --assert nmsp7/nmsp7-1/nmsp7-2/nmsp7-3/j = 0
  --assert nmsp7/nmsp7-1/nmsp7-2/nmsp7-3/k = 3
  --assert nmsp7/nmsp7-1/nmsp7-2/nmsp7-3/l = 6
===end-group===

===start-group=== "include"
  --test-- "nminc1"
    nmsp8: context [
      #include %namespace-test-include.reds
    ]
  --assert 54321 = nmsp8/i

===end-group===

===start-group=== "libs"
    nmsp-lib: context [
      #import [
        LIBM-file cdecl [
          abs-int: "abs" [
            i       [integer!]
            return: [integer!]
          ]
        ]
      ]
      #import [
        LIBC-file cdecl [
          strnlen: "strnlen" [
            str     [c-string!]
            maxlen  [integer!]
            return: [integer!]
          ]
        ]
      ]
    ]
  --test-- "nmlibs1"
  --assert 1 = nmsp-lib/abs-int -1
  --test-- "nmlibs2"
  --assert 11 = nmsp-lib/strnlen "hello world" 20

===end-group===

===start-group=== "cross-reference"

	nmxr1: context [c: 789 fooo: func [][nmxr2/e: 123]]
	nmxr2: context [e: 456 f: nmxr1/c]

  --test-- "ns-cross-1"
	--assert nmxr2/e = 456
	nmxr1/fooo
	--assert nmxr2/e = 123

  --test-- "ns-cross-2"
	--assert nmxr2/f = 789

===end-group===

===start-group=== "with"
  --test-- "nsw1"
    nsw1-nsp: context [b: 123]
    with nsw1-nsp [
      --assert b = 123
    ]

  --test-- "nsw2"
    nsw2-nsp1: context [b: 123]
    nsw2-nsp2: context [b: 456]
    with [nsw2-nsp1 nsw2-nsp2] [
      --assert b = 123
      --assert nsw2-nsp1/b = 123
      --assert nsw2-nsp2/b = 456
    ]

  --test-- "nsw3"
    nsw3-nsp1: context [z: declare pointer! [integer!] fooo: func [][nsw3-nsp2/e: 123]]
    nsw3-nsp2: context [e: 456]

    with nsw3-nsp1 [
      c: 123
      z: null
    ]
	--assert nsw3-nsp1/z = null

	  e: -1
	  with [nsw3-nsp1 nsw3-nsp2][
	    fooo
	    --assert e = 123
	  ]
	--assert e = -1

	--test-- "nsw4"
    nsw4-nsp1: context [e: 456]
    nsw4-nsp2: context [fooo: func [][e: 123]]
    with [nsw4-nsp1 nsw4-nsp2] [
      fooo
      --assert e = 456
    ]

===end-group===

===start-group=== "System/Words"

  --test-- "nssw1"
    nssw1-a: 1
    nssw1-nmsp: context [
      nssw1-a: 2
      --assert 1 = system/words/nssw1-a
      --assert 2 = nssw1-a
      system/words/nssw1-a: 3
    ]
  --assert nssw1-a = 3

  --test-- 'nssw2'
    nssw2-i: 1
    nssw2-nmsp: context [
     nssw2-i: 2
     pi: declare pointer! [integer!]
     pi: :system/words/nssw2-i
     --assert pi/value = 1
     pi/value = 3
    ]
  --assert nssw2-i = 3

===end-group===

~~~end-file~~~

Red/System [
	Title:   "Red/System null test script"
	Author:  "Nenad Rakocevic & Peter W A Wood"
	File: 	 %namespace-test.reds
	Rights:  "Copyright (C) 2011 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.reds

~~~start-file~~~ "namespace"

    nmsp1: context [
      i: 123
      f: 1.23
      f32: as float32! 2.46
      l: true
      s: "my string"
      fn: func [pi [pointer! [integer!]] return: [integer!]] [pi/value: 789 789]
      fn2: func [
        i [integer!]
        return: [integer!]
      ][ 2 * i]
      st: declare struct! [
        a [integer!]
        b [integer!]
      ]
    ]

    i: 987
	ctx: context [
		i: 123
		j: "test"
		foo: func [return: [integer!]][
			i: i + 1
			i
		]
		--test-- "in-ns1"
		--assert 124 = foo
	]

===start-group=== "basic"

  --test-- "ns1"
  --assert 123 = nmsp1/i
  --test-- "ns2"
  --assert 1.23 = nmsp1/f
  --test-- "ns3"
  --assert (as float32! 2.46) = nmsp1/f32
  --test-- "ns4"
  --assert nmsp1/l
  --test-- "ns5"
  --assert nmsp1/s/1 = #"m"
  --assert nmsp1/s/2 = #"y"
  --assert nmsp1/s/3 = #" "
  --assert nmsp1/s/4 = #"s"
  --assert nmsp1/s/5 = #"t"
  --assert nmsp1/s/6 = #"r"
  --assert nmsp1/s/7 = #"i"
  --assert nmsp1/s/8 = #"n"
  --assert nmsp1/s/9 = #"g"
  --test-- "ns6"
    nmsp1/s: "hello"
  --assert 5 = length? nmsp1/s
  --test-- "ns7"
    ns1-b-i: 0
  --assert 789 = nmsp1/fn :ns1-b-i
  --test-- "ns8"
    ns1-b-i: 4
  --assert 8 = nmsp1/fn2 ns1-b-i
  --test-- "ns9"
    nmsp1/st/a: 1
  --assert nmsp1/st/a = 1
  --test-- "ns10"
  --assert ctx/j/1 = #"t"
  --test-- "ns11"
  --assert ctx/foo = 125
  --test-- "ns12"
    ctx/i: ctx/i + 1
  --assert ctx/i = 126
  --assert i = 987
  --test-- "ns13"
    ns13i: 1
    ns13i-nsp: context [
      ns13i: 2
      get-ns13i: func [return: [integer!]] [ns13i]
    ]
  --assert 2 = ns13i-nsp/get-ns13i

===end-group===

===start-group=== "hiding"
    i: 321
    f: 3.21
    f32: as float32! 6.42
    l: false
    s: "not my string"
    fn: func [pi [pointer! [integer!]]] [pi/value: 987]
    fn2: func[
        i [integer!]
        return: [integer!]
      ][ 3 * i]
    st: declare struct! [
        a [integer!]
        b [integer!]
    ]

  --test-- "nmh1"
    nmsp1/i: 789
  --assert i = 321
  --test-- "nmh2"
    nmsp1/f: 7.89
  --assert f = 3.21
  --test-- "nmh3"
    nmsp1/f32: as float32! 7.89
  --assert nmsp1/f32 = as float32! 7.89
  --test-- "nmh4"
    nmsp1/s: "str"
  --assert 13 = length? s
  --test-- "nmh5"
    nmh5-i: 1
    nmsp1/fn :nmh5-i
  --assert 789 = nmh5-i
  --test-- "nmh6"
    nmh6-i: 1
    fn :nmh6-i
  --assert 987 = nmh6-i
  --test-- "nmh7"
    nmh7-i: 2
  --assert 4 = nmsp1/fn2 nmh7-i
  --assert 6 = fn2 nmh7-i
  --test-- "nmh8"
    st/a: 1
    st/b: 2
    nmsp1/st/a: 100
    nmsp1/st/b: 200
  --assert 1 = st/a
  --assert 2 = st/b

===end-group===

===start-group=== "initialisation"
    nmsp2: context [
      i: 2
      j: 3
      k: 0
      s: "12345"
      st: declare struct! [
        a [integer!]
        b [c-string!]
        c [float!]
        d [integer!]
      ]

      k: i * j
      s/1: #"h"
      s/2: #"e"
      s/3: #"l"
      s/4: #"l"
      s/5: #"o"
      st/a: 1
      st/b: "hello"
      st/c: 12345.678
      st/d: 1
      until [
        i: i * j
        j: j - 1
        j < 1
      ]
    ]
  --test-- "nmi1"
  --assert nmsp2/i = 12
  --test-- "nmi2"
  --assert nmsp2/j = 0
  --test-- "nmi3"
  --assert nmsp2/k = 6
  --test-- "nmi4"
  --assert nmsp2/s/1 = #"h"
  --assert nmsp2/s/2 = #"e"
  --assert nmsp2/s/3 = #"l"
  --assert nmsp2/s/4 = #"l"
  --assert nmsp2/s/5 = #"o"
  --test-- "nmi5"
  --assert nmsp2/st/a = 1
  --test-- "nmi6"
  --assert nmsp2/st/b/1 = #"h"
  --assert nmsp2/st/b/2 = #"e"
  --assert nmsp2/st/b/3 = #"l"
  --assert nmsp2/st/b/4 = #"l"
  --assert nmsp2/st/b/5 = #"o"
  --test-- "nmi7"
  --assert nmsp2/st/c = 12345.678
  --test-- "nmi8"
  --assert nmsp2/st/d = 1

===end-group===

===start-group=== "multiple"
    nmspa: context [
      i: 1
    ]
    nmspb: context [
      i: 2
    ]
    nmspc: context [
      i: 3
    ]
    nmspd: context [
      i: 4
    ]
    nmspe: context [
      i: 5
    ]
    nmspf: context [
      i: 6
    ]
    nmspg: context [
      i: 7
    ]
    nmsph: context [
      i: 8
    ]
    nmspi: context [
      i: 9
    ]
    nmspj: context [
      i: 10
    ]
    nmspk: context [
      i: 11
    ]
  --test-- "nmm1"
  --assert nmspa/i = 1
  --assert nmspb/i = 2
  --assert nmspc/i = 3
  --assert nmspd/i = 4
  --assert nmspe/i = 5
  --assert nmspf/i = 6
  --assert nmspg/i = 7
  --assert nmsph/i = 8
  --assert nmspi/i = 9
  --assert nmspj/i = 10
  --assert nmspk/i = 11

===end-group===

===start-group=== "global access"
  --test-- "nmga1"
    i2: 0
    j: 3
    nmsp3: context [
      i: 2
      k: i * j
      i2: 4
    ]
  --assert nmsp3/k = 6
  --assert nmsp3/i2 = 4
  --assert i2 = 0
  --test-- "nmga2"
      j3: 1
    nmsp4: context [
      i3: 2
      k3: i3 * j3
      i4: 4
    ]
    i4: 0
    j3: 3
  --assert nmsp4/k3 = 2
  --assert i4 = 0
===end-group===

===start-group=== "pointers"
  --test-- "nmp1"
    i: 12345
    nmsp5: context [
      pi: declare pointer! [integer!]
    ]
    nmsp5/pi: :i
  --assert nmsp5/pi/value = 12345
  ; --test-- "nmp2"						;-- getting a pointer on a variable in a context using a path
  ;   pi: declare pointer! [integer!]	;-- is not a supported feature. Use a local function to
  ;   nmsp6: context [					;-- get such pointer.
  ;     i: 12345
  ;   ]
  ;   pi: :nmsp6/i
  ; --assert pi/value = 12345
  --test-- "nmp3"
    nmsp6a: context [
      i: 67890
      get-addr-i: func [
        return: [pointer! [integer!]]
      ][
        :i
      ]
    ]
    pinmp3: declare pointer! [integer!]
    pinmp3: nmsp6a/get-addr-i
  --assert 67890 = pinmp3/value

===end-group===

===start-group=== "nesting"
  --test-- "nmm1"
    nmsp7: context [
      i: 0
      nmsp7-1: context [
        i: 1
        j: i * nmsp7/i
        nmsp7-2: context [
          i: 2
          j: i * nmsp7/i
          k: i * nmsp7/nmsp7-1/i
          nmsp7-3: context [
            i: 3
            j: i * nmsp7/i
            k: i * nmsp7/nmsp7-1/i
            l: i * nmsp7/nmsp7-1/nmsp7-2/i
          ]
          --assert i = 2
          --assert j = 0
          --assert k = 2
		  --assert nmsp7/i = 0
		  --assert nmsp7/nmsp7-1/i = 1
		  --assert nmsp7/nmsp7-1/j = 0
        ]
        --assert i = 1
        --assert j = 0
        --assert nmsp7/i = 0
      ]
      --assert i = 0
    ]
  --assert nmsp7/i = 0
  --assert nmsp7/nmsp7-1/i = 1
  --assert nmsp7/nmsp7-1/j = 0
  --assert nmsp7/nmsp7-1/nmsp7-2/i = 2
  --assert nmsp7/nmsp7-1/nmsp7-2/j = 0
  --assert nmsp7/nmsp7-1/nmsp7-2/k = 2
  --assert nmsp7/nmsp7-1/nmsp7-2/nmsp7-3/i = 3
  --assert nmsp7/nmsp7-1/nmsp7-2/nmsp7-3/j = 0
  --assert nmsp7/nmsp7-1/nmsp7-2/nmsp7-3/k = 3
  --assert nmsp7/nmsp7-1/nmsp7-2/nmsp7-3/l = 6
===end-group===

===start-group=== "include"
  --test-- "nminc1"
    nmsp8: context [
      #include %namespace-test-include.reds
    ]
  --assert 54321 = nmsp8/i

===end-group===

===start-group=== "libs"
    nmsp-lib: context [
      #import [
        LIBM-file cdecl [
          abs-int: "abs" [
            i       [integer!]
            return: [integer!]
          ]
        ]
      ]
      #import [
        LIBC-file cdecl [
          strnlen: "strnlen" [
            str     [c-string!]
            maxlen  [integer!]
            return: [integer!]
          ]
        ]
      ]
    ]
  --test-- "nmlibs1"
  --assert 1 = nmsp-lib/abs-int -1
  --test-- "nmlibs2"
  --assert 11 = nmsp-lib/strnlen "hello world" 20

===end-group===

===start-group=== "cross-reference"

	nmxr1: context [c: 789 fooo: func [][nmxr2/e: 123]]
	nmxr2: context [e: 456 f: nmxr1/c]

  --test-- "ns-cross-1"
	--assert nmxr2/e = 456
	nmxr1/fooo
	--assert nmxr2/e = 123

  --test-- "ns-cross-2"
	--assert nmxr2/f = 789

===end-group===

===start-group=== "with"
  --test-- "nsw1"
    nsw1-nsp: context [b: 123]
    with nsw1-nsp [
      --assert b = 123
    ]

  --test-- "nsw2"
    nsw2-nsp1: context [b: 123]
    nsw2-nsp2: context [b: 456]
    with [nsw2-nsp1 nsw2-nsp2] [
      --assert b = 123
      --assert nsw2-nsp1/b = 123
      --assert nsw2-nsp2/b = 456
    ]

  --test-- "nsw3"
    nsw3-nsp1: context [z: declare pointer! [integer!] fooo: func [][nsw3-nsp2/e: 123]]
    nsw3-nsp2: context [e: 456]

    with nsw3-nsp1 [
      c: 123
      z: null
    ]
	--assert nsw3-nsp1/z = null

	  e: -1
	  with [nsw3-nsp1 nsw3-nsp2][
	    fooo
	    --assert e = 123
	  ]
	--assert e = -1

	--test-- "nsw4"
    nsw4-nsp1: context [e: 456]
    nsw4-nsp2: context [fooo: func [][e: 123]]
    with [nsw4-nsp1 nsw4-nsp2] [
      fooo
      --assert e = 456
    ]

===end-group===

~~~end-file~~~