FIX: wrong native ID for PARSE.

FIX: wrong native ID for PARSE.

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

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

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

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

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

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

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!]
		value2	 [number!]
		return:  [number!]
	]
	#get-definition ACT_ADD
]

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

multiply: make action! [[
		"Returns the product of two values."
		value1	 [number!]
		value2	 [number!]
		return:  [number!]
	]
	#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!]
		value2 	 [number!]
		return:  [number!]
	]
	#get-definition ACT_REMAINDER
]

round: make action! [[
		"TBD: 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!]
		value2	 [number!]
		return:  [number!]
	]
	#get-definition ACT_SUBTRACT
]

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

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

;-- Bitwise actions --

;and~
;complement
;or~
;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

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

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

load: make native! [[
		"Returns a value or block of values by reading and evaluating a source."
		source [file! url! string! binary! block!]
		/header "TBD: Include Red header as a loaded value"
		/all    "TBD: Don't evaluate Red header"
		/type	"TBD:"
		/into "Put results in out block, instead of creating a new block"
			out [block!] "Target block for results, when /into is used"
	]
	#get-definition NAT_LOAD
]

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
]

parse: make native! [[
		input [series!]
		rules [block!]
		/all
		/case
		;/strict
		return: [logic!]
	]
	#get-definition NAT_PARSE
]

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

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

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

;------------------------------------------
;-				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:		 #"."

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

quit-return: routine [
	"Stops evaluation and exits the program with a given status."
	status			[integer!] "Process termination value to return"
][
	quit status
]
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]
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]
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]
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]
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
]

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"
][
	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)]
				]
			]
		]
		'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]

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

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

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

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

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

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

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!]
		value2	 [number!]
		return:  [number!]
	]
	#get-definition ACT_ADD
]

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

multiply: make action! [[
		"Returns the product of two values."
		value1	 [number!]
		value2	 [number!]
		return:  [number!]
	]
	#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!]
		value2 	 [number!]
		return:  [number!]
	]
	#get-definition ACT_REMAINDER
]

round: make action! [[
		"TBD: 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!]
		value2	 [number!]
		return:  [number!]
	]
	#get-definition ACT_SUBTRACT
]

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

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

;-- Bitwise actions --

;and~
;complement
;or~
;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

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

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

load: make native! [[
		"Returns a value or block of values by reading and evaluating a source."
		source [file! url! string! binary! block!]
		/header "TBD: Include Red header as a loaded value"
		/all    "TBD: Don't evaluate Red header"
		/type	"TBD:"
		/into "Put results in out block, instead of creating a new block"
			out [block!] "Target block for results, when /into is used"
	]
	#get-definition NAT_LOAD
]

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
]

parse: make native! [[
		input [series!]
		rules [block!]
		/all
		/case
		;/strict
		return: [logic!]
	]
	#get-definition NAT_BIND
]

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

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

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

;------------------------------------------
;-				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:		 #"."

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

quit-return: routine [
	"Stops evaluation and exits the program with a given status."
	status			[integer!] "Process termination value to return"
][
	quit status
]
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]
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]
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]
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]
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
]

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"
][
	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)]
				]
			]
		]
		'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]


TESTS: added complemented bitset tests.

TESTS: added complemented bitset tests.

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

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

