rephrase TO message

rephrase TO message

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

system: context [
	version: #version
	build:	 #build-date

	words: #system [
		obj: as red-object! stack/push*
		obj/header: TYPE_OBJECT
		obj/ctx:	global-ctx
		obj/class:	-1
		obj/on-set:	null
	]

	platform: func ["Return a word identifying the operating system"][
		#system [
			#switch OS [
				Windows  [SET_RETURN(words/_windows)]
				Syllable [SET_RETURN(words/_syllable)]
				MacOSX	 [SET_RETURN(words/_macosx)]
				#default [SET_RETURN(words/_linux)]
			]
		]
	]

	catalog: context [
		datatypes:
		actions:
		natives: none

		errors: context [
			throw: object [
				code:				0
				type:				"Throw error"
				break:				"no loop to break"
				return:				"return or exit not in function"
				throw:				["no catch for throw:" :arg1]
				continue:			"no loop to continue"
			]
			note: object [
				code:				100
				type:				"note"
				no-load:			["cannot load: " :arg1]
			]
			syntax: object [
				code:				200
				type:				"Syntax error"
				invalid:			["invalid" :arg1 "at" :arg2]
				missing:			["missing" :arg2 "at" :arg1]
				no-header:			["script is missing a Red header:" :arg1]
				no-rs-header:		["script is missing a Red/System header:" :arg1]
				bad-header:			["script header is not valid:" :arg1]
				malconstruct:		["invalid construction spec:" :arg1]
				bad-char:			["invalid character in:" :arg1]
			]
			script: object [
				code:				300
				type:				"Script error"
				no-value:			[:arg1 "has no value"]
				need-value:			[:arg1 "needs a value"]
				not-defined:		[:arg1 "word is not bound to a context"]
				not-in-context:		[:arg1 "is not in the specified context"]
				no-arg:				[:arg1 "is missing its" :arg2 "argument"]
				expect-arg:			[:arg1 "does not allow" :arg2 "for its" :arg3 "argument"]
				expect-val:			["expected" :arg1 "not" :arg2]
				expect-type:		[:arg1 :arg2 "field must be of type" :arg3]
				cannot-use:			["cannot use" :arg1 "on" :arg2 "value"]
				invalid-arg:		["invalid argument:" :arg1]
				invalid-type:		[:arg1 "type is not allowed here"]
				invalid-op:			["invalid operator:" :arg1]
				no-op-arg:			[:arg1 "operator is missing an argument"]
				invalid-data:		["data not in correct format:" :arg1]
				invalid-part:		["invalid /part count:" :arg1]
				not-same-type:		"values must be of the same type"
				not-related:		["incompatible argument for" :arg1 "of" :arg2]
				bad-func-def:		["invalid function definition:" :arg1]
				bad-func-arg:		["function argument" :arg1 "is not valid"]
				bad-func-extern:	["invalid /extern value" :arg1]
				no-refine:			[:arg1 "has no refinement called" :arg2]
				bad-refines:		"incompatible or invalid refinements"
				bad-refine:			["incompatible refinement:" :arg1]
				invalid-path:		["cannot access" :arg2 "in path" :arg1]
				invalid-path-set:	["unsupported type in" :arg1 "set-path"]
				invalid-path-get:	["unsupported type in" :arg1 "get-path"]
				bad-path-type:		["path" :arg1 "is not valid for" :arg2 "type"]
				bad-path-set:		["cannot set" :arg2 "in path" :arg1]
				bad-field-set:		["cannot set" :arg1 "field to" :arg2 "datatype"]
				dup-vars:			["duplicate variable specified:" :arg1]
				past-end:			"out of range or past end"
				missing-arg:		"missing a required argument or refinement"
				out-of-range:		["value out of range:" :arg1]
				invalid-chars:		"contains invalid characters"
				invalid-compare:	["cannot compare" :arg1 "with" :arg2]
				wrong-type:			["datatype assertion failed for:" :arg1]
				invalid-refine-arg: ["invalid" :arg1 "argument:" :arg2]
				type-limit:			[:arg1 "overflow/underflow"]
				size-limit:			["maximum limit reached:" :arg1]
				no-return:			"block did not return a value"
				throw-usage:		"invalid use of a thrown error value"
				;locked-word:		["protected variable - cannot modify:" :arg1]
				;protected:			"protected value or series - cannot modify"
				;self-protected:	"cannot set/unset self - it is protected"
				bad-bad:			[:arg1 "error:" :arg2]
				bad-make-arg:		["cannot MAKE" :arg1 "from:" :arg2]
                bad-to-arg:         ["TO cannot convert" :arg1 "from:" :arg2]
				invalid-spec-field: ["invalid" :arg1 "field in spec block"]
				missing-spec-field: [:arg1 "not found in spec block"]
				;bad-decode:		"missing or unsupported encoding marker"
				;already-used:		["alias word is already in use:" :arg1]
				;wrong-denom:		[:arg1 "not same denomination as" :arg2]
				;bad-press:			["invalid compressed data - problem:" :arg1]
				;dialect:			["incorrect" :arg1 "dialect usage at:" :arg2]
				parse-rule:			["PARSE - invalid rule or usage of rule:" :arg1]
				parse-end:			["PARSE - unexpected end of rule after:" :arg1]
				;parse-variable:	["PARSE - expected a variable, not:" :arg1]
				;parse-command:		"PARSE - command cannot be used as variable:" :arg1]
				parse-invalid-ref:	["PARSE - get-word refers to a different series!" :arg1]
				parse-series:		["PARSE - input must be a series:" :arg1]
				parse-unsupported:	"PARSE - matching by datatype not supported for any-string! input"
			]
			math: object [
				code:				400
				type:				"Math error"
				zero-divide:		"attempt to divide by zero"
				overflow:			"math or number overflow"
				positive:			"positive number required"
			]
			access: object [
				code:				500
				type:				"Access error"
				;cannot-open:		["cannot open:" :arg1 "reason:" :arg2]
				;not-open:			["port is not open:" :arg1]
				;already-open:		["port is already open:" :arg1]
				;no-connect:		["cannot connect:" :arg1 "reason:" :arg2]
				;not-connected:		["port is not connected:" :arg1]
				;no-script:			["script not found:" :arg1]
				;no-scheme-name:	["new scheme must have a name:" :arg1]
				;no-scheme:			["missing port scheme:" :arg1]
				;invalid-spec:		["invalid spec or options:" :arg1]
				;invalid-port:		["invalid port object (invalid field values)"]
				;invalid-actor:		["invalid port actor (must be native or object)"]
				;invalid-port-arg:	["invalid port argument:" arg1]
				;no-port-action:	["this port does not support:" :arg1]
				;protocol:			["protocol error:" :arg1]
				;invalid-check:		["invalid checksum (tampered file):" :arg1]
				;write-error:		["write failed:" :arg1 "reason:" :arg2]
				;read-error:		["read failed:" :arg1 "reason:" :arg2]
				;read-only:			["read-only - write not allowed:" :arg1]
				;no-buffer:			["port has no data buffer:" :arg1]
				;timeout:			["port action timed out:" :arg1]
				;no-create:			["cannot create:" :arg1]
				;no-delete:			["cannot delete:" :arg1]
				;no-rename:			["cannot rename:" :arg1]
				;bad-file-path:		["bad file path:" :arg1]
				;bad-file-mode:		["bad file mode:" :arg1]
				;security:			["security violation:" :arg1 " (refer to SECURE function)"]
				;security-level:	["attempt to lower security to" :arg1]
				;security-error:	["invalid" :arg1 "security policy:" :arg2]
				;no-codec:			["cannot decode or encode (no codec):" :arg1]
				;bad-media:			["bad media data (corrupt image, sound, video)"]
				;no-extension:		["cannot open extension:" :arg1]
				;bad-extension:		["invalid extension format:" :arg1]
				;extension-init:	["extension cannot be initialized (check version):" :arg1]
				;call-fail:			["external process failed:" :arg1]
			]
			user: object [
				code:				800
				type:				"User error"
				message:			[:arg1]
			]
			internal: object [
				code:				900
				type:				"Internal error"
				bad-path:			["bad path:" arg1]
				not-here:			[arg1 "not supported on your system"]
				no-memory:			"not enough memory"
				stack-overflow:		"stack overflow"
				;bad-series:		"invalid series"
				;limit-hit:			["internal limit reached:" :arg1]
				;bad-sys-func:		["invalid or missing system function:" :arg1]
				feature-na:			"feature not available"
				not-done:			"reserved for future use (or not yet implemented)"
				invalid-error:		"error object or fields were not valid"
			]
		]

	]

	state: context [
		interpreted?: func ["Return TRUE if called from the interpreter"][
			#system [logic/box stack/eval? null]
		]

		last-error: none
	]

	modules: make block! 8
	codecs:  context []
	schemes: context []
	ports:	 context []

	locale: context [
		language:
		language*:										;-- in locale language
		locale:
		locale*: none									;-- in locale language

		;collation: context [
		;	lower-to-upper: #system [stack/set-last as cell! case-folding/lower-to-upper]
		;	upper-to-lower: #system [stack/set-last as cell! case-folding/upper-to-lower]
		;]

		months: [
		  "January" "February" "March" "April" "May" "June"
		  "July" "August" "September" "October" "November" "December"
		]

		days: [
		  "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday" "Sunday"
		]
	]

	options: context [
		boot: 			none
		home: 			none
		path: 			none
		script: 		none
		args: 			none
		do-arg: 		none
		debug: 			none
		secure: 		none
		quiet: 			false
		binary-base: 	16
		decimal-digits: 15
		module-paths: 	make block! 1
		file-types: 	none

		;-- change the way float numbers are processed
		float: context [
			pretty?: false
			full?: 	 false

			on-change*: func [word old new][
				switch word [
					pretty? [
						either new [
							#system [float/pretty-print?: yes]
						][
							#system [float/pretty-print?: no]
						]
					]
					full? [
						either new [
							#system [float/full-support?: yes]
						][
							#system [float/full-support?: no]
						]
					]
				]
			]
		]
	]

	script: context [
		title: header: parent: path: args: none
	]

	standard: context [
		header: context [
			title: name: type: version: date: file: author: needs: none
		]
		error: context [
			code: type: id: arg1: arg2: arg3: near: where: stack: none
		]
	]

	view: context [
		screen: 	none
		event-port: none

		metrics: context [
			screen-size: 	none
			dpi:			none
			;scaling:		1x1
		]
	]

	lexer: none
	console: none
]

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

