Fix #869: bug in trans-float

Fix #869: bug in trans-float

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

trans-number: routine [
	start  [string!]
	end	   [string!]
	float? [logic!]
	/local
		c	 [integer!]
		n	 [integer!]
		m	 [integer!]
		len  [integer!]
		p	 [byte-ptr!]
		neg? [logic!]
][
	if float? [
		trans-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]
]

trans-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!]
][
	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
	]
	cp: as integer! cur/1      ;store last char
	cur/1: #"^@"               ;replace the char with null so to-float can use it as end of input
	float/box string/to-float s0
	cur/1: as byte! cp         ;revert the char back
]

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

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

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

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

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

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

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

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

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

	trans-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 [#"^(80)" - #"^(8A)"]			;-- 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: [2 6 hexa-char] e: (				;-- Unicode values allowed up to 10FFFFh
				value: trans-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: trans-string type: file!)
			| s: any [ahead [not-file-char | ws-no-count] break | skip] e:
			  (process: trans-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! trans-store stack do trans-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
			trans-push-path stack type					;-- create empty path
			trans-word stack copy/part s e type			;-- push 1st path element
		)
		some [
			slash
			s: [
				integer-number-rule			(trans-store stack trans-number s e no)
				| begin-symbol-rule			(trans-word stack copy/part s e word!)
				| paren-rule
				| #":" s: begin-symbol-rule	(trans-word stack copy/part s e get-word!)
				;@@ add more datatypes here
			]
			opt [#":" (trans-set-path back tail stack)]
		] (trans-pop stack)
	]

	word-rule: 	[
		#"%" ws-no-count (trans-word stack "%" word!)	;-- special case for remainder op!
		| s: begin-symbol-rule (type: word!) [
				url-rule
				| path-rule								;-- path matched
				| opt [#":" (type: set-word!)]
				  (trans-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!)
			| (trans-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
			| (trans-word stack copy/part s e type)		;-- lit-word matched
		]
	]

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

	refinement-rule: [
		slash (type: refinement!) s: symbol-rule
		(trans-word stack copy/part s e type)
	]

	slash-rule: [s: [slash opt slash] e:]

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

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

	integer-rule: [
		integer-number-rule
		opt [float-number-rule | float-exp-rule e: (type: float!)]
		ahead [integer-end | ws-no-count | end]
	]

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

	float-number-rule: [
		[dot | comma] [
			[some digit opt float-exp-rule]
			| #"#" [[[#"N" | #"n"] [#"a" | #"A"] [#"N" | #"n"]]
					| [[#"I" | #"i"] [#"N" | #"n"] [#"F" | #"f"]]]
		] 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
		#"]" (trans-pop stack)
	]

	paren-rule: [
		#"(" (append/only stack make paren! 4)
		any-value
		#")" (trans-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		(trans-store stack value)
			| integer-rule		if (value: trans-number s e type = float!) (trans-store stack value)
			| float-rule		if (value: trans-float s e) (trans-store stack value)
			| hexa-rule			(trans-store stack trans-hexa s e)
			| word-rule
			| lit-word-rule
			| get-word-rule
			| slash-rule		(trans-word stack copy/part s e word!)
			| refinement-rule
			| file-rule			(trans-store stack value: do process)
			| char-rule			(trans-store stack value)
			| issue-rule
			| block-rule
			| paren-rule
			| string-rule		(trans-store stack do trans-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
]

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

trans-number: routine [
	start  [string!]
	end	   [string!]
	float? [logic!]
	/local
		c	 [integer!]
		n	 [integer!]
		m	 [integer!]
		len  [integer!]
		p	 [byte-ptr!]
		neg? [logic!]
][
	if float? [
		trans-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]
]

trans-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!]
][
	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
	]

	cur/1: #"^@"
	float/box string/to-float s0
	cur/1: as-byte 10
]

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

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

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

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

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

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

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

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

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

	trans-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 [#"^(80)" - #"^(8A)"]			;-- 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: [2 6 hexa-char] e: (				;-- Unicode values allowed up to 10FFFFh
				value: trans-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: trans-string type: file!)
			| s: any [ahead [not-file-char | ws-no-count] break | skip] e:
			  (process: trans-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! trans-store stack do trans-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
			trans-push-path stack type					;-- create empty path
			trans-word stack copy/part s e type			;-- push 1st path element
		)
		some [
			slash
			s: [
				integer-number-rule			(trans-store stack trans-number s e no)
				| begin-symbol-rule			(trans-word stack copy/part s e word!)
				| paren-rule
				| #":" s: begin-symbol-rule	(trans-word stack copy/part s e get-word!)
				;@@ add more datatypes here
			]
			opt [#":" (trans-set-path back tail stack)]
		] (trans-pop stack)
	]

	word-rule: 	[
		#"%" ws-no-count (trans-word stack "%" word!)	;-- special case for remainder op!
		| s: begin-symbol-rule (type: word!) [
				url-rule
				| path-rule								;-- path matched
				| opt [#":" (type: set-word!)]
				  (trans-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!)
			| (trans-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
			| (trans-word stack copy/part s e type)		;-- lit-word matched
		]
	]

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

	refinement-rule: [
		slash (type: refinement!) s: symbol-rule
		(trans-word stack copy/part s e type)
	]

	slash-rule: [s: [slash opt slash] e:]

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

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

	integer-rule: [
		integer-number-rule
		opt [float-number-rule | float-exp-rule e: (type: float!)]
		ahead [integer-end | ws-no-count | end]
	]

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

	float-number-rule: [
		[dot | comma] [
			[some digit opt float-exp-rule]
			| #"#" [[[#"N" | #"n"] [#"a" | #"A"] [#"N" | #"n"]]
					| [[#"I" | #"i"] [#"N" | #"n"] [#"F" | #"f"]]]
		] 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
		#"]" (trans-pop stack)
	]

	paren-rule: [
		#"(" (append/only stack make paren! 4)
		any-value
		#")" (trans-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		(trans-store stack value)
			| integer-rule		if (value: trans-number s e type = float!) (trans-store stack value)
			| float-rule		if (value: trans-float s e ) (trans-store stack value)
			| hexa-rule			(trans-store stack trans-hexa s e)
			| word-rule
			| lit-word-rule
			| get-word-rule
			| slash-rule		(trans-word stack copy/part s e word!)
			| refinement-rule
			| file-rule			(trans-store stack value: do process)
			| char-rule			(trans-store stack value)
			| issue-rule
			| block-rule
			| paren-rule
			| string-rule		(trans-store stack do trans-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
]


FEAT: added `system/float-options` new access path for setting floating point numbers options.

Usage:

    system/float-options <spec>
 where
    <spec>: block of flags (word! | set-word!) with values (logic! | word!).

Valid flags are:
    * pretty?: enables pretty printing of float numbers when very close to an integer value (default: true)
    * full?: enables math operations on float special values (default: false)

Examples:

    red>> 4.000000000000001e32
    == 4.0e32
    red>> system/float-options [pretty?: no]
    red>> 4.000000000000001e32
    == 4.000000000000001e32

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

;-- 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
file!:			make datatype! #get-definition TYPE_FILE
url!:			make datatype! #get-definition TYPE_URL

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
get-path!:		make datatype! #get-definition TYPE_GET_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
point!:			make datatype! #get-definition TYPE_POINT

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

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

;; Warning: do not define any function of any kind before MAKE definition

make: make action! [[									;--	this one works!	;-)
		"Returns a new value made from a spec for that value's type"
		type	 [any-type!] "The datatype or a prototype value"
		spec	 [any-type!] "The specification	of the new value"
		return:  [any-type!] "Returns the specified datatype"
	]
	#get-definition ACT_MAKE
]

random: make action! [[
		"Returns a random value of the same datatype; or shuffles series"
		value   [any-type!] "Maximum value of result (modified when series)"
		/seed   "Restart or randomize"
		/secure "TBD: Returns a cryptographically secure random number"
		/only	"Pick a random value from a series"
		return:	[any-type!]
	]
	#get-definition ACT_RANDOM
]

reflect: make action! [[
		"Returns internal details about a value via reflection"
		value	[any-type!]
		field 	[word!] "spec, body, words, etc. Each datatype defines its own reflectors"
	]
	#get-definition ACT_REFLECT
]

to: make action! [[
		"Converts to a specified datatype"
		type	[any-type!] "The datatype or example value"
		spec	[any-type!] "The attributes of the new value"
	]
	#get-definition ACT_TO
]

form: make action! [[
		"Returns a user-friendly string representation of a value"
		value	  [any-type!]
		/part "Limit the length of the result"
			limit [integer!]
		return:	  [string!]
	]
	#get-definition ACT_FORM
]

mold: make action! [[
		"Returns a source format string representation of a value"
		value	  [any-type!]
		/only "Exclude outer brackets if value is a block"
		/all  "TBD: Return value in loadable format"
		/flat "TBD: Exclude all indentation"
		/part "Limit the length of the result"
			limit [integer!]
		return:	  [string!]
	]
	#get-definition ACT_MOLD
]

;-- Scalar actions --

absolute: make action! [[
		"Returns the non-negative value"
		value	 [number!]
		return:  [number!]
	]
	#get-definition ACT_ABSOLUTE
]

add: make action! [[
		"Returns the sum of the two values"
		value1	 [number! char!]
		value2	 [number! char!]
		return:  [number! char!]
	]
	#get-definition ACT_ADD
]

divide: make action! [[
		"Returns the quotient of two values"
		value1	 [number! char!] "The dividend (numerator)"
		value2	 [number! char!] "The divisor (denominator)"
		return:  [number! char!]
	]
	#get-definition ACT_DIVIDE
]

multiply: make action! [[
		"Returns the product of two values"
		value1	 [number! char!]
		value2	 [number! char!]
		return:  [number! char!]
	]
	#get-definition ACT_MULTIPLY
]

negate: make action! [[
		"Returns the opposite (additive inverse) value"
		number 	 [number!]
		return:  [number!]
	]
	#get-definition ACT_NEGATE
]

power: make action! [[
		"Returns a number raised to a given power (exponent)"
		number	 [number!] "Base value"
		exponent [number!] "The power (index) to raise the base value by"
		return:	 [number!]
	]
	#get-definition ACT_POWER
]

remainder: make action! [[
		"Returns what is left over when one value is divided by another"
		value1 	 [number! char!]
		value2 	 [number! char!]
		return:  [number! char!]
	]
	#get-definition ACT_REMAINDER
]

modulo: func [
	"Compute a nonnegative remainder of A divided by B"
	a		[number!]
	b		[number!]
	return: [number!]
	/local r
][
	b: absolute b
    all [0 > r: a % b r: r + b]
    a: absolute a
    either all [a + r = (a + b) 0 < r + r - b] [r - b] [r]
]

round: make action! [[
		"(not yet implemented)"
		;"Returns the nearest integer. Halves round up (away from zero) by default"
		n		[number!]
		/to		"Return the nearest multiple of the scale parameter"
		scale	[number!] "Must be a non-zero value"
		/even		"Halves round toward even results"
		/down		"Round toward zero, ignoring discarded digits. (truncate)"
		/half-down	"Halves round toward zero"
		/floor		"Round in negative direction"
		/ceiling	"Round in positive direction"
		/half-ceiling "Halves round in positive direction"
	]
	#get-definition ACT_ROUND
]

subtract: make action! [[
		"Returns the difference between two values"
		value1	 [number! char!]
		value2	 [number! char!]
		return:  [number! char!]
	]
	#get-definition ACT_SUBTRACT
]

even?: make action! [[
		"Returns true if the number is evenly divisible by 2"
		number 	 [number! char!]
		return:  [number! char!]
	]
	#get-definition ACT_EVEN?
]

odd?: make action! [[
		"Returns true if the number has a remainder of 1 when divided by 2"
		number 	 [number! char!]
		return:  [number! char!]
	]
	#get-definition ACT_ODD?
]

;-- Bitwise actions --

and~: make action! [[
		"Returns the first value ANDed with the second"
		value1	[logic! integer! char! bitset! typeset!]
		value2	[logic! integer! char! bitset! typeset!]
		return:	[logic! integer! char! bitset! typeset!]
	]
	#get-definition ACT_AND~
]

complement: make action! [[
		"Returns the opposite (complementing) value of the input value"
		value	[logic! integer! bitset! typeset!]
		return: [logic! integer! bitset! typeset!]
	]
	#get-definition ACT_COMPLEMENT
]

or~: make action! [[
		"Returns the first value ORed with the second"
		value1	[logic! integer! char! bitset! typeset!]
		value2	[logic! integer! char! bitset! typeset!]
		return:	[logic! integer! char! bitset! typeset!]
	]
	#get-definition ACT_OR~
]

xor~: make action! [[
		"Returns the first value exclusive ORed with the second"
		value1	[logic! integer! char! bitset! typeset!]
		value2	[logic! integer! char! bitset! typeset!]
		return:	[logic! integer! char! bitset! typeset!]
	]
	#get-definition ACT_XOR~
]

;-- Series actions --

append: make action! [[
		"Inserts value(s) at series tail; returns series head"
		series	   [series!]
		value	   [any-type!]
		/part "Limit the number of values inserted"
			length [number! series!]
		/only "Insert block types as single values (overrides /part)"
		/dup  "Duplicate the inserted values"
			count  [number!]
		return:    [series!]
	]
	#get-definition ACT_APPEND
]

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

back: make action! [[
		"Returns a series at the previous index"
		series	 [series!]
		return:  [series!]
	]
	#get-definition ACT_BACK
]

;change

clear: make action! [[
		"Removes series values from current index to tail; returns new tail"
		series	 [series!]
		return:  [series!]
	]
	#get-definition ACT_CLEAR
]

copy: make action! [[
		"Returns a copy of a non-scalar value"
		value	 [series!]
		/part	 "Limit the length of the result"
			length [number! series!]
		/deep	 "Copy nested values"
		/types	 "Copy only specific types of non-scalar values"
			kind [datatype!]
		return:  [series!]
	]
	#get-definition ACT_COPY
]

find: make action! [[
		"Returns the series where a value is found, or NONE"
		series	 [series! none!]
		value 	 [any-type!]
		/part "Limit the length of the search"
			length [number! series!]
		/only "Treat a series search value as a single value"
		/case "Perform a case-sensitive search"
		/any  "TBD: Use * and ? wildcards in string searches"
		/with "TBD: Use custom wildcards in place of * and ?"
			wild [string!]
		/skip "Treat the series as fixed size records"
			size [integer!]
		/last "Find the last occurrence of value, from the tail"
		/reverse "Find the last occurrence of value, from the current index"
		/tail "Return the tail of the match found, rather than the head"
		/match "Match at current index only and return tail of match"
	]
	#get-definition ACT_FIND
]

head: make action! [[
		"Returns a series at its first index"
		series	 [series!]
		return:  [series!]
	]
	#get-definition ACT_HEAD
]

head?: make action! [[
		"Returns true if a series is at its first index"
		series	 [series!]
		return:  [logic!]
	]
	#get-definition ACT_HEAD?
]

index?: make action! [[
		"Returns the current series index, relative to the head"
		series	 [series!]
		return:  [integer!]
	]
	#get-definition ACT_INDEX?
]

insert: make action! [[
		"Inserts value(s) at series index; returns series head"
		series	   [series!]
		value	   [any-type!]
		/part "Limit the number of values inserted"
			length [number! series!]
		/only "Insert block types as single values (overrides /part)"
		/dup  "Duplicate the inserted values"
			count  [number!]
		return:    [series!]
	]
	#get-definition ACT_INSERT
]

length?: make action! [[
		"Returns the number of values in the series, from the current index to the tail"
		series	 [series!]
		return:  [integer!]
	]
	#get-definition ACT_LENGTH?
]

next: make action! [[
		"Returns a series at the next index"
		series	 [series!]
		return:  [series!]
	]
	#get-definition ACT_NEXT
]

pick: make action! [[
		"Returns the series value at a given index"
		series	 [series!]
		index 	 [integer! logic!]
		return:  [any-type!]
	]
	#get-definition ACT_PICK
]

poke: make action! [[
		"Replaces the series value at a given index, and returns the new value"
		series	 [series!]
		index 	 [integer! logic!]
		value 	 [any-type!]
		return:  [series!]
	]
	#get-definition ACT_POKE
]

remove: make action! [[
		"Returns the series at the same index after removing a value"
		series	 [series! none!]
		/part "Removes a number of values, or values up to the given series index"
			length [number! series!]
		return:  [series! none!]
	]
	#get-definition ACT_REMOVE
]

reverse: make action! [[
		"Reverses the order of elements; returns at same position"
		series	 [series! gob! tuple! pair!]
		/part "Limits to a given length or position"
			length [number! series!]
		return:  [series! gob! tuple! pair!]
	]
	#get-definition ACT_REVERSE
]

select: make action! [[
		"Find a value in a series and return the next value, or NONE"
		series	 [series! none!]
		value 	 [any-type!]
		/part "Limit the length of the search"
			length [number! series!]
		/only "Treat a series search value as a single value"
		/case "Perform a case-sensitive search"
		/any  "TBD: Use * and ? wildcards in string searches"
		/with "TBD: Use custom wildcards in place of * and ?"
			wild [string!]
		/skip "Treat the series as fixed size records"
			size [integer!]
		/last "Find the last occurrence of value, from the tail"
		/reverse "Find the last occurrence of value, from the current index"
		return:  [any-type!]
	]
	#get-definition ACT_SELECT
]

;sort

skip: make action! [[
		"Returns the series relative to the current index"
		series	 [series!]
		offset 	 [integer!]
		return:  [series!]
	]
	#get-definition ACT_SKIP
]

swap: make action! [[
		"Swaps elements between two series or the same series"
		series1  [series!]
		series2  [series!]
		return:  [series!]
	]
	#get-definition ACT_SWAP
]

tail: make action! [[
		"Returns a series at the index after its last value"
		series	 [series!]
		return:  [series!]
	]
	#get-definition ACT_TAIL
]

tail?: make action! [[
		"Returns true if a series is past its last value"
		series	 [series!]
		return:  [logic!]
	]
	#get-definition ACT_TAIL?
]

take: make action! [[
		"Removes and returns one or more elements"
		series	 [series!]
		/part	 "Specifies a length or end position"
			length [number! series! pair!]
		/deep	 "Copy nested values"
		/last	 "Take it from the tail end"
	]
	#get-definition ACT_TAKE
]

trim: make action! [[
		"Removes space from a string or NONE from a block or object"
		series	[series! object! error! module!]
		/head	"Removes only from the head"
		/tail	"Removes only from the tail"
		/auto	"Auto indents lines relative to first line"
		/lines	"Removes all line breaks and extra spaces"
		/all	"Removes all whitespace"
		/with	"Same as /all, but removes characters in 'str'"
			str [char! string! binary! integer!]
	]
	#get-definition ACT_TRIM
]

;-- I/O actions --

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

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

if: make native! [[
		"If condition is true, evaluate block; else return NONE"
		cond  	 [any-type!]
		then-blk [block!]
	]
	#get-definition NAT_IF
]

unless: make native! [[
		"If condition is not true, evaluate block; else return NONE"
		cond  	 [any-type!]
		then-blk [block!]
	]
	#get-definition NAT_UNLESS
]

either: make native! [[
		"If condition is true, eval true-block; else eval false-blk"
		cond  	  [any-type!]
		true-blk  [block!]
		false-blk [block!]
	]
	#get-definition NAT_EITHER
]

any: make native! [[
		"Evaluates, returning at the first that is true"
		conds [block!]
	]
	#get-definition NAT_ANY
]

all: make native! [[
		"Evaluates, returning at the first that is not true"
		conds [block!]
	]
	#get-definition NAT_ALL
]

while: make native! [[
		"Evaluates body until condition is true"
		cond [block!]
		body [block!]
	]
	#get-definition NAT_WHILE
]

until: make native! [[
		"Evaluates body until it is true"
		body [block!]
	]
	#get-definition NAT_UNTIL
]

loop: make native! [[
		"Evaluates body a number of times"
		count [integer!]
		body  [block!]
	]
	#get-definition NAT_LOOP
]

repeat: make native! [[
		"Evaluates body a number of times, tracking iteration count"
		'word [word!]    "Iteration counter; not local to loop"
		value [integer!] "Number of times to evaluate body"
		body  [block!]
	]
	#get-definition NAT_REPEAT
]

foreach: make native! [[
		"Evaluates body for each value in a series"
		'word  [word! block!]   "Word, or words, to set on each iteration"
		series [series!]
		body   [block!]
	]
	#get-definition NAT_FOREACH
]

forall: make native! [[
		"Evaluates body for all values in a series"
		'word [word!]   "Word referring to series to iterate over"
		body  [block!]
	]
	#get-definition NAT_FORALL
]

;break: make native! [
;	[]													;@@ add /return option
;	none
;]

func: make native! [[
		"Defines a function with a given spec and body"
		spec [block!]
		body [block!]
	]
	#get-definition NAT_FUNC
]

function: make native! [[
		"Defines a function, making all words found in body local"
		spec [block!]
		body [block!]
		/extern	"Exclude words that follow this refinement"
	]
	#get-definition NAT_FUNCTION
]

does: make native! [[
		"Defines a function with no arguments or local variables"
		body [block!]
	]
	#get-definition NAT_DOES
]

has: make native! [[
		"Defines a function with local variables, but no arguments"
		vars [block!]
		body [block!]
	]
	#get-definition NAT_HAS
]

switch: make native! [[
		"Evaluates the first block following the value found in cases"
		value [any-type!] "The value to match"
		cases [block!]
		/default "Specify a default block, if value is not found in cases"
			case [block!] "Default block to evaluate"
	]
	#get-definition NAT_SWITCH
]

case: make native! [[
		"Evaluates the block following the first true condition"
		cases [block!] "Block of condition-block pairs"
		/all "Test all conditions, evaluating the block following each true condition"
	]
	#get-definition NAT_CASE
]

do: make native! [[
		"Evaluates a value, returning the last evaluation result"
		value [any-type!]
	]
	#get-definition NAT_DO
]

reduce: make native! [[
		"Returns a copy of a block, evaluating all expressions"
		value [any-type!]
		/into "Put results in out block, instead of creating a new block"
			out [any-block!] "Target block for results, when /into is used"
	]
	#get-definition NAT_REDUCE
]

compose: make native! [[
		"Returns a copy of a block, evaluating only parens"
		value [block!]
		/deep "Compose nested blocks"
		/only "Compose nested blocks as blocks containing their values"
		/into "Put results in out block, instead of creating a new block"
			out [any-block!] "Target block for results, when /into is used"
	]
	#get-definition NAT_COMPOSE
]

get: make native! [[
		"Returns the value a word refers to"
		word	[word!]
		/any "If word has no value, return UNSET rather than causing an error"
		return: [any-type!]
	]
	#get-definition NAT_GET
]

set: make native! [[
		"Sets the value(s) one or more words refer to"
		word	[any-word! block!] "Word or block of words to set"
		value	[any-type!] "Value or block of values to assign to words"
		/any "Allow UNSET as a value rather than causing an error"
		return: [any-type!]
	]
	#get-definition NAT_SET
]

print: make native! [[
		"Outputs a value followed by a newline"
		value	[any-type!]
	]
	#get-definition NAT_PRINT
]

prin: make native! [[
		"Outputs a value"
		value	[any-type!]
	]
	#get-definition NAT_PRIN
]

equal?: make native! [[
		"Returns true if two values are equal"
		value1 [any-type!]
		value2 [any-type!]
	]
	#get-definition NAT_EQUAL?
]

not-equal?: make native! [[
		"Returns true if two values are not equal"
		value1 [any-type!]
		value2 [any-type!]
	]
	#get-definition NAT_NOT_EQUAL?
]

strict-equal?: make native! [[
		"Returns true if two values are equal, and also the same datatype"
		value1 [any-type!]
		value2 [any-type!]
	]
	#get-definition NAT_STRICT_EQUAL?
]

lesser?: make native! [[
		"Returns true if the first value is less than the second"
		value1 [any-type!]
		value2 [any-type!]
	]
	#get-definition NAT_LESSER?
]

greater?: make native! [[
		"Returns true if the first value is greater than the second"
		value1 [any-type!]
		value2 [any-type!]
	]
	#get-definition NAT_GREATER?
]

lesser-or-equal?: make native! [[
		"Returns true if the first value is less than or equal to the second"
		value1 [any-type!]
		value2 [any-type!]
	]
	#get-definition NAT_LESSER_OR_EQUAL?
]

greater-or-equal?: make native! [[
		"Returns true if the first value is greater than or equal to the second"
		value1 [any-type!]
		value2 [any-type!]
	]
	#get-definition NAT_GREATER_OR_EQUAL?
]

same?: make native! [[
		"Returns true if two values have the same identity"
		value1 [any-type!]
		value2 [any-type!]
	]
	#get-definition NAT_SAME?
]

not: make native! [[
		"Returns the negation (logical complement) of a value"
		value [any-type!]
	]
	#get-definition NAT_NOT
]

halt: make native! [[
		"Stops evaluation"
	]
	#get-definition NAT_HALT
]

type?: make native! [[
		"Returns the datatype of a value"
		value [any-type!]
		/word "Return a word value, rather than a datatype value"
	]
	#get-definition NAT_TYPE?
]

stats: make native! [[
		"Returns interpreter statistics"
		/show "TBD:"
		/info "Output formatted results"
		return: [integer! block!]
	]
	#get-definition NAT_STATS
]

bind: make native! [[
		word 	[block! any-word!]
		context [any-word! any-object!]
		/copy
		return: [block! any-word!]
	]
	#get-definition NAT_BIND
]

in: make native! [[
		object [any-object!]
		word   [any-word! block! paren!]
	]
	#get-definition NAT_IN
]

parse: make native! [[
		input [series!]
		rules [block!]
		/case
		;/strict
		/part
			length [number! series!]
		/trace
			callback [function! [
				event	[word!]
				match?	[logic!]
				rule	[block!]
				input	[series!]
				stack	[block!]
				return: [logic!]
			]]
		return: [logic! block!]
	]
	#get-definition NAT_PARSE
]

union: make native! [[
		set1 [block! string! bitset! typeset!]
		set2 [block! string! bitset! typeset!]
		/case
		/skip "Treat the series as fixed size records"
			size [integer!]
		return: [block! string! bitset! typeset!]
	]
	#get-definition NAT_UNION
]

complement?: make native! [[
		"Returns true if the bitset is complemented"
		bits [bitset!]
	]
	#get-definition NAT_COMPLEMENT?
]

dehex: make native! [[
		"Converts URL-style hex encoded (%xx) strings"
		value [string! file!]							;@@ replace with any-string!
	]
	#get-definition NAT_DEHEX
]

negative?: make native! [[
		"Returns TRUE if the number is negative"
		number [number!]
	]
	#get-definition NAT_NEGATIVE?
]

positive?: make native! [[
		"Returns TRUE if the number is positive"
		number [number!]
	]
	#get-definition NAT_POSITIVE?
]

max: make native! [[
		"Returns the greater of the two values"
		value1 [number! series!]
		value2 [number! series!]
	]
	#get-definition NAT_MAX
]

min: make native! [[
		"Returns the lesser of the two values"
		value1 [number! series!]
		value2 [number! series!]
	]
	#get-definition NAT_MIN
]

shift: make native! [[
		"Perform a bit shift operation. Right shift (decreasing) by default"
		data	[integer! binary!]
		bits	[integer!]
		/left	 "Shift bits to the left (increasing)"
		/logical "Use logical shift (unsigned, fill with zero)"
		return: [integer! binary!]
	]
	#get-definition NAT_SHIFT
]

shift-right:   routine [][natives/shift* -1 -1]
shift-left:	   routine [][natives/shift* 1 -1]
shift-logical: routine [][natives/shift* -1 1]

to-hex: make native! [[
		"Converts numeric value to a hex issue! datatype (with leading # and 0's)"
		value	[integer! tuple!]
		/size "Specify number of hex digits in result"
			length [integer!]
		return: [issue!]
	]
	#get-definition NAT_TO_HEX
]

sine: make native! [[
		"Returns the trigonometric sine"
		angle	[number!]
		/radians "Angle is specified in radians"
		return: [float!]
	]
	#get-definition NAT_SINE
]

cosine: make native! [[
		"Returns the trigonometric cosine"
		angle	[number!]
		/radians "Angle is specified in radians"
		return: [float!]
	]
	#get-definition NAT_COSINE
]

tangent: make native! [[
		"Returns the trigonometric tangent"
		angle	[number!]
		/radians "Angle is specified in radians"
		return: [float!]
	]
	#get-definition NAT_TANGENT
]

arcsine: make native! [[
		"Returns the trigonometric arcsine (in degrees by default)"
		angle	[number!]
		/radians "Angle is specified in radians"
		return: [float!]
	]
	#get-definition NAT_ARCSINE
]

arccosine: make native! [[
		"Returns the trigonometric arccosine (in degrees by default)"
		angle	[number!]
		/radians "Angle is specified in radians"
		return: [float!]
	]
	#get-definition NAT_ARCCOSINE
]

arctangent: make native! [[
		"Returns the trigonometric arctangent (in degrees by default)"
		angle	[number!]
		/radians "Angle is specified in radians"
		return: [float!]
	]
	#get-definition NAT_ARCTANGENT
]

NaN?: make native! [[
		"Returns TRUE if the number is Not-a-Number"
		value	[number!]
		return: [logic!]
	]
	#get-definition NAT_NAN?
]

;------------------------------------------
;-			   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! :modulo
#load set-word! "%"		make op! :remainder
#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?
#load set-word! "<<"	make op! :shift-left
#load set-word! ">>"	make op! :shift-right
#load set-word! ">>>"	make op! :shift-logical
#load set-word! "**"	make op! :power
and:					make op! :and~
or:						make op! :or~
xor:					make op! :xor~

;------------------------------------------
;-				Scalars					  -
;------------------------------------------
Red: true												;-- ultimate Truth ;-) (pre-defines Red word)

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

tab:		 #"^-"
cr: 		 #"^M"
newline: lf: #"^/"
escape:      #"^["
slash: 		 #"/"
sp: space: 	 #" "
null: 		 #"^@"
crlf:		 "^M^/"
dot:		 #"."
comma:		 #","

pi: 3.141592653589793

;------------------------------------------
;-			   Routines					  -
;------------------------------------------

set-float-pretty: routine [mode [logic!]][float/pretty-print?: mode]
set-float-full:	  routine [mode [logic!]][float/full-support?: mode]

cos: routine [
	"Returns the trigonometric cosine"
	angle [float!] "Angle in radians"
][
	natives/cosine* 1
]

sin: routine [
	"Returns the trigonometric sine"
	angle [float!] "Angle in radians"
][
	natives/sine* 1
]

tan: routine [
	"Returns the trigonometric tangent"
	angle [float!] "Angle in radians"
][
	natives/tangent* 1
]

arccos: routine [
	"Returns the trigonometric arccosine"
	angle [float!] "Angle in radians"
][
	natives/arccosine* 1
]

arcsin: routine [
	"Returns the trigonometric arcsine"
	angle [float!] "Angle in radians"
][
	natives/arcsine* 1
]

arctan: routine [
	"Returns the trigonometric arctangent"
	angle [float!] "Angle in radians"
][
	natives/arctangent* 1
]

quit-return: routine [
	"Stops evaluation and exits the program with a given status"
	status			[integer!] "Process termination value to return"
][
	quit status
]

;------------------------------------------
;-			   Mezzanines				  -
;------------------------------------------

comment: func [value][]

quit: func [
	"Stops evaluation and exits the program"
	/return status	[integer!] "Return an exit status"
][
	quit-return any [status 0]
]

empty?: func [
	"Returns true if a series is at its tail"
	series	[series!]
	return:	[logic!]
][
	tail? series
]

??: func [
	"Prints a word and the value it refers to (molded)"
	'value [word!]
][
	prin mold :value
	prin ": "
	probe get/any :value
]

probe: func [
	"Returns a value after printing its molded form"
	value
][
	print mold value
	value
]

quote: func [
	:value
][
	:value
]

first:	func ["Returns the first value in a series"  s [series!]] [pick s 1]	;@@ temporary definitions, should be natives ?
second:	func ["Returns the second value in a series" s [series!]] [pick s 2]
third:	func ["Returns the third value in a series"  s [series!]] [pick s 3]
fourth:	func ["Returns the fourth value in a series" s [series!]] [pick s 4]
fifth:	func ["Returns the fifth value in a series"  s [series!]] [pick s 5]

last:	func ["Returns the last value in a series"  s [series!]][pick back tail s 1]

action?:	 func ["Returns true if the value is this type" value [any-type!]] [action!		= type? :value]
bitset?:	 func ["Returns true if the value is this type" value [any-type!]] [bitset!		= type? :value]
block?:		 func ["Returns true if the value is this type" value [any-type!]] [block!		= type? :value]
char?: 		 func ["Returns true if the value is this type" value [any-type!]] [char!		= type? :value]
datatype?:	 func ["Returns true if the value is this type" value [any-type!]] [datatype!	= type? :value]
file?:		 func ["Returns true if the value is this type" value [any-type!]] [file!		= type? :value]
url?:		 func ["Returns true if the value is this type" value [any-type!]] [url!		= type? :value]
function?:	 func ["Returns true if the value is this type" value [any-type!]] [function!	= type? :value]
get-path?:	 func ["Returns true if the value is this type" value [any-type!]] [get-path!	= type? :value]
get-word?:	 func ["Returns true if the value is this type" value [any-type!]] [get-word!	= type? :value]
integer?:    func ["Returns true if the value is this type" value [any-type!]] [integer!	= type? :value]
issue?:    	 func ["Returns true if the value is this type" value [any-type!]] [issue!		= type? :value]
lit-path?:	 func ["Returns true if the value is this type" value [any-type!]] [lit-path!	= type? :value]
lit-word?:	 func ["Returns true if the value is this type" value [any-type!]] [lit-word!	= type? :value]
logic?:		 func ["Returns true if the value is this type" value [any-type!]] [logic!		= type? :value]
native?:	 func ["Returns true if the value is this type" value [any-type!]] [native!		= type? :value]
none?:		 func ["Returns true if the value is this type" value [any-type!]] [none!		= type? :value]
object?:	 func ["Returns true if the value is this type" value [any-type!]] [object!		= type? :value]
op?:		 func ["Returns true if the value is this type" value [any-type!]] [op!			= type? :value]
paren?:		 func ["Returns true if the value is this type" value [any-type!]] [paren!		= type? :value]
path?:		 func ["Returns true if the value is this type" value [any-type!]] [path!		= type? :value]
refinement?: func ["Returns true if the value is this type" value [any-type!]] [refinement! = type? :value]
routine?:	 func ["Returns true if the value is this type" value [any-type!]] [routine!	= type? :value]
set-path?:	 func ["Returns true if the value is this type" value [any-type!]] [set-path!	= type? :value]
set-word?:	 func ["Returns true if the value is this type" value [any-type!]] [set-word!	= type? :value]
string?:	 func ["Returns true if the value is this type" value [any-type!]] [string!		= type? :value]
unset?:		 func ["Returns true if the value is this type" value [any-type!]] [unset!		= type? :value]
word?:		 func ["Returns true if the value is this type" value [any-type!]] [word!		= type? :value]

any-series?: func [value][
	find [												;@@ To be replaced with a typeset check
		block! paren! path! lit-path! set-path!
		get-path! string! file!
	] type?/word :value
]

spec-of: func [
	"Returns the spec of a value that supports reflection"
	value
][
	reflect :value 'spec
]

body-of: func [
	"Returns the body of a value that supports reflection"
	value
][
	reflect :value 'body
]

words-of: func [
	"Returns the list of words of a value that supports reflection"
	value
][
	reflect :value 'words
]

values-of: func [
	"Returns the list of values of a value that supports reflection"
	value
][
	reflect :value 'values
]

context: func [spec [block!]][make object! spec]

word-to-logic: func [value [word! logic!]][
	either logic? value [value][
		any [
			all [find [true yes on]  value true]
			all [find [false no off] value false]
		]
	]
]

system: function [
	"Returns information about the interpreter"
	/version	   "Return the system version"
	/words		   "Return a block of global words available"
	/platform	   "Return a word identifying the operating system"
	/interpreted?  "Return TRUE if called from the interpreter"
	/float-options "Change the way float numbers are processed"
		spec [block!] "Float flags (pretty?, full?) set to TRUE or FALSE"
	/local value
][
	case [
		version [#version]
		words	[#system [_context/get-words]]
		platform [
			#system [
				#switch OS [
					Windows  [SET_RETURN(words/_windows)]
					Syllable [SET_RETURN(words/_syllable)]
					MacOSX	 [SET_RETURN(words/_macosx)]
					#default [SET_RETURN(words/_linux)]
				]
			]
		]
		interpreted? [#system [logic/box stack/eval?]]
		float-options [
			if value: select spec 'pretty? [set-float-pretty word-to-logic value]
			if value: select spec 'full?   [set-float-full	 word-to-logic value]
			make unset! none
		]
		'else [
			print "Please specify a system refinement value (/version, /words, or /platform)"
		]
	]
]

replace: func [
	series [series!]
	pattern
	value
	/all
	/local pos len
][
	len: either any-series? :pattern [length? pattern][1]

	either all [
		pos: series
		either any-series? :pattern [
			while [pos: find pos pattern][
				remove/part pos len
				pos: insert pos value
			]
		][
			while [pos: find pos pattern][pos/1: value]
		]
	][
		if pos: find series pattern [
			remove/part pos len
			insert pos value
		]
	]
	series
]

zero?: func [
	value [number!]
][
	value = 0
]

charset: func [
	spec [block! integer! char! string! binary!]
][
	make bitset! spec
]

p-indent: make string! 30								;@@ to be put in an local context

on-parse-event: func [
	event	[word!]   "Trace events: push, pop, fetch, match, iterate, paren, end"
	match?	[logic!]  "Result of last matching operation"
	rule	[block!]  "Current rule at current position"
	input	[series!] "Input series at next position to match"
	stack	[block!]  "Internal parse rules stack"
	return: [logic!]  "TRUE: continue parsing, FALSE: stop and exit parsing"
][
	switch event [
		push  [
			print [p-indent "-->"]
			append p-indent "  "
		]
		pop	  [
			clear back back tail p-indent
			print [p-indent "<--"]
		]
		fetch [
			print [
				p-indent "match:" mold/part rule  50 newline
				p-indent "input:" mold/part input 50 p-indent
			]
		]
		match [print [p-indent "==>" either match? ["matched"]["not matched"]]]
		end   [print ["return:" match?]]
	]
	true
]

parse-trace: func [
	"Wrapper for parse/trace using the default event processor"
	input [series!]
	rules [block!]
	/case
	/part
		limit [integer!]
	return: [logic! block!]
][
	either case [
		parse/case/trace input rules :on-parse-event
	][
		either part [
			parse/part/trace input rules limit :on-parse-event
		][
			parse/trace input rules :on-parse-event
		]
	]
]

#include %lexer.red

load: function [
	"Returns a value or block of values by reading and evaluating a source"
	source [file! url! string! binary!]
	/header "TBD: Include Red header as a loaded value"
	/all    "TBD: Don't evaluate Red header"
	/type	"TBD:"
	/part
		length [integer! string!]
	/into "Put results in out block, instead of creating a new block"
		out [block!] "Target block for results"
][
	if part [
		case [
			zero? length [return make block! 1]
			string? length [
				if (index? length) = index? source [
					return make block! 1
				]
			]
		]
	]

	unless out [out: make block! 4]
	;switch type?/word [
	;	file!	[]
	;	url!	[]
	;	binary! []
	;]
	either part [transcode/part source out length][transcode source out]
	unless :all [if 1 = length? out [out: out/1]]
	out
]

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

;-- 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
file!:			make datatype! #get-definition TYPE_FILE
url!:			make datatype! #get-definition TYPE_URL

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
get-path!:		make datatype! #get-definition TYPE_GET_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
point!:			make datatype! #get-definition TYPE_POINT

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

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

;; Warning: do not define any function of any kind before MAKE definition

make: make action! [[									;--	this one works!	;-)
		"Returns a new value made from a spec for that value's type"
		type	 [any-type!] "The datatype or a prototype value"
		spec	 [any-type!] "The specification	of the new value"
		return:  [any-type!] "Returns the specified datatype"
	]
	#get-definition ACT_MAKE
]

random: make action! [[
		"Returns a random value of the same datatype; or shuffles series"
		value   [any-type!] "Maximum value of result (modified when series)"
		/seed   "Restart or randomize"
		/secure "TBD: Returns a cryptographically secure random number"
		/only	"Pick a random value from a series"
		return:	[any-type!]
	]
	#get-definition ACT_RANDOM
]

reflect: make action! [[
		"Returns internal details about a value via reflection"
		value	[any-type!]
		field 	[word!] "spec, body, words, etc. Each datatype defines its own reflectors"
	]
	#get-definition ACT_REFLECT
]

to: make action! [[
		"Converts to a specified datatype"
		type	[any-type!] "The datatype or example value"
		spec	[any-type!] "The attributes of the new value"
	]
	#get-definition ACT_TO
]

form: make action! [[
		"Returns a user-friendly string representation of a value"
		value	  [any-type!]
		/part "Limit the length of the result"
			limit [integer!]
		return:	  [string!]
	]
	#get-definition ACT_FORM
]

mold: make action! [[
		"Returns a source format string representation of a value"
		value	  [any-type!]
		/only "Exclude outer brackets if value is a block"
		/all  "TBD: Return value in loadable format"
		/flat "TBD: Exclude all indentation"
		/part "Limit the length of the result"
			limit [integer!]
		return:	  [string!]
	]
	#get-definition ACT_MOLD
]

;-- Scalar actions --

absolute: make action! [[
		"Returns the non-negative value"
		value	 [number!]
		return:  [number!]
	]
	#get-definition ACT_ABSOLUTE
]

add: make action! [[
		"Returns the sum of the two values"
		value1	 [number! char!]
		value2	 [number! char!]
		return:  [number! char!]
	]
	#get-definition ACT_ADD
]

divide: make action! [[
		"Returns the quotient of two values"
		value1	 [number! char!] "The dividend (numerator)"
		value2	 [number! char!] "The divisor (denominator)"
		return:  [number! char!]
	]
	#get-definition ACT_DIVIDE
]

multiply: make action! [[
		"Returns the product of two values"
		value1	 [number! char!]
		value2	 [number! char!]
		return:  [number! char!]
	]
	#get-definition ACT_MULTIPLY
]

negate: make action! [[
		"Returns the opposite (additive inverse) value"
		number 	 [number!]
		return:  [number!]
	]
	#get-definition ACT_NEGATE
]

power: make action! [[
		"Returns a number raised to a given power (exponent)"
		number	 [number!] "Base value"
		exponent [number!] "The power (index) to raise the base value by"
		return:	 [number!]
	]
	#get-definition ACT_POWER
]

remainder: make action! [[
		"Returns what is left over when one value is divided by another"
		value1 	 [number! char!]
		value2 	 [number! char!]
		return:  [number! char!]
	]
	#get-definition ACT_REMAINDER
]

modulo: func [
	"Compute a nonnegative remainder of A divided by B"
	a		[number!]
	b		[number!]
	return: [number!]
	/local r
][
	b: absolute b
    all [0 > r: a % b r: r + b]
    a: absolute a
    either all [a + r = (a + b) 0 < r + r - b] [r - b] [r]
]

round: make action! [[
		"(not yet implemented)"
		;"Returns the nearest integer. Halves round up (away from zero) by default"
		n		[number!]
		/to		"Return the nearest multiple of the scale parameter"
		scale	[number!] "Must be a non-zero value"
		/even		"Halves round toward even results"
		/down		"Round toward zero, ignoring discarded digits. (truncate)"
		/half-down	"Halves round toward zero"
		/floor		"Round in negative direction"
		/ceiling	"Round in positive direction"
		/half-ceiling "Halves round in positive direction"
	]
	#get-definition ACT_ROUND
]

subtract: make action! [[
		"Returns the difference between two values"
		value1	 [number! char!]
		value2	 [number! char!]
		return:  [number! char!]
	]
	#get-definition ACT_SUBTRACT
]

even?: make action! [[
		"Returns true if the number is evenly divisible by 2"
		number 	 [number! char!]
		return:  [number! char!]
	]
	#get-definition ACT_EVEN?
]

odd?: make action! [[
		"Returns true if the number has a remainder of 1 when divided by 2"
		number 	 [number! char!]
		return:  [number! char!]
	]
	#get-definition ACT_ODD?
]

;-- Bitwise actions --

and~: make action! [[
		"Returns the first value ANDed with the second"
		value1	[logic! integer! char! bitset! typeset!]
		value2	[logic! integer! char! bitset! typeset!]
		return:	[logic! integer! char! bitset! typeset!]
	]
	#get-definition ACT_AND~
]

complement: make action! [[
		"Returns the opposite (complementing) value of the input value"
		value	[logic! integer! bitset! typeset!]
		return: [logic! integer! bitset! typeset!]
	]
	#get-definition ACT_COMPLEMENT
]

or~: make action! [[
		"Returns the first value ORed with the second"
		value1	[logic! integer! char! bitset! typeset!]
		value2	[logic! integer! char! bitset! typeset!]
		return:	[logic! integer! char! bitset! typeset!]
	]
	#get-definition ACT_OR~
]

xor~: make action! [[
		"Returns the first value exclusive ORed with the second"
		value1	[logic! integer! char! bitset! typeset!]
		value2	[logic! integer! char! bitset! typeset!]
		return:	[logic! integer! char! bitset! typeset!]
	]
	#get-definition ACT_XOR~
]

;-- Series actions --

append: make action! [[
		"Inserts value(s) at series tail; returns series head"
		series	   [series!]
		value	   [any-type!]
		/part "Limit the number of values inserted"
			length [number! series!]
		/only "Insert block types as single values (overrides /part)"
		/dup  "Duplicate the inserted values"
			count  [number!]
		return:    [series!]
	]
	#get-definition ACT_APPEND
]

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

back: make action! [[
		"Returns a series at the previous index"
		series	 [series!]
		return:  [series!]
	]
	#get-definition ACT_BACK
]

;change

clear: make action! [[
		"Removes series values from current index to tail; returns new tail"
		series	 [series!]
		return:  [series!]
	]
	#get-definition ACT_CLEAR
]

copy: make action! [[
		"Returns a copy of a non-scalar value"
		value	 [series!]
		/part	 "Limit the length of the result"
			length [number! series!]
		/deep	 "Copy nested values"
		/types	 "Copy only specific types of non-scalar values"
			kind [datatype!]
		return:  [series!]
	]
	#get-definition ACT_COPY
]

find: make action! [[
		"Returns the series where a value is found, or NONE"
		series	 [series! none!]
		value 	 [any-type!]
		/part "Limit the length of the search"
			length [number! series!]
		/only "Treat a series search value as a single value"
		/case "Perform a case-sensitive search"
		/any  "TBD: Use * and ? wildcards in string searches"
		/with "TBD: Use custom wildcards in place of * and ?"
			wild [string!]
		/skip "Treat the series as fixed size records"
			size [integer!]
		/last "Find the last occurrence of value, from the tail"
		/reverse "Find the last occurrence of value, from the current index"
		/tail "Return the tail of the match found, rather than the head"
		/match "Match at current index only and return tail of match"
	]
	#get-definition ACT_FIND
]

head: make action! [[
		"Returns a series at its first index"
		series	 [series!]
		return:  [series!]
	]
	#get-definition ACT_HEAD
]

head?: make action! [[
		"Returns true if a series is at its first index"
		series	 [series!]
		return:  [logic!]
	]
	#get-definition ACT_HEAD?
]

index?: make action! [[
		"Returns the current series index, relative to the head"
		series	 [series!]
		return:  [integer!]
	]
	#get-definition ACT_INDEX?
]

insert: make action! [[
		"Inserts value(s) at series index; returns series head"
		series	   [series!]
		value	   [any-type!]
		/part "Limit the number of values inserted"
			length [number! series!]
		/only "Insert block types as single values (overrides /part)"
		/dup  "Duplicate the inserted values"
			count  [number!]
		return:    [series!]
	]
	#get-definition ACT_INSERT
]

length?: make action! [[
		"Returns the number of values in the series, from the current index to the tail"
		series	 [series!]
		return:  [integer!]
	]
	#get-definition ACT_LENGTH?
]

next: make action! [[
		"Returns a series at the next index"
		series	 [series!]
		return:  [series!]
	]
	#get-definition ACT_NEXT
]

pick: make action! [[
		"Returns the series value at a given index"
		series	 [series!]
		index 	 [integer! logic!]
		return:  [any-type!]
	]
	#get-definition ACT_PICK
]

poke: make action! [[
		"Replaces the series value at a given index, and returns the new value"
		series	 [series!]
		index 	 [integer! logic!]
		value 	 [any-type!]
		return:  [series!]
	]
	#get-definition ACT_POKE
]

remove: make action! [[
		"Returns the series at the same index after removing a value"
		series	 [series! none!]
		/part "Removes a number of values, or values up to the given series index"
			length [number! series!]
		return:  [series! none!]
	]
	#get-definition ACT_REMOVE
]

reverse: make action! [[
		"Reverses the order of elements; returns at same position"
		series	 [series! gob! tuple! pair!]
		/part "Limits to a given length or position"
			length [number! series!]
		return:  [series! gob! tuple! pair!]
	]
	#get-definition ACT_REVERSE
]

select: make action! [[
		"Find a value in a series and return the next value, or NONE"
		series	 [series! none!]
		value 	 [any-type!]
		/part "Limit the length of the search"
			length [number! series!]
		/only "Treat a series search value as a single value"
		/case "Perform a case-sensitive search"
		/any  "TBD: Use * and ? wildcards in string searches"
		/with "TBD: Use custom wildcards in place of * and ?"
			wild [string!]
		/skip "Treat the series as fixed size records"
			size [integer!]
		/last "Find the last occurrence of value, from the tail"
		/reverse "Find the last occurrence of value, from the current index"
		return:  [any-type!]
	]
	#get-definition ACT_SELECT
]

;sort

skip: make action! [[
		"Returns the series relative to the current index"
		series	 [series!]
		offset 	 [integer!]
		return:  [series!]
	]
	#get-definition ACT_SKIP
]

swap: make action! [[
		"Swaps elements between two series or the same series"
		series1  [series!]
		series2  [series!]
		return:  [series!]
	]
	#get-definition ACT_SWAP
]

tail: make action! [[
		"Returns a series at the index after its last value"
		series	 [series!]
		return:  [series!]
	]
	#get-definition ACT_TAIL
]

tail?: make action! [[
		"Returns true if a series is past its last value"
		series	 [series!]
		return:  [logic!]
	]
	#get-definition ACT_TAIL?
]

take: make action! [[
		"Removes and returns one or more elements"
		series	 [series!]
		/part	 "Specifies a length or end position"
			length [number! series! pair!]
		/deep	 "Copy nested values"
		/last	 "Take it from the tail end"
	]
	#get-definition ACT_TAKE
]

trim: make action! [[
		"Removes space from a string or NONE from a block or object"
		series	[series! object! error! module!]
		/head	"Removes only from the head"
		/tail	"Removes only from the tail"
		/auto	"Auto indents lines relative to first line"
		/lines	"Removes all line breaks and extra spaces"
		/all	"Removes all whitespace"
		/with	"Same as /all, but removes characters in 'str'"
			str [char! string! binary! integer!]
	]
	#get-definition ACT_TRIM
]

;-- I/O actions --

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

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

if: make native! [[
		"If condition is true, evaluate block; else return NONE"
		cond  	 [any-type!]
		then-blk [block!]
	]
	#get-definition NAT_IF
]

unless: make native! [[
		"If condition is not true, evaluate block; else return NONE"
		cond  	 [any-type!]
		then-blk [block!]
	]
	#get-definition NAT_UNLESS
]

either: make native! [[
		"If condition is true, eval true-block; else eval false-blk"
		cond  	  [any-type!]
		true-blk  [block!]
		false-blk [block!]
	]
	#get-definition NAT_EITHER
]

any: make native! [[
		"Evaluates, returning at the first that is true"
		conds [block!]
	]
	#get-definition NAT_ANY
]

all: make native! [[
		"Evaluates, returning at the first that is not true"
		conds [block!]
	]
	#get-definition NAT_ALL
]

while: make native! [[
		"Evaluates body until condition is true"
		cond [block!]
		body [block!]
	]
	#get-definition NAT_WHILE
]

until: make native! [[
		"Evaluates body until it is true"
		body [block!]
	]
	#get-definition NAT_UNTIL
]

loop: make native! [[
		"Evaluates body a number of times"
		count [integer!]
		body  [block!]
	]
	#get-definition NAT_LOOP
]

repeat: make native! [[
		"Evaluates body a number of times, tracking iteration count"
		'word [word!]    "Iteration counter; not local to loop"
		value [integer!] "Number of times to evaluate body"
		body  [block!]
	]
	#get-definition NAT_REPEAT
]

foreach: make native! [[
		"Evaluates body for each value in a series"
		'word  [word! block!]   "Word, or words, to set on each iteration"
		series [series!]
		body   [block!]
	]
	#get-definition NAT_FOREACH
]

forall: make native! [[
		"Evaluates body for all values in a series"
		'word [word!]   "Word referring to series to iterate over"
		body  [block!]
	]
	#get-definition NAT_FORALL
]

;break: make native! [
;	[]													;@@ add /return option
;	none
;]

func: make native! [[
		"Defines a function with a given spec and body"
		spec [block!]
		body [block!]
	]
	#get-definition NAT_FUNC
]

function: make native! [[
		"Defines a function, making all words found in body local"
		spec [block!]
		body [block!]
		/extern	"Exclude words that follow this refinement"
	]
	#get-definition NAT_FUNCTION
]

does: make native! [[
		"Defines a function with no arguments or local variables"
		body [block!]
	]
	#get-definition NAT_DOES
]

has: make native! [[
		"Defines a function with local variables, but no arguments"
		vars [block!]
		body [block!]
	]
	#get-definition NAT_HAS
]

switch: make native! [[
		"Evaluates the first block following the value found in cases"
		value [any-type!] "The value to match"
		cases [block!]
		/default "Specify a default block, if value is not found in cases"
			case [block!] "Default block to evaluate"
	]
	#get-definition NAT_SWITCH
]

case: make native! [[
		"Evaluates the block following the first true condition"
		cases [block!] "Block of condition-block pairs"
		/all "Test all conditions, evaluating the block following each true condition"
	]
	#get-definition NAT_CASE
]

do: make native! [[
		"Evaluates a value, returning the last evaluation result"
		value [any-type!]
	]
	#get-definition NAT_DO
]

reduce: make native! [[
		"Returns a copy of a block, evaluating all expressions"
		value [any-type!]
		/into "Put results in out block, instead of creating a new block"
			out [any-block!] "Target block for results, when /into is used"
	]
	#get-definition NAT_REDUCE
]

compose: make native! [[
		"Returns a copy of a block, evaluating only parens"
		value [block!]
		/deep "Compose nested blocks"
		/only "Compose nested blocks as blocks containing their values"
		/into "Put results in out block, instead of creating a new block"
			out [any-block!] "Target block for results, when /into is used"
	]
	#get-definition NAT_COMPOSE
]

get: make native! [[
		"Returns the value a word refers to"
		word	[word!]
		/any "If word has no value, return UNSET rather than causing an error"
		return: [any-type!]
	]
	#get-definition NAT_GET
]

set: make native! [[
		"Sets the value(s) one or more words refer to"
		word	[any-word! block!] "Word or block of words to set"
		value	[any-type!] "Value or block of values to assign to words"
		/any "Allow UNSET as a value rather than causing an error"
		return: [any-type!]
	]
	#get-definition NAT_SET
]

print: make native! [[
		"Outputs a value followed by a newline"
		value	[any-type!]
	]
	#get-definition NAT_PRINT
]

prin: make native! [[
		"Outputs a value"
		value	[any-type!]
	]
	#get-definition NAT_PRIN
]

equal?: make native! [[
		"Returns true if two values are equal"
		value1 [any-type!]
		value2 [any-type!]
	]
	#get-definition NAT_EQUAL?
]

not-equal?: make native! [[
		"Returns true if two values are not equal"
		value1 [any-type!]
		value2 [any-type!]
	]
	#get-definition NAT_NOT_EQUAL?
]

strict-equal?: make native! [[
		"Returns true if two values are equal, and also the same datatype"
		value1 [any-type!]
		value2 [any-type!]
	]
	#get-definition NAT_STRICT_EQUAL?
]

lesser?: make native! [[
		"Returns true if the first value is less than the second"
		value1 [any-type!]
		value2 [any-type!]
	]
	#get-definition NAT_LESSER?
]

greater?: make native! [[
		"Returns true if the first value is greater than the second"
		value1 [any-type!]
		value2 [any-type!]
	]
	#get-definition NAT_GREATER?
]

lesser-or-equal?: make native! [[
		"Returns true if the first value is less than or equal to the second"
		value1 [any-type!]
		value2 [any-type!]
	]
	#get-definition NAT_LESSER_OR_EQUAL?
]

greater-or-equal?: make native! [[
		"Returns true if the first value is greater than or equal to the second"
		value1 [any-type!]
		value2 [any-type!]
	]
	#get-definition NAT_GREATER_OR_EQUAL?
]

same?: make native! [[
		"Returns true if two values have the same identity"
		value1 [any-type!]
		value2 [any-type!]
	]
	#get-definition NAT_SAME?
]

not: make native! [[
		"Returns the negation (logical complement) of a value"
		value [any-type!]
	]
	#get-definition NAT_NOT
]

halt: make native! [[
		"Stops evaluation"
	]
	#get-definition NAT_HALT
]

type?: make native! [[
		"Returns the datatype of a value"
		value [any-type!]
		/word "Return a word value, rather than a datatype value"
	]
	#get-definition NAT_TYPE?
]

stats: make native! [[
		"Returns interpreter statistics"
		/show "TBD:"
		/info "Output formatted results"
		return: [integer! block!]
	]
	#get-definition NAT_STATS
]

bind: make native! [[
		word 	[block! any-word!]
		context [any-word! any-object!]
		/copy
		return: [block! any-word!]
	]
	#get-definition NAT_BIND
]

in: make native! [[
		object [any-object!]
		word   [any-word! block! paren!]
	]
	#get-definition NAT_IN
]

parse: make native! [[
		input [series!]
		rules [block!]
		/case
		;/strict
		/part
			length [number! series!]
		/trace
			callback [function! [
				event	[word!]
				match?	[logic!]
				rule	[block!]
				input	[series!]
				stack	[block!]
				return: [logic!]
			]]
		return: [logic! block!]
	]
	#get-definition NAT_PARSE
]

union: make native! [[
		set1 [block! string! bitset! typeset!]
		set2 [block! string! bitset! typeset!]
		/case
		/skip "Treat the series as fixed size records"
			size [integer!]
		return: [block! string! bitset! typeset!]
	]
	#get-definition NAT_UNION
]

complement?: make native! [[
		"Returns true if the bitset is complemented"
		bits [bitset!]
	]
	#get-definition NAT_COMPLEMENT?
]

dehex: make native! [[
		"Converts URL-style hex encoded (%xx) strings"
		value [string! file!]							;@@ replace with any-string!
	]
	#get-definition NAT_DEHEX
]

negative?: make native! [[
		"Returns TRUE if the number is negative"
		number [number!]
	]
	#get-definition NAT_NEGATIVE?
]

positive?: make native! [[
		"Returns TRUE if the number is positive"
		number [number!]
	]
	#get-definition NAT_POSITIVE?
]

max: make native! [[
		"Returns the greater of the two values"
		value1 [number! series!]
		value2 [number! series!]
	]
	#get-definition NAT_MAX
]

min: make native! [[
		"Returns the lesser of the two values"
		value1 [number! series!]
		value2 [number! series!]
	]
	#get-definition NAT_MIN
]

shift: make native! [[
		"Perform a bit shift operation. Right shift (decreasing) by default"
		data	[integer! binary!]
		bits	[integer!]
		/left	 "Shift bits to the left (increasing)"
		/logical "Use logical shift (unsigned, fill with zero)"
		return: [integer! binary!]
	]
	#get-definition NAT_SHIFT
]

shift-right:   routine [][natives/shift* -1 -1]
shift-left:	   routine [][natives/shift* 1 -1]
shift-logical: routine [][natives/shift* -1 1]

to-hex: make native! [[
		"Converts numeric value to a hex issue! datatype (with leading # and 0's)"
		value	[integer! tuple!]
		/size "Specify number of hex digits in result"
			length [integer!]
		return: [issue!]
	]
	#get-definition NAT_TO_HEX
]

sine: make native! [[
		"Returns the trigonometric sine"
		angle	[number!]
		/radians "Angle is specified in radians"
		return: [float!]
	]
	#get-definition NAT_SINE
]

cosine: make native! [[
		"Returns the trigonometric cosine"
		angle	[number!]
		/radians "Angle is specified in radians"
		return: [float!]
	]
	#get-definition NAT_COSINE
]

tangent: make native! [[
		"Returns the trigonometric tangent"
		angle	[number!]
		/radians "Angle is specified in radians"
		return: [float!]
	]
	#get-definition NAT_TANGENT
]

arcsine: make native! [[
		"Returns the trigonometric arcsine (in degrees by default)"
		angle	[number!]
		/radians "Angle is specified in radians"
		return: [float!]
	]
	#get-definition NAT_ARCSINE
]

arccosine: make native! [[
		"Returns the trigonometric arccosine (in degrees by default)"
		angle	[number!]
		/radians "Angle is specified in radians"
		return: [float!]
	]
	#get-definition NAT_ARCCOSINE
]

arctangent: make native! [[
		"Returns the trigonometric arctangent (in degrees by default)"
		angle	[number!]
		/radians "Angle is specified in radians"
		return: [float!]
	]
	#get-definition NAT_ARCTANGENT
]

NaN?: make native! [[
		"Returns TRUE if the number is Not-a-Number"
		value	[number!]
		return: [logic!]
	]
	#get-definition NAT_NAN?
]

;------------------------------------------
;-			   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! :modulo
#load set-word! "%"		make op! :remainder
#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?
#load set-word! "<<"	make op! :shift-left
#load set-word! ">>"	make op! :shift-right
#load set-word! ">>>"	make op! :shift-logical
#load set-word! "**"	make op! :power
and:					make op! :and~
or:						make op! :or~
xor:					make op! :xor~

;------------------------------------------
;-				Scalars					  -
;------------------------------------------
Red: true												;-- ultimate Truth ;-) (pre-defines Red word)

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

tab:		 #"^-"
cr: 		 #"^M"
newline: lf: #"^/"
escape:      #"^["
slash: 		 #"/"
sp: space: 	 #" "
null: 		 #"^@"
crlf:		 "^M^/"
dot:		 #"."
comma:		 #","

pi: 3.141592653589793

;------------------------------------------
;-			   Routines					  -
;------------------------------------------

cos: routine [
	"Returns the trigonometric cosine"
	angle [float!] "Angle in radians"
][
	natives/cosine* 1
]

sin: routine [
	"Returns the trigonometric sine"
	angle [float!] "Angle in radians"
][
	natives/sine* 1
]

tan: routine [
	"Returns the trigonometric tangent"
	angle [float!] "Angle in radians"
][
	natives/tangent* 1
]

arccos: routine [
	"Returns the trigonometric arccosine"
	angle [float!] "Angle in radians"
][
	natives/arccosine* 1
]

arcsin: routine [
	"Returns the trigonometric arcsine"
	angle [float!] "Angle in radians"
][
	natives/arcsine* 1
]

arctan: routine [
	"Returns the trigonometric arctangent"
	angle [float!] "Angle in radians"
][
	natives/arctangent* 1
]

quit-return: routine [
	"Stops evaluation and exits the program with a given status"
	status			[integer!] "Process termination value to return"
][
	quit status
]

;------------------------------------------
;-			   Mezzanines				  -
;------------------------------------------

comment: func [value][]

quit: func [
	"Stops evaluation and exits the program"
	/return status	[integer!] "Return an exit status"
][
	quit-return any [status 0]
]

empty?: func [
	"Returns true if a series is at its tail"
	series	[series!]
	return:	[logic!]
][
	tail? series
]

??: func [
	"Prints a word and the value it refers to (molded)"
	'value [word!]
][
	prin mold :value
	prin ": "
	probe get/any :value
]

probe: func [
	"Returns a value after printing its molded form"
	value
][
	print mold value
	value
]

quote: func [
	:value
][
	:value
]

first:	func ["Returns the first value in a series"  s [series!]] [pick s 1]	;@@ temporary definitions, should be natives ?
second:	func ["Returns the second value in a series" s [series!]] [pick s 2]
third:	func ["Returns the third value in a series"  s [series!]] [pick s 3]
fourth:	func ["Returns the fourth value in a series" s [series!]] [pick s 4]
fifth:	func ["Returns the fifth value in a series"  s [series!]] [pick s 5]

last:	func ["Returns the last value in a series"  s [series!]][pick back tail s 1]

action?:	 func ["Returns true if the value is this type" value [any-type!]] [action!		= type? :value]
bitset?:	 func ["Returns true if the value is this type" value [any-type!]] [bitset!		= type? :value]
block?:		 func ["Returns true if the value is this type" value [any-type!]] [block!		= type? :value]
char?: 		 func ["Returns true if the value is this type" value [any-type!]] [char!		= type? :value]
datatype?:	 func ["Returns true if the value is this type" value [any-type!]] [datatype!	= type? :value]
file?:		 func ["Returns true if the value is this type" value [any-type!]] [file!		= type? :value]
url?:		 func ["Returns true if the value is this type" value [any-type!]] [url!		= type? :value]
function?:	 func ["Returns true if the value is this type" value [any-type!]] [function!	= type? :value]
get-path?:	 func ["Returns true if the value is this type" value [any-type!]] [get-path!	= type? :value]
get-word?:	 func ["Returns true if the value is this type" value [any-type!]] [get-word!	= type? :value]
integer?:    func ["Returns true if the value is this type" value [any-type!]] [integer!	= type? :value]
issue?:    	 func ["Returns true if the value is this type" value [any-type!]] [issue!		= type? :value]
lit-path?:	 func ["Returns true if the value is this type" value [any-type!]] [lit-path!	= type? :value]
lit-word?:	 func ["Returns true if the value is this type" value [any-type!]] [lit-word!	= type? :value]
logic?:		 func ["Returns true if the value is this type" value [any-type!]] [logic!		= type? :value]
native?:	 func ["Returns true if the value is this type" value [any-type!]] [native!		= type? :value]
none?:		 func ["Returns true if the value is this type" value [any-type!]] [none!		= type? :value]
object?:	 func ["Returns true if the value is this type" value [any-type!]] [object!		= type? :value]
op?:		 func ["Returns true if the value is this type" value [any-type!]] [op!			= type? :value]
paren?:		 func ["Returns true if the value is this type" value [any-type!]] [paren!		= type? :value]
path?:		 func ["Returns true if the value is this type" value [any-type!]] [path!		= type? :value]
refinement?: func ["Returns true if the value is this type" value [any-type!]] [refinement! = type? :value]
routine?:	 func ["Returns true if the value is this type" value [any-type!]] [routine!	= type? :value]
set-path?:	 func ["Returns true if the value is this type" value [any-type!]] [set-path!	= type? :value]
set-word?:	 func ["Returns true if the value is this type" value [any-type!]] [set-word!	= type? :value]
string?:	 func ["Returns true if the value is this type" value [any-type!]] [string!		= type? :value]
unset?:		 func ["Returns true if the value is this type" value [any-type!]] [unset!		= type? :value]
word?:		 func ["Returns true if the value is this type" value [any-type!]] [word!		= type? :value]

any-series?: func [value][
	find [												;@@ To be replaced with a typeset check
		block! paren! path! lit-path! set-path!
		get-path! string! file!
	] type?/word :value
]

spec-of: func [
	"Returns the spec of a value that supports reflection"
	value
][
	reflect :value 'spec
]

body-of: func [
	"Returns the body of a value that supports reflection"
	value
][
	reflect :value 'body
]

words-of: func [
	"Returns the list of words of a value that supports reflection"
	value
][
	reflect :value 'words
]

values-of: func [
	"Returns the list of values of a value that supports reflection"
	value
][
	reflect :value 'values
]

context: func [spec [block!]][make object! spec]

system: function [
	"Returns information about the interpreter"
	/version	  "Return the system version"
	/words		  "Return a block of global words available"
	/platform	  "Return a word identifying the operating system"
	/interpreted? "Return TRUE if called from the interpreter"
][
	case [
		version [#version]
		words	[#system [_context/get-words]]
		platform [
			#system [
				#switch OS [
					Windows  [SET_RETURN(words/_windows)]
					Syllable [SET_RETURN(words/_syllable)]
					MacOSX	 [SET_RETURN(words/_macosx)]
					#default [SET_RETURN(words/_linux)]
				]
			]
		]
		interpreted? [#system [logic/box stack/eval?]]
		'else [
			print "Please specify a system refinement value (/version, /words, or /platform)"
		]
	]
]

replace: func [
	series [series!]
	pattern
	value
	/all
	/local pos len
][
	len: either any-series? :pattern [length? pattern][1]

	either all [
		pos: series
		either any-series? :pattern [
			while [pos: find pos pattern][
				remove/part pos len
				pos: insert pos value
			]
		][
			while [pos: find pos pattern][pos/1: value]
		]
	][
		if pos: find series pattern [
			remove/part pos len
			insert pos value
		]
	]
	series
]

zero?: func [
	value [number!]
][
	value = 0
]

charset: func [
	spec [block! integer! char! string! binary!]
][
	make bitset! spec
]

p-indent: make string! 30								;@@ to be put in an local context

on-parse-event: func [
	event	[word!]   "Trace events: push, pop, fetch, match, iterate, paren, end"
	match?	[logic!]  "Result of last matching operation"
	rule	[block!]  "Current rule at current position"
	input	[series!] "Input series at next position to match"
	stack	[block!]  "Internal parse rules stack"
	return: [logic!]  "TRUE: continue parsing, FALSE: stop and exit parsing"
][
	switch event [
		push  [
			print [p-indent "-->"]
			append p-indent "  "
		]
		pop	  [
			clear back back tail p-indent
			print [p-indent "<--"]
		]
		fetch [
			print [
				p-indent "match:" mold/part rule  50 newline
				p-indent "input:" mold/part input 50 p-indent
			]
		]
		match [print [p-indent "==>" either match? ["matched"]["not matched"]]]
		end   [print ["return:" match?]]
	]
	true
]

parse-trace: func [
	"Wrapper for parse/trace using the default event processor"
	input [series!]
	rules [block!]
	/case
	/part
		limit [integer!]
	return: [logic! block!]
][
	either case [
		parse/case/trace input rules :on-parse-event
	][
		either part [
			parse/part/trace input rules limit :on-parse-event
		][
			parse/trace input rules :on-parse-event
		]
	]
]

#include %lexer.red

load: function [
	"Returns a value or block of values by reading and evaluating a source"
	source [file! url! string! binary!]
	/header "TBD: Include Red header as a loaded value"
	/all    "TBD: Don't evaluate Red header"
	/type	"TBD:"
	/part
		length [integer! string!]
	/into "Put results in out block, instead of creating a new block"
		out [block!] "Target block for results"
][
	if part [
		case [
			zero? length [return make block! 1]
			string? length [
				if (index? length) = index? source [
					return make block! 1
				]
			]
		]
	]

	unless out [out: make block! 4]
	;switch type?/word [
	;	file!	[]
	;	url!	[]
	;	binary! []
	;]
	either part [transcode/part source out length][transcode source out]
	unless :all [if 1 = length? out [out: out/1]]
	out
]


FIX: missing change from previous commit.

Red/System [
	Title:   "Red/System MacOS X runtime"
	Author:  "Nenad Rakocevic"
	File: 	 %darwin.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 OS_TYPE		4

#syscall [
	write: 4 [
		fd		[integer!]
		buffer	[c-string!]
		count	[integer!]
		return: [integer!]
	]
]

#if use-natives? = yes [
	#syscall [
		quit: 1 [							;-- "exit" syscall
			status	[integer!]
		]
	]
]

;-------------------------------------------
;-- Retrieve command-line information from stack
;-------------------------------------------
#if type = 'exe [
	system/args-count: 	pop
	system/args-list: 	as str-array! system/stack/top
	system/env-vars: 	system/args-list + system/args-count + 1
]

#include %BSD.reds

Red/System [
	Title:   "Red/System MacOS X runtime"
	Author:  "Nenad Rakocevic"
	File: 	 %darwin.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 OS_TYPE		4

#syscall [
	write: 4 [
		fd		[integer!]
		buffer	[c-string!]
		count	[integer!]
		return: [integer!]
	]
]

#if use-natives? = yes [
	#syscall [
		quit: 1 [							;-- "exit" syscall
			status	[integer!]
		]
	]
]

;-------------------------------------------
;-- Retrieve command-line information from stack
;-------------------------------------------
system/args-count: 	pop
system/args-list: 	as str-array! system/stack/top
system/env-vars: 	system/args-list + system/args-count + 1

#include %BSD.reds