~~~start-file~~~ "bitset"

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

	--test-- "basic-1"	--assert "make bitset! #{00}" = mold make bitset! 1
	--test-- "basic-2"	--assert "make bitset! #{00}" = mold charset ""
	--test-- "basic-3"	--assert "make bitset! #{00}" = mold charset []
	--test-- "basic-4"	--assert "make bitset! #{80}" = mold charset #"^(00)"
	--test-- "basic-5"	--assert "make bitset! #{40}" = mold charset #"^(01)"
	--test-- "basic-6"	--assert "make bitset! #{000000000000FFC0}" = mold charset "0123456789"
	--test-- "basic-7"	--assert "make bitset! #{F0}" = mold charset [0 1 2 3]

	--test-- "basic-8"
		--assert "make bitset! #{FF800000FFFF8000048900007FFFFFE0}"
			 = mold charset [#"a" - #"z" 0 - 8 32 - #"0" "HELLO"]

	--test-- "basic-9"
		bs: make bitset! [0 1 2 3]
		--assert 8 = length? bs
		--assert true  = pick bs 0
		--assert true  = pick bs 1
		--assert true  = pick bs 2
		--assert true  = pick bs 3
		--assert false = pick bs 4
		--assert false = pick bs 256
		--assert false = pick bs 257
		--assert false = pick bs 2147483647
		--assert false = pick bs -2147483648

	--test-- "basic-10"
		bs: make bitset! [0 1 2 3]
		--assert 8 = length? bs
		--assert true  = bs/0
		--assert true  = bs/1
		--assert true  = bs/2
		--assert true  = bs/3
		--assert false = bs/4
		--assert false = bs/256
		--assert false = bs/257
		--assert false = bs/2147483647
		--assert false = bs/-2147483648

	--test-- "basic-11"
		bs: make bitset! [0 1 2 3]
		--assert 8 = length? bs
		--assert true  = pick bs #"^(00)"
		--assert true  = pick bs #"^(01)"
		--assert true  = pick bs #"^(02)"
		--assert true  = pick bs #"^(03)"
		--assert false = pick bs #"^(04)"
		--assert false = pick bs #"^(0100)"
		--assert false = pick bs #"^(0101)"

	--test-- "basic-12"
		bs: make bitset! [0100h 0102h]
		--assert 264 = length? bs
		--assert true  = pick bs 0100h
		--assert false = pick bs 0101h
		--assert true  = pick bs 0102h

	--test-- "basic-13"
		bs: make bitset! [255 257]
		--assert 264 = length? bs
		--assert true  = pick bs 255
		--assert false = pick bs 256
		--assert true  = pick bs 257

	--test-- "basic-14"
		bs: make bitset! [255 256]
		--assert 264 = length? bs
		--assert true = pick bs 255
		--assert true = pick bs 256

	--test-- "basic-15"
		bs: make bitset! [00010000h]
		--assert 65544 = length? bs
		--assert true = pick bs 00010000h

	--test-- "basic-16"
		bs: make bitset! 9
		--assert 16 = length? bs
		bs/7: yes
		--assert bs/7 = true
		--assert bs/8 = false
		bs/8: yes
		--assert bs/8 = true
		--assert bs/9 = false

	--test-- "basic-17"
		bs: make bitset! 8
		--assert 8 = length? bs
		bs/7: yes
		--assert bs/7 = true
		--assert bs/8 = false
		bs/8: yes
		--assert 16 = length? bs
		--assert bs/8 = true
		--assert bs/9 = false

===end-group===

===start-group=== "modify"

	--test-- "poke-1"
		bs: make bitset! [0 1 2 3]
		poke bs 4 true
		--assert true = pick bs 0
		--assert true = pick bs 1
		--assert true = pick bs 2
		--assert true = pick bs 3
		--assert true = pick bs 4
		--assert false = pick bs 5

	--test-- "poke-2"
		bs: make bitset! [0 1 2 3]
		--assert true = pick bs 0
		poke bs 0 false
		--assert false = pick bs 0
		poke bs 0 true
		--assert true = pick bs 0
		poke bs 0 none
		--assert false = pick bs 0
		bs/0: yes
		--assert bs/0 = true
		bs/0: no
		--assert bs/0 = false
		bs/0: yes
		--assert bs/0 = true
		bs/0: none
		--assert bs/0 = false

	--test-- "append-1"
		bs: make bitset! 8
		--assert 8 = length? bs
		append bs ["hello" #"x" - #"z"]
		--assert "make bitset! #{000000000000000000000000048900E0}" = mold bs

	--test-- "clear-1"
		clear bs
		--assert "make bitset! #{00000000000000000000000000000000}" = mold bs

	--test-- "clear-2"
		bs: charset "^(00)^(01)^(02)^(03)^(04)^(05)^(06)^(07)"
		--assert 8 = length? bs
		--assert "make bitset! #{FF}" = mold bs
		clear bs
		--assert "make bitset! #{00}" = mold bs

	--test-- "remove-1"
		bs: charset "012345789"
		--assert 64 = length? bs
		--assert "make bitset! #{000000000000FDC0}" = mold bs
		--assert "make bitset! #{0000000000007DC0}" = mold remove/part bs #"0"
		--assert "make bitset! #{0000000000003DC0}" = mold remove/part bs 49
		--assert "make bitset! #{0000000000000000}" = mold remove/part bs [#"2" - #"7" "8" #"9"]

===end-group===

===start-group=== "union"

	--test-- "u-1"
		c1: charset "0123456789"
		c2: charset [#"a" - #"z"]
		u: "make bitset! #{000000000000FFC0000000007FFFFFE0}"
		--assert u = mold union c1 c2
		--assert u = mold union c2 c1

===end-group===

===start-group=== "complemented"

	--test-- "comp-1"	--assert "make bitset! [not #{}]"   = mold charset [not]
	--test-- "comp-2"	--assert "make bitset! [not #{80}]" = mold charset [not #"^(00)"]
	--test-- "comp-3"	--assert "make bitset! [not #{40}]" = mold charset [not #"^(01)"]
	--test-- "comp-4"	--assert "make bitset! [not #{000000000000FFC0}]" = mold charset [not "0123456789"]
	--test-- "comp-5"	--assert "make bitset! [not #{F0}]" = mold charset [not 0 1 2 3]

	--test-- "comp-5"
		bs: make bitset! 1
		--assert "make bitset! #{00}" = mold bs
		--assert 8 = length? bs
		bs: complement bs
		--assert 8 = length? bs
		--assert "make bitset! [not #{00}]" = mold bs

	--test-- "comp-6"
		bs: charset [not "hello123" #"a" - #"z"]
		--assert 128 = length? bs
		--assert "make bitset! [not #{0000000000007000000000007FFFFFE0}]" = mold bs
		clear bs
		--assert 128 = length? bs
		--assert "make bitset! [not #{00000000000000000000000000000000}]" = mold bs

	--test-- "comp-7"
		bs: complement charset " "
		--assert 40 = length? bs
		--assert bs/31 = true
		--assert bs/32 = false
		--assert bs/33 = true
		--assert bs/200 = true

	--test-- "comp-8"
		bs/32: true
		--assert bs/32 = true
		--assert "make bitset! [not #{0000000000}]" = mold bs

	--test-- "comp-9"
		poke bs #" " none
		--assert bs/32 = false
		--assert "make bitset! [not #{0000000080}]" = mold bs

	--test-- "comp-10"
		clear bs
		--assert "make bitset! [not #{0000000000}]" = mold bs

	--test-- "comp-11"
		poke bs [32 - 40] none
		--assert "make bitset! [not #{00000000FF80}]" = mold bs
		poke bs [32 - 40] true
		--assert "make bitset! [not #{000000000000}]" = mold bs

===end-group===

~~~end-file~~~

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

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

~~~start-file~~~ "bitset"

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

	--test-- "basic-1"	--assert "make bitset! #{00}" = mold make bitset! 1
	--test-- "basic-2"	--assert "make bitset! #{00}" = mold charset ""
	--test-- "basic-3"	--assert "make bitset! #{00}" = mold charset []
	--test-- "basic-4"	--assert "make bitset! #{80}" = mold charset #"^(00)"
	--test-- "basic-5"	--assert "make bitset! #{40}" = mold charset #"^(01)"
	--test-- "basic-6"	--assert "make bitset! #{000000000000FFC0}" = mold charset "0123456789"
	--test-- "basic-7"	--assert "make bitset! #{F0}" = mold charset [0 1 2 3]

	--test-- "basic-8"
		--assert "make bitset! #{FF800000FFFF8000048900007FFFFFE0}"
			 = mold charset [#"a" - #"z" 0 - 8 32 - #"0" "HELLO"]

	--test-- "basic-9"
		bs: make bitset! [0 1 2 3]
		--assert 8 = length? bs
		--assert true  = pick bs 0
		--assert true  = pick bs 1
		--assert true  = pick bs 2
		--assert true  = pick bs 3
		--assert false = pick bs 4
		--assert false = pick bs 256
		--assert false = pick bs 257
		--assert false = pick bs 2147483647
		--assert false = pick bs -2147483648

	--test-- "basic-10"
		bs: make bitset! [0 1 2 3]
		--assert 8 = length? bs
		--assert true  = bs/0
		--assert true  = bs/1
		--assert true  = bs/2
		--assert true  = bs/3
		--assert false = bs/4
		--assert false = bs/256
		--assert false = bs/257
		--assert false = bs/2147483647
		--assert false = bs/-2147483648

	--test-- "basic-11"
		bs: make bitset! [0 1 2 3]
		--assert 8 = length? bs
		--assert true  = pick bs #"^(00)"
		--assert true  = pick bs #"^(01)"
		--assert true  = pick bs #"^(02)"
		--assert true  = pick bs #"^(03)"
		--assert false = pick bs #"^(04)"
		--assert false = pick bs #"^(0100)"
		--assert false = pick bs #"^(0101)"

	--test-- "basic-12"
		bs: make bitset! [0100h 0102h]
		--assert 264 = length? bs
		--assert true  = pick bs 0100h
		--assert false = pick bs 0101h
		--assert true  = pick bs 0102h

	--test-- "basic-13"
		bs: make bitset! [255 257]
		--assert 264 = length? bs
		--assert true  = pick bs 255
		--assert false = pick bs 256
		--assert true  = pick bs 257

	--test-- "basic-14"
		bs: make bitset! [255 256]
		--assert 264 = length? bs
		--assert true = pick bs 255
		--assert true = pick bs 256

	--test-- "basic-15"
		bs: make bitset! [00010000h]
		--assert 65544 = length? bs
		--assert true = pick bs 00010000h

	--test-- "basic-16"
		bs: make bitset! 9
		--assert 16 = length? bs
		bs/7: yes
		--assert bs/7 = true
		--assert bs/8 = false
		bs/8: yes
		--assert bs/8 = true
		--assert bs/9 = false

	--test-- "basic-17"
		bs: make bitset! 8
		--assert 8 = length? bs
		bs/7: yes
		--assert bs/7 = true
		--assert bs/8 = false
		bs/8: yes
		--assert 16 = length? bs
		--assert bs/8 = true
		--assert bs/9 = false

===end-group===

===start-group=== "modify"

	--test-- "poke-1"
		bs: make bitset! [0 1 2 3]
		poke bs 4 true
		--assert true = pick bs 0
		--assert true = pick bs 1
		--assert true = pick bs 2
		--assert true = pick bs 3
		--assert true = pick bs 4
		--assert false = pick bs 5

	--test-- "poke-2"
		bs: make bitset! [0 1 2 3]
		--assert true = pick bs 0
		poke bs 0 false
		--assert false = pick bs 0
		poke bs 0 true
		--assert true = pick bs 0
		poke bs 0 none
		--assert false = pick bs 0
		bs/0: yes
		--assert bs/0 = true
		bs/0: no
		--assert bs/0 = false
		bs/0: yes
		--assert bs/0 = true
		bs/0: none
		--assert bs/0 = false

	--test-- "append-1"
		bs: make bitset! 8
		--assert 8 = length? bs
		append bs ["hello" #"x" - #"z"]
		--assert "make bitset! #{000000000000000000000000048900E0}" = mold bs

	--test-- "clear-1"
		clear bs
		--assert "make bitset! #{00000000000000000000000000000000}" = mold bs

	--test-- "clear-2"
		bs: charset "^(00)^(01)^(02)^(03)^(04)^(05)^(06)^(07)"
		--assert 8 = length? bs
		--assert "make bitset! #{FF}" = mold bs
		clear bs
		--assert "make bitset! #{00}" = mold bs

	--test-- "remove-1"
		bs: charset "012345789"
		--assert 64 = length? bs
		--assert "make bitset! #{000000000000FDC0}" = mold bs
		--assert "make bitset! #{0000000000007DC0}" = mold remove/part bs #"0"
		--assert "make bitset! #{0000000000003DC0}" = mold remove/part bs 49
		--assert "make bitset! #{0000000000000000}" = mold remove/part bs [#"2" - #"7" "8" #"9"]

===end-group===

===start-group=== "union"

	--test-- "u-1"
		c1: charset "0123456789"
		c2: charset [#"a" - #"z"]
		u: "make bitset! #{000000000000FFC0000000007FFFFFE0}"
		--assert u = mold union c1 c2
		--assert u = mold union c2 c1

===end-group===

~~~end-file~~~


FIX: Removed unused function binding

FIX: Removed unused function binding

Red/System [
	Title:   "Red/System unistd Binding"
	Author:  "Bruno Anselme"
	EMail:   "be.red@free.fr"
	File:    %linux.reds
	Rights:  "Copyright (c) 2014 Bruno Anselme"
	License: {
		Distributed under the Boost Software License, Version 1.0.
		See https://github.com/dockimbel/Red/blob/master/BSL-License.txt
	}
]

#if target = 'IA-32 [
	system/fpu/mask/overflow: on
	system/fpu/mask/underflow: on
	system/fpu/mask/zero-divide: on
	system/fpu/mask/invalid-op: on
	system/fpu/update
]

#if OS <> 'Windows [
	; Wordexp enums
	#enum wrde-flag [
		WRDE_DOOFFS:     1
		WRDE_APPEND:     2
		WRDE_NOCMD:      4
		WRDE_REUSE:      8
		WRDE_SHOWERR:    16
		WRDE_UNDEF:      32
		__WRDE_FLAGS:    63
	]
	#enum wrde-error [
		WRDE_NOSPACE:     1
		WRDE_BADCHAR:     2
		WRDE_BADVAL:      3
		WRDE_CMDSUB:      4
		WRDE_SYNTAX:      5
	]
	; Wordexp types
	wordexp-type!: alias struct! [
		we_wordc  [integer!]
		we_wordv  [str-array!]
		we_offs   [integer!]
	]
	; Values for the second argument to fcntl
	#define F_DUPFD   0
	#define F_GETFD   1
	#define F_SETFD   2
	#define F_GETFL   3
	#define F_SETFL   4

	; Values for the third argument to fcntl
	#enum open-fnctl! [
		O_ACCMODE:       0003h
		O_RDONLY:          00h
		O_WRONLY:          01h
		O_RDWR:            02h
		O_CREAT:         0100h
		O_EXCL:          0200h
		O_NOCTTY:        0400h
		O_TRUNC:     00001000h
		O_APPEND:    00002000h
		O_NONBLOCK:  00004000h
		O_SYNC:      04010000h
		O_ASYNC:     00020000h
		O_LARGEFILE: 00100000h

		O_DIRECTORY: 00200000h
		O_NOFOLLOW:  00400000h
		O_CLOEXEC:   02000000h
		O_DIRECT:    00040000h
		O_NOATIME:   01000000h
		O_PATH:      10000000h
		O_DSYNC:     00010000h
	]

	#import [ LIBC-file cdecl [
		fork: "fork" [ "Create a new process"
			return:        [integer!]
		]
		sleep: "sleep" [ "Make the process sleep for nb seconds"
			nb             [integer!]
			return:        [integer!]
		]
		execvp: "execvp" [
			cmd            [c-string!] "Command to run"
			args-list      [str-array!]
			return:        [integer!]
		]
		wordexp: "wordexp" [ "Perform word expansions"
			words          [c-string!]
			pwordexp       [wordexp-type!]
			flags          [integer!]
			return:        [integer!]
		]
		wordfree: "wordfree" [ "Free strings array"
			pwordexp       [wordexp-type!]
			return:        [integer!]
		]
		wait: "wait" [ "Wait for any child process to stop or terminate"
			status         [int-ptr!]
			return:        [integer!]
		]
		waitpid: "waitpid" [ "Wait for specified child process to stop or terminate"
			pid            [integer!]  "Process ID"
			status         [int-ptr!]
			options        [integer!]
			return:        [integer!]
		]
		pipe: "pipe" [ "Create a one-way communication channel"
			pipedes        [int-ptr!]  "Pointer to a 2 integers array"
			return:        [integer!]
		]
		dup2: "dup2" [ "Duplicate fd to fd2 closing fd2 and making it open on the same file"
			fd             [integer!]  "File descriptor"
			fd2            [integer!]  "File descriptor"
			return:        [integer!]
		]
		close: "close" [ "Close the file descriptor"
			fd             [integer!]  "File descriptor"
			return:        [integer!]
		]
		ioread: "read" [ "Read nbytes into buf from fd"
			fd             [integer!]  "File descriptor"
			buf            [byte-ptr!] "Pointer to allocated memory"
			nbytes         [integer!]  "Size of allocated memory"
			return:        [integer!]  "Number of bytes read or error"
		]
		iowrite: "write" [ "Write nbytes into fd from buf"
			fd             [integer!]  "File descriptor"
			buf            [byte-ptr!] "Pointer to source data"
			nbytes         [integer!]  "Source data count (bytes)"
			return:        [integer!]  "Number of bytes written or error"
		]
		fcntl: "fcntl" [ "Manipulate file descriptor"
			[variadic]
			; fd           [integer!]    "File descriptor"
			; cmd          [integer!]    "Command"
			; ...                        "Optional arguments"
			return:        [integer!]
		]
	] ; cdecl
	] ; #import
] ; OS <> 'Windows

Red/System [
	Title:   "Red/System unistd Binding"
	Author:  "Bruno Anselme"
	EMail:   "be.red@free.fr"
	File:    %linux.reds
	Rights:  "Copyright (c) 2014 Bruno Anselme"
	License: {
		Distributed under the Boost Software License, Version 1.0.
		See https://github.com/dockimbel/Red/blob/master/BSL-License.txt
	}
]

#if target = 'IA-32 [
	system/fpu/mask/overflow: on
	system/fpu/mask/underflow: on
	system/fpu/mask/zero-divide: on
	system/fpu/mask/invalid-op: on
	system/fpu/update
]

#if OS <> 'Windows [
	; Wordexp enums
	#enum wrde-flag [
		WRDE_DOOFFS:     1
		WRDE_APPEND:     2
		WRDE_NOCMD:      4
		WRDE_REUSE:      8
		WRDE_SHOWERR:    16
		WRDE_UNDEF:      32
		__WRDE_FLAGS:    63
	]
	#enum wrde-error [
		WRDE_NOSPACE:     1
		WRDE_BADCHAR:     2
		WRDE_BADVAL:      3
		WRDE_CMDSUB:      4
		WRDE_SYNTAX:      5
	]
	; Wordexp types
	wordexp-type!: alias struct! [
		we_wordc  [integer!]
		we_wordv  [str-array!]
		we_offs   [integer!]
	]
	; Values for the second argument to fcntl
	#define F_DUPFD   0
	#define F_GETFD   1
	#define F_SETFD   2
	#define F_GETFL   3
	#define F_SETFL   4

	; Values for the third argument to fcntl
	#enum open-fnctl! [
		O_ACCMODE:       0003h
		O_RDONLY:          00h
		O_WRONLY:          01h
		O_RDWR:            02h
		O_CREAT:         0100h
		O_EXCL:          0200h
		O_NOCTTY:        0400h
		O_TRUNC:     00001000h
		O_APPEND:    00002000h
		O_NONBLOCK:  00004000h
		O_SYNC:      04010000h
		O_ASYNC:     00020000h
		O_LARGEFILE: 00100000h

		O_DIRECTORY: 00200000h
		O_NOFOLLOW:  00400000h
		O_CLOEXEC:   02000000h
		O_DIRECT:    00040000h
		O_NOATIME:   01000000h
		O_PATH:      10000000h
		O_DSYNC:     00010000h
	]

	#import [ LIBC-file cdecl [
		fork: "fork" [ "Create a new process"
			return:        [integer!]
		]
		sleep: "sleep" [ "Make the process sleep for nb seconds"
			nb             [integer!]
			return:        [integer!]
		]
		execvp: "execvp" [
			cmd            [c-string!] "Command to run"
			args-list      [str-array!]
			return:        [integer!]
		]
		execlp: "execlp" [
			[variadic]
;			cmd            [c-string!] "Command to run"
;			arg1           [c-string!]
;			arg2           [c-string!]
;			...
			return:        [integer!]
		]
		wordexp: "wordexp" [ "Perform word expansions"
			words          [c-string!]
			pwordexp       [wordexp-type!]
			flags          [integer!]
			return:        [integer!]
		]
		wordfree: "wordfree" [ "Free strings array"
			pwordexp       [wordexp-type!]
			return:        [integer!]
		]
		wait: "wait" [ "Wait for any child process to stop or terminate"
			status         [int-ptr!]
			return:        [integer!]
		]
		waitpid: "waitpid" [ "Wait for specified child process to stop or terminate"
			pid            [integer!]  "Process ID"
			status         [int-ptr!]
			options        [integer!]
			return:        [integer!]
		]
		pipe: "pipe" [ "Create a one-way communication channel"
			pipedes        [int-ptr!]  "Pointer to a 2 integers array"
			return:        [integer!]
		]
		dup2: "dup2" [ "Duplicate fd to fd2 closing fd2 and making it open on the same file"
			fd             [integer!]  "File descriptor"
			fd2            [integer!]  "File descriptor"
			return:        [integer!]
		]
		close: "close" [ "Close the file descriptor"
			fd             [integer!]  "File descriptor"
			return:        [integer!]
		]
		ioread: "read" [ "Read nbytes into buf from fd"
			fd             [integer!]  "File descriptor"
			buf            [byte-ptr!] "Pointer to allocated memory"
			nbytes         [integer!]  "Size of allocated memory"
			return:        [integer!]  "Number of bytes read or error"
		]
		iowrite: "write" [ "Write nbytes into fd from buf"
			fd             [integer!]  "File descriptor"
			buf            [byte-ptr!] "Pointer to source data"
			nbytes         [integer!]  "Source data count (bytes)"
			return:        [integer!]  "Number of bytes written or error"
		]
		fcntl: "fcntl" [ "Manipulate file descriptor"
			[variadic]
			; fd           [integer!]    "File descriptor"
			; cmd          [integer!]    "Command"
			; ...                        "Optional arguments"
			return:        [integer!]
		]
	] ; cdecl
	] ; #import
] ; OS <> 'Windows