system: context [
	version: #version
	build:	 #build-date

	words: #system [
		obj: as red-object! stack/push*
		obj/header: TYPE_OBJECT
		obj/ctx:	global-ctx
		obj/class:	-1
		obj/on-set:	null
	]

	platform: func ["Return a word identifying the operating system"][
		#system [
			#switch OS [
				Windows  [SET_RETURN(words/_windows)]
				Syllable [SET_RETURN(words/_syllable)]
				MacOSX	 [SET_RETURN(words/_macosx)]
				#default [SET_RETURN(words/_linux)]
			]
		]
	]

	catalog: context [
		datatypes:
		actions:
		natives: none

		errors: context [
			throw: object [
				code:				0
				type:				"Throw error"
				break:				"no loop to break"
				return:				"return or exit not in function"
				throw:				["no catch for throw:" :arg1]
				continue:			"no loop to continue"
			]
			note: object [
				code:				100
				type:				"note"
				no-load:			["cannot load: " :arg1]
			]
			syntax: object [
				code:				200
				type:				"Syntax error"
				invalid:			["invalid" :arg1 "at" :arg2]
				missing:			["missing" :arg2 "at" :arg1]
				no-header:			["script is missing a Red header:" :arg1]
				no-rs-header:		["script is missing a Red/System header:" :arg1]
				bad-header:			["script header is not valid:" :arg1]
				malconstruct:		["invalid construction spec:" :arg1]
				bad-char:			["invalid character in:" :arg1]
			]
			script: object [
				code:				300
				type:				"Script error"
				no-value:			[:arg1 "has no value"]
				need-value:			[:arg1 "needs a value"]
				not-defined:		[:arg1 "word is not bound to a context"]
				not-in-context:		[:arg1 "is not in the specified context"]
				no-arg:				[:arg1 "is missing its" :arg2 "argument"]
				expect-arg:			[:arg1 "does not allow" :arg2 "for its" :arg3 "argument"]
				expect-val:			["expected" :arg1 "not" :arg2]
				expect-type:		[:arg1 :arg2 "field must be of type" :arg3]
				cannot-use:			["cannot use" :arg1 "on" :arg2 "value"]
				invalid-arg:		["invalid argument:" :arg1]
				invalid-type:		[:arg1 "type is not allowed here"]
				invalid-op:			["invalid operator:" :arg1]
				no-op-arg:			[:arg1 "operator is missing an argument"]
				invalid-data:		["data not in correct format:" :arg1]
				invalid-part:		["invalid /part count:" :arg1]
				not-same-type:		"values must be of the same type"
				not-related:		["incompatible argument for" :arg1 "of" :arg2]
				bad-func-def:		["invalid function definition:" :arg1]
				bad-func-arg:		["function argument" :arg1 "is not valid"]
				bad-func-extern:	["invalid /extern value" :arg1]
				no-refine:			[:arg1 "has no refinement called" :arg2]
				bad-refines:		"incompatible or invalid refinements"
				bad-refine:			["incompatible refinement:" :arg1]
				invalid-path:		["cannot access" :arg2 "in path" :arg1]
				invalid-path-set:	["unsupported type in" :arg1 "set-path"]
				invalid-path-get:	["unsupported type in" :arg1 "get-path"]
				bad-path-type:		["path" :arg1 "is not valid for" :arg2 "type"]
				bad-path-set:		["cannot set" :arg2 "in path" :arg1]
				bad-field-set:		["cannot set" :arg1 "field to" :arg2 "datatype"]
				dup-vars:			["duplicate variable specified:" :arg1]
				past-end:			"out of range or past end"
				missing-arg:		"missing a required argument or refinement"
				out-of-range:		["value out of range:" :arg1]
				invalid-chars:		"contains invalid characters"
				invalid-compare:	["cannot compare" :arg1 "with" :arg2]
				wrong-type:			["datatype assertion failed for:" :arg1]
				invalid-refine-arg: ["invalid" :arg1 "argument:" :arg2]
				type-limit:			[:arg1 "overflow/underflow"]
				size-limit:			["maximum limit reached:" :arg1]
				no-return:			"block did not return a value"
				throw-usage:		"invalid use of a thrown error value"
				;locked-word:		["protected variable - cannot modify:" :arg1]
				;protected:			"protected value or series - cannot modify"
				;self-protected:	"cannot set/unset self - it is protected"
				bad-bad:			[:arg1 "error:" :arg2]
				bad-make-arg:		["cannot MAKE" :arg1 "from:" :arg2]
                bad-to-arg:         ["cannot TO" :arg1 "from:" :arg2]
				invalid-spec-field: ["invalid" :arg1 "field in spec block"]
				missing-spec-field: [:arg1 "not found in spec block"]
				;bad-decode:		"missing or unsupported encoding marker"
				;already-used:		["alias word is already in use:" :arg1]
				;wrong-denom:		[:arg1 "not same denomination as" :arg2]
				;bad-press:			["invalid compressed data - problem:" :arg1]
				;dialect:			["incorrect" :arg1 "dialect usage at:" :arg2]
				parse-rule:			["PARSE - invalid rule or usage of rule:" :arg1]
				parse-end:			["PARSE - unexpected end of rule after:" :arg1]
				;parse-variable:	["PARSE - expected a variable, not:" :arg1]
				;parse-command:		"PARSE - command cannot be used as variable:" :arg1]
				parse-invalid-ref:	["PARSE - get-word refers to a different series!" :arg1]
				parse-series:		["PARSE - input must be a series:" :arg1]
				parse-unsupported:	"PARSE - matching by datatype not supported for any-string! input"
			]
			math: object [
				code:				400
				type:				"Math error"
				zero-divide:		"attempt to divide by zero"
				overflow:			"math or number overflow"
				positive:			"positive number required"
			]
			access: object [
				code:				500
				type:				"Access error"
				;cannot-open:		["cannot open:" :arg1 "reason:" :arg2]
				;not-open:			["port is not open:" :arg1]
				;already-open:		["port is already open:" :arg1]
				;no-connect:		["cannot connect:" :arg1 "reason:" :arg2]
				;not-connected:		["port is not connected:" :arg1]
				;no-script:			["script not found:" :arg1]
				;no-scheme-name:	["new scheme must have a name:" :arg1]
				;no-scheme:			["missing port scheme:" :arg1]
				;invalid-spec:		["invalid spec or options:" :arg1]
				;invalid-port:		["invalid port object (invalid field values)"]
				;invalid-actor:		["invalid port actor (must be native or object)"]
				;invalid-port-arg:	["invalid port argument:" arg1]
				;no-port-action:	["this port does not support:" :arg1]
				;protocol:			["protocol error:" :arg1]
				;invalid-check:		["invalid checksum (tampered file):" :arg1]
				;write-error:		["write failed:" :arg1 "reason:" :arg2]
				;read-error:		["read failed:" :arg1 "reason:" :arg2]
				;read-only:			["read-only - write not allowed:" :arg1]
				;no-buffer:			["port has no data buffer:" :arg1]
				;timeout:			["port action timed out:" :arg1]
				;no-create:			["cannot create:" :arg1]
				;no-delete:			["cannot delete:" :arg1]
				;no-rename:			["cannot rename:" :arg1]
				;bad-file-path:		["bad file path:" :arg1]
				;bad-file-mode:		["bad file mode:" :arg1]
				;security:			["security violation:" :arg1 " (refer to SECURE function)"]
				;security-level:	["attempt to lower security to" :arg1]
				;security-error:	["invalid" :arg1 "security policy:" :arg2]
				;no-codec:			["cannot decode or encode (no codec):" :arg1]
				;bad-media:			["bad media data (corrupt image, sound, video)"]
				;no-extension:		["cannot open extension:" :arg1]
				;bad-extension:		["invalid extension format:" :arg1]
				;extension-init:	["extension cannot be initialized (check version):" :arg1]
				;call-fail:			["external process failed:" :arg1]
			]
			user: object [
				code:				800
				type:				"User error"
				message:			[:arg1]
			]
			internal: object [
				code:				900
				type:				"Internal error"
				bad-path:			["bad path:" arg1]
				not-here:			[arg1 "not supported on your system"]
				no-memory:			"not enough memory"
				stack-overflow:		"stack overflow"
				;bad-series:		"invalid series"
				;limit-hit:			["internal limit reached:" :arg1]
				;bad-sys-func:		["invalid or missing system function:" :arg1]
				feature-na:			"feature not available"
				not-done:			"reserved for future use (or not yet implemented)"
				invalid-error:		"error object or fields were not valid"
			]
		]

	]

	state: context [
		interpreted?: func ["Return TRUE if called from the interpreter"][
			#system [logic/box stack/eval? null]
		]

		last-error: none
	]

	modules: make block! 8
	codecs:  context []
	schemes: context []
	ports:	 context []

	locale: context [
		language:
		language*:										;-- in locale language
		locale:
		locale*: none									;-- in locale language

		;collation: context [
		;	lower-to-upper: #system [stack/set-last as cell! case-folding/lower-to-upper]
		;	upper-to-lower: #system [stack/set-last as cell! case-folding/upper-to-lower]
		;]

		months: [
		  "January" "February" "March" "April" "May" "June"
		  "July" "August" "September" "October" "November" "December"
		]

		days: [
		  "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday" "Sunday"
		]
	]

	options: context [
		boot: 			none
		home: 			none
		path: 			none
		script: 		none
		args: 			none
		do-arg: 		none
		debug: 			none
		secure: 		none
		quiet: 			false
		binary-base: 	16
		decimal-digits: 15
		module-paths: 	make block! 1
		file-types: 	none

		;-- change the way float numbers are processed
		float: context [
			pretty?: false
			full?: 	 false

			on-change*: func [word old new][
				switch word [
					pretty? [
						either new [
							#system [float/pretty-print?: yes]
						][
							#system [float/pretty-print?: no]
						]
					]
					full? [
						either new [
							#system [float/full-support?: yes]
						][
							#system [float/full-support?: no]
						]
					]
				]
			]
		]
	]

	script: context [
		title: header: parent: path: args: none
	]

	standard: context [
		header: context [
			title: name: type: version: date: file: author: needs: none
		]
		error: context [
			code: type: id: arg1: arg2: arg3: near: where: stack: none
		]
	]

	view: context [
		screen: 	none
		event-port: none

		metrics: context [
			screen-size: 	none
			dpi:			none
			;scaling:		1x1
		]
	]

	lexer: none
	console: none
]


r342: reformatted letter from authors

r342: reformatted letter from authors

h1. Getting Started

*Dear build -monkey- -master- artist,*

We created CruiseControl.rb so that you can kick ass.

We want you to have basic continuous integration up and running 10 minutes after reading this page.
After that, we want you to find that the tool looks good, does what you expect, and basically just
works. Finally, when you need to do something unusual, we want you to be surprised by how easy that was, too.

In short, we want you to *love* CruiseControl.rb.

Very truly yours,

CruiseControl.rb team

ThoughtWorks

P.S. We also want to know if we somehow fall short of these goals.

h1. Basics

CruiseControl.rb has two parts: a builder and a dashboard.

*Builder* is a daemon process that polls source control every once in a while for new revisions.

When someone performs a check in, the builder:

# detects it
# updates its own copy of the project
# runs the build
# notifies interested parties about the build's outcome

*Dashboard* is a web application that helps to monitor the status of project builds and troubleshoot failures.

Each installation of CruiseControl.rb may have multiple projects and multiple builders (one per project). There may
also be multiple installations of CruiseControl.rb per computer.

h1. Prerequisites

* "Ruby":http://www.ruby-lang.org/en/ 1.8.4 or later
* "Subversion":http://subversion.tigris.org/ client 1.3.2 or later
* svn and ruby executables must both be in the PATH.