FEAT: added support to char! parsing to runtime lexer.

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

		m: n * 10
		if m < n [SET_RETURN(none-value) exit]			;-- return NONE on overflow
		n: m

		m: n + c - #"0"
		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-pop: function [stack [block!]][
	value: last stack
	remove back tail stack
	append/only last stack value
]

transcode: func [
	src		[string!]
	dst		[block! none!]
	return: [block!]
	/local
		cs stack pos s e value line count? wrong-delimiters comment-rule
		digit 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 block-rule literal-value
		any-value escaped-char char-rule line-string nested-curly-braces
		multiline-string string-rule cnt trans-string new base c
][
	cs:		[- - - - - - - - - - - - -]
	stack:	clear []
	count?:	yes											;-- if TRUE, lines counter is enabled

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

	trans-string: [
		new: make string! (index? e) - index? s
		parse/case copy/part s e [						;@@ add /part option to parse!
			any [
				escaped-char (append new value)
				| set c skip (append new c)
			]
		]
		new
	]

	if cs/1 = '- [
		cs/1:  charset "0123465798"						;-- digit
		cs/2:  union cs/1 charset "ABCDEF"				;-- hexa
		cs/3:  union cs/2 charset "abcdef"				;-- hexa-char
		cs/4:  charset {/\^^,[](){}"#%$@:;}				;-- not-word-char
		cs/5:  union union cs/4 cs/1 charset {'}		;-- not-word-1st
		cs/6:  charset {[](){}"%@:;}					;-- not-file-char
		cs/7:  #"^""									;-- not-str-char
		cs/8:  #"}"										;-- not-mstr-char
		cs/9:  charset [#"^(40)" - #"^(5F)"]			;-- caret-char
		cs/10: charset [#"^(00)" - #"^(1F)"]			;-- non-printable-char
		cs/11: charset {^{"[]);}						;-- integer-end
		cs/12: charset " ^-^M"							;-- ws-ASCII, ASCII common whitespaces
		cs/13: charset [#"^(80)" - #"^(8A)"]			;-- ws-U+2k, Unicode spaces in the U+2000-U+200A range
	]
	set [
		digit 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
	] 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)")
			]
			| s: [2 6 hexa-char] e: (				;-- Unicode values allowed up to 10FFFFh
				value: encode-UTF8-char s e
			)
		] #")"
		| #"^^" [
			[
				#"/" 	(value: #"^/")
				| #"-"	(value: #"^-")
				| #"?" 	(value: #"^(del)")			;@@FIXME
				| #"^^" (value: #"^^")				;-- caret escaping case
				| #"{"	(value: #"{")
				| #"}"	(value: #"}")
				| #"^""	(value: #"^"")
			]
			| s: caret-char (value: s/1 - 64)
		]
	]

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

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

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

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

	string-rule: [line-string | multiline-string]

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

	integer-rule: [
		integer-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)
	]

	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
			;| multiline-comment-rule
			;| escaped-rule    (stack/push value)
			| integer-rule		(append last stack trans-integer s e)
			;| hexa-rule		  (stack/push decode-hexa	 copy/part s e)
			;| word-rule		  (stack/push to type value)
			;| lit-word-rule	  (stack/push to type value)
			;| get-word-rule	  (stack/push to type value)
			;| refinement-rule (stack/push to refinement! copy/part s e)
			;| slash-rule	  (stack/push to word! 	   	 copy/part s e)
			;| issue-rule	  (stack/push to issue!	   	 copy/part s e)
			;| file-rule		  (stack/push load-file		 copy/part s e)
			| char-rule			(append last stack value)
			| block-rule
			| paren-rule
			| string-rule		(append last stack do trans-string)
			;| binary-rule	  (stack/push load-binary s e)
		]
	]

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

	parse/case src [any-value opt wrong-delimiters]
	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-integer: routine [
	start [string!]
	end	  [string!]
	/local
		c	 [integer!]
		n	 [integer!]
		m	 [integer!]
		len  [integer!]
		p	 [byte-ptr!]
		neg? [logic!]
][
	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

		m: n * 10
		if m < n [SET_RETURN(none-value) exit]			;-- return NONE on overflow
		n: m

		m: n + c - #"0"
		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-pop: function [stack [block!]][
	value: last stack
	remove back tail stack
	append/only last stack value
]

transcode: func [
	src		[string!]
	dst		[block! none!]
	return: [block!]
	/local
		cs stack pos s e value line count? wrong-delimiters comment-rule
		digit 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 block-rule literal-value
		any-value escaped-char char-rule line-string nested-curly-braces
		multiline-string string-rule cnt trans-string new base c
][
	cs:		[- - - - - - - - - - - - -]
	stack:	clear []
	count?:	yes											;-- if TRUE, lines counter is enabled

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

	trans-string: [
		new: make string! (index? e) - index? s
		parse/case copy/part s e [						;@@ add /part option to parse!
			any [
				escaped-char (append new value)
				| set c skip (append new c)
			]
		]
		new
	]

	if cs/1 = '- [
		cs/1:  charset "0123465798"						;-- digit
		cs/2:  union cs/1 charset "ABCDEF"				;-- hexa
		cs/3:  union cs/2 charset "abcdef"				;-- hexa-char
		cs/4:  charset {/\^^,[](){}"#%$@:;}				;-- not-word-char
		cs/5:  union union cs/4 cs/1 charset {'}		;-- not-word-1st
		cs/6:  charset {[](){}"%@:;}					;-- not-file-char
		cs/7:  #"^""									;-- not-str-char
		cs/8:  #"}"										;-- not-mstr-char
		cs/9:  charset [#"^(40)" - #"^(5F)"]			;-- caret-char
		cs/10: charset [#"^(00)" - #"^(1F)"]			;-- non-printable-char
		cs/11: charset {^{"[]);}						;-- integer-end
		cs/12: charset " ^-^M"							;-- ws-ASCII, ASCII common whitespaces
		cs/13: charset [#"^(80)" - #"^(8A)"]			;-- ws-U+2k, Unicode spaces in the U+2000-U+200A range
	]
	set [
		digit 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
	] 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)")
			]
			| s: [2 6 hexa-char] e: (				;-- Unicode values allowed up to 10FFFFh
				value: encode-UTF8-char s e
			)
		] #")"
		| #"^^" [
			[
				#"/" 	(value: #"^/")
				| #"-"	(value: #"^-")
				| #"?" 	(value: #"^(del)")			;@@FIXME
				| #"^^" (value: #"^^")				;-- caret escaping case
				| #"{"	(value: #"{")
				| #"}"	(value: #"}")
				| #"^""	(value: #"^"")
			]
			| s: caret-char (value: s/1 - 64)
		]
	]

	char-rule: [
		{#"} (type: char!) [
			s: escaped-char
			| copy value UTF8-printable (value: as-binary value)
			| #"^-" (value: s/1)
		] {"}
	]

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

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

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

	string-rule: [line-string | multiline-string]

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

	integer-rule: [
		integer-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)
	]

	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
			;| multiline-comment-rule
			;| escaped-rule    (stack/push value)
			| integer-rule	  (append last stack trans-integer s e)
			;| hexa-rule		  (stack/push decode-hexa	 copy/part s e)
			;| word-rule		  (stack/push to type value)
			;| lit-word-rule	  (stack/push to type value)
			;| get-word-rule	  (stack/push to type value)
			;| refinement-rule (stack/push to refinement! copy/part s e)
			;| slash-rule	  (stack/push to word! 	   	 copy/part s e)
			;| issue-rule	  (stack/push to issue!	   	 copy/part s e)
			;| file-rule		  (stack/push load-file		 copy/part s e)
			;| char-rule		  (stack/push decode-UTF8-char value)
			| block-rule
			| paren-rule
			| string-rule	  (append last stack do trans-string)
			;| binary-rule	  (stack/push load-binary s e)
		]
	]

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

	parse/case src [any-value opt wrong-delimiters]
	stack/1
]


FIX: bug in allocating at tail of series.

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

set-type: func [										;@@ convert to macro?
	cell 		[cell!]
	type		[integer!]
][
	cell/header: cell/header and type-mask or type
]

alloc-at-tail: func [
	blk		[red-block!]
	return: [cell!]
][
	alloc-tail as series! blk/node/value
]

alloc-tail: func [
	s		[series!]
	return: [cell!]
	/local
		cell	[red-value!]
][
	if (as byte-ptr! s/tail + 1) > ((as byte-ptr! s + 1) + s/size) [
		s: expand-series s 0
	]

	cell: s/tail
	;-- ensure that cell is within series boundary
	assert (as byte-ptr! cell) < ((as byte-ptr! s + 1) + s/size)

	s/tail: s/tail + 1									;-- move tail to next cell
	cell
]

copy-cell: func [
	src		[cell!]
	dst		[cell!]
	return: [red-value!]
][
	copy-memory											;@@ optimize for 16 bytes copying
		as byte-ptr! dst
		as byte-ptr! src
		size? cell!
	dst
]

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

set-type: func [										;@@ convert to macro?
	cell 		[cell!]
	type		[integer!]
][
	cell/header: cell/header and type-mask or type
]

alloc-at-tail: func [
	blk		[red-block!]
	return: [cell!]
][
	alloc-tail as series! blk/node/value
]

alloc-tail: func [
	s		[series!]
	return: [cell!]
	/local
		cell	[red-value!]
][
	if (as byte-ptr! s/tail + 1) >= ((as byte-ptr! s + 1) + s/size) [
		s: expand-series s 0
	]

	cell: s/tail
	;-- ensure that cell is within series boundary
	assert (as byte-ptr! cell) < ((as byte-ptr! s + 1) + s/size)

	s/tail: s/tail + 1									;-- move tail to next cell
	cell
]

copy-cell: func [
	src		[cell!]
	dst		[cell!]
	return: [red-value!]
][
	copy-memory											;@@ optimize for 16 bytes copying
		as byte-ptr! dst
		as byte-ptr! src
		size? cell!
	dst
]