h1. Assumptions and limitations

* CruiseControl.rb currently only works with Subversion.
* Dashboard and all builders need to run on the same computer.

h1. Installation

Follow these directions or watch our "5 minute install":screencasts.html screencast.

1. "Download":download.html and unpack CruiseControl.rb

  p(def). (below, we will refer to the place where you unpack it as [cruise])

2. From [cruise], run ./cruise add your_project --url [URL of your_project Subversion trunk].

  p(def). Optionally, you can specify username and password by adding  --username [your_user] --password
    [your_password] to the command.

  p(def). This creates a directory for your_project's builds at
    [cruise]/builds/your_project/, and checks out your_project from subversion URL specified to
    [cruise]/builds/your_project/work/.

  p(def hint). Hint: Rakefile of your_project should be in [cruise]/builds/your_project/work/ directory, not anywhere under
    it. A common mistake is to specify in --url option the root of project's SVN repository instead of the trunk.
    Rakefile then ends up in [cruise]/builds/your_project/work/trunk/ and CruiseControl.rb does not see it there.

3. From [cruise], run ./cruise start.

  p(def hint). Hint: This starts cruise on port 3333, if you want to run your server on a different port, just type
    ./cruise start -p [port]

4. Browse to "http://localhost:3333":http://localhost:3333.

  p(def). All going well, weather permitting, you will see a page with CruiseControl.rb logo. This is the dashboard, and it
    should display your project.  If it's passing, you're done - though you should double check it's doing what it should be
    by clicking on the project name and looking at the build log for the last build.  If it's failing or otherwise misbehaving, go
    on to step 5.

5. Go to [cruise]/builds/your_project/work/ and make the build pass.

  p(def). For a regular Rails app, this involves creating a test database, editing database.yml to connect to that
    database, performing rake RAILS_ENV=test db:migrate, running rake test and making
    sure that it passes.

6. Press the "build now" button on the "Dashboard":http://localhost:3333 to rebuild your project

  p(def). This should build your_project and place build outputs into [cruise]/builds/your_project/build-[revision-number]/

  p(def hint). Hint: Monitor log/your_project_builder.log for any signs of trouble. Try to check in a change to
    your_project and see if the builder can detect and build it.  Check your_project status in the dashboard.

  p(def hint). Hint: ./cruise help displays a list of commands, ./cruise help [command]
    displays options available for each command.

Next step: read the "manual":manual.html


FIX: issue #720 (Compiling %console.red more than once does not work)

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

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! [[
		"(not yet implemented)"
		;"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! [[
		"(not yet implemented)"
		;"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! [[
		"(not yet implemented)"
		;"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! [[
		"(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~

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

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

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

comment: func [value][]

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

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
	return: [logic! block!]
][
	either case [
		parse/case/trace input rules :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:"
	/into "Put results in out block, instead of creating a new block"
		out [block!] "Target block for results"
][
	unless out [out: make block! 4]
	;switch type?/word [
	;	file!	[]
	;	url!	[]
	;	binary! []
	;]
	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

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

comment: func [value][]

;------------------------------------------
;-				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! [[
		"(not yet implemented)"
		;"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! [[
		"(not yet implemented)"
		;"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! [[
		"(not yet implemented)"
		;"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! [[
		"(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~

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

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

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

;-- `comment` defined as a function for the interpreter
do [set 'comment func [value][]]

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

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
	return: [logic! block!]
][
	either case [
		parse/case/trace input rules :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:"
	/into "Put results in out block, instead of creating a new block"
		out [block!] "Target block for results"
][
	unless out [out: make block! 4]
	;switch type?/word [
	;	file!	[]
	;	url!	[]
	;	binary! []
	;]
	transcode source out
	unless :all [if 1 = length? out [out: out/1]]
	out
]