FEAT: first usage of new internal 'fire function to replace old hard-wired error.

Red/System [
	Title:   "Red action functions"
	Author:  "Nenad Rakocevic"
	File: 	 %actions.reds
	Tabs:	 4
	Rights:  "Copyright (C) 2011-2012 Nenad Rakocevic. All rights reserved."
	License: {
		Distributed under the Boost Software License, Version 1.0.
		See https://github.com/dockimbel/Red/blob/master/BSL-License.txt
	}
]

actions: context [
	verbose: 0

	table: declare int-ptr!

	register: func [
		[variadic]
		count	[integer!]
		list	[int-ptr!]
		/local
			offset [integer!]
			index  [integer!]
	][
		offset: 0
		index:  1

		until [
			table/index: list/value
			index: index + 1
			list: list + 1
			count: count - 1
			zero? count
		]
		assert index = (ACTIONS_NB + 1)
	]

	get-action-ptr-from: func [
		type	[integer!]								;-- datatype ID
		action	[integer!]								;-- action ID
		return: [integer!]								;-- action pointer (datatype-dependent)
		/local
			index [integer!]
	][
		index: type << 8 + action
		index: action-table/index						;-- lookup action function pointer

		if zero? index [
			fire [
				TO_ERROR(script expect-arg)
				stack/get-call
				datatype/push type
				none-value								;@@ placeholder for now
			]
		]
		index
	]

	;@@ temporary stack-oriented version kept until internal API fully changed
	get-action-ptr*: func [
		action	[integer!]								;-- action ID
		return: [integer!]								;-- action pointer (datatype-dependent)
		/local
			arg  [red-value!]
	][
		arg: stack/arguments
		get-action-ptr-from TYPE_OF(arg) action
	]

	get-action-ptr: func [
		value	[red-value!]							;-- any-type! value
		action	[integer!]								;-- action ID
		return: [integer!]								;-- action pointer (datatype-dependent)
	][
		get-action-ptr-from TYPE_OF(value) action
	]

	get-index-argument: func [
		return:	 [integer!]
		/local
			arg  [red-value!]
			int  [red-integer!]
			char [red-char!]
			bool [red-logic!]
	][
		arg: stack/arguments + 1
		switch TYPE_OF(arg) [
			TYPE_INTEGER [int:  as red-integer! arg int/value]
			TYPE_CHAR 	 [char: as red-char! 	arg char/value]
			TYPE_LOGIC	 [bool: as red-logic! 	arg 2 - as-integer bool/value]
			default		 [0]
		]
	]

	;--- Actions polymorphic calls ---

	make*: func [
		return:	 [red-value!]
	][
		stack/set-last make stack/arguments stack/arguments + 1
	]

	make: func [
		proto 	 [red-value!]
		spec	 [red-value!]
		return:	 [red-value!]
		/local
			dt	 [red-datatype!]
			int  [red-integer!]
			type [integer!]
			action-make
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/make"]]

		type: TYPE_OF(proto)
		if type = TYPE_DATATYPE [
			dt: as red-datatype! proto
			type: dt/value
		]

		action-make: as function! [
			proto 	 [red-value!]
			spec	 [red-value!]
			return:	 [red-value!]						;-- newly created value
		] get-action-ptr-from type ACT_MAKE

		action-make proto spec
	]

	random*: func [
		seed	[integer!]
		secure	[integer!]
		only	[integer!]
		return:	[red-value!]
	][
		random
			as red-value! stack/arguments
			as logic! seed + 1
			as logic! secure + 1
			as logic! only + 1
	]

	random: func [
		value   [red-value!]
		seed?	[logic!]
		secure? [logic!]
		only?	[logic!]
		return: [red-value!]
		/local
			action-random
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/random"]]

		action-random: as function! [
			value	[red-value!]
			seed?	[logic!]
			secure? [logic!]
			only?	[logic!]
			return: [red-value!]
		] get-action-ptr value ACT_RANDOM

		action-random value seed? secure? only?
	]

	reflect*: func [
		return: [red-block!]
	][
		reflect stack/arguments as red-word! stack/arguments + 1
	]

	reflect: func [
		value	[red-value!]
		field	[red-word!]
		return: [red-block!]
		/local
			action-reflect
	][
		action-reflect: as function! [
			value	[red-value!]
			field	[integer!]
			return:	[red-block!]
		] get-action-ptr-from TYPE_OF(value) ACT_REFLECT

		action-reflect value field/symbol
	]

	to*: func [
		return: [red-value!]
	][
		to as red-datatype! stack/arguments stack/arguments + 1
	]

	to: func [
		type	[red-datatype!]
		spec	[red-value!]
		return: [red-value!]
		/local
			action-to
	][
		if TYPE_OF(spec) = type/value [return stack/set-last spec]

		action-to: as function! [
			type	[red-datatype!]
			spec	[red-value!]
			return: [red-value!]
		] get-action-ptr-from TYPE_OF(spec) ACT_TO

		action-to type spec
	]

	form*: func [
		part	   [integer!]
		/local
			arg	   [red-value!]
			buffer [red-string!]
			int    [red-integer!]
			limit  [integer!]
	][
		arg: stack/arguments + part

		limit: either part >= 0 [
			int: as red-integer! arg
			int/value
		][0]

		stack/keep										;-- keep last value
		buffer: string/rs-make-at stack/push* 16		;@@ /part argument
		limit: form stack/arguments buffer arg limit

		if all [part >= 0 negative? limit][
			string/truncate-from-tail GET_BUFFER(buffer) limit
		]
		stack/set-last as red-value! buffer
	]

	form: func [
		value   [red-value!]							;-- FORM argument
		buffer  [red-string!]							;-- FORM buffer
		arg		[red-value!]							;-- max bytes count
		part	[integer!]
		return: [integer!]
		/local
			action-form
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/form"]]

		action-form: as function! [
			value	[red-value!]						;-- FORM argument
			buffer	[red-string!]						;-- FORM buffer
			arg		[red-value!]						;-- max bytes count
			part	[integer!]
			return: [integer!]							;-- remaining part count
		] get-action-ptr value ACT_FORM

		action-form value buffer arg part
	]

	mold*: func [
		only	[integer!]
		_all	[integer!]
		flat	[integer!]
		part	[integer!]
		/local
			arg	   [red-value!]
			buffer [red-string!]
			int    [red-integer!]
			limit  [integer!]
	][
		arg: stack/arguments + part

		limit: either part >= 0 [
			int: as red-integer! arg
			int/value
		][0]

		stack/keep										;-- keep last value
		buffer: string/rs-make-at stack/push* 16		;@@ /part argument
		limit: mold
			stack/arguments
			buffer
			as logic! only + 1
			as logic! _all + 1
			as logic! flat + 1
			arg
			limit
			0

		if all [part >= 0 negative? limit][
			string/truncate-from-tail GET_BUFFER(buffer) limit
		]
		stack/set-last as red-value! buffer
	]

	mold: func [
		value    [red-value!]							;-- MOLD argument
		buffer   [red-string!]							;-- MOLD buffer
		only?	 [logic!]
		all?	 [logic!]
		flat?	 [logic!]
		arg		 [red-value!]
		part     [integer!]								;-- max bytes count
		indent	 [integer!]
		return:  [integer!]
		/local
			action-mold
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/mold"]]

		action-mold: as function! [
			value	 [red-value!]						;-- FORM argument
			buffer	 [red-string!]						;-- FORM buffer
			only?	 [logic!]
			all?	 [logic!]
			flat?	 [logic!]
			part-arg [red-value!]
			part	 [integer!]							;-- max bytes count
			indent	 [integer!]
			return:  [integer!]							;-- remaining part count
		] get-action-ptr value ACT_MOLD

		action-mold value buffer only? all? flat? arg part indent
	]

	eval-path*: func [
		set?	[logic!]
		return:	[red-value!]
		/local
			value [red-value!]
	][
		value: either set? [stack/arguments + 2][null]
		stack/set-last eval-path
			stack/arguments
			stack/arguments + 1
			value
	]

	eval-path: func [
		parent	[red-value!]
		element	[red-value!]
		value	[red-value!]
		return:	[red-value!]
		/local
			action-path
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/eval-path"]]

		action-path: as function! [
			parent	[red-value!]
			element	[red-value!]
			value	[red-value!]
			return:	[red-value!]
		] get-action-ptr parent ACT_EVALPATH

		action-path parent element value
	]

	set-path*: func [][]

	compare*: func [
		op		[comparison-op!]
		return: [red-logic!]
		/local
			result [red-logic!]
	][
		result: as red-logic! stack/arguments
		result/value: compare stack/arguments stack/arguments + 1 op
		result/header: TYPE_LOGIC
		result
	]

	compare: func [
		value1  [red-value!]
		value2  [red-value!]
		op	    [comparison-op!]
		return: [logic!]
		/local
			action-compare value res
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/compare"]]

		action-compare: as function! [
			value1  [red-value!]						;-- first operand
			value2  [red-value!]						;-- second operand
			op	    [integer!]							;-- type of comparison
			return: [integer!]
		] get-action-ptr value1 ACT_COMPARE

		value: action-compare value1 value2 op
		if value = -2 [
			switch op [
				COMP_EQUAL
				COMP_STRICT_EQUAL [value]
				COMP_NOT_EQUAL 	  [value: 0]
				default [
					--NOT_IMPLEMENTED--					;@@ add error handling
					value
				]
			]
		]
		switch op [
			COMP_EQUAL
			COMP_STRICT_EQUAL 	[res: value = 0]
			COMP_NOT_EQUAL 		[res: value <> 0]
			COMP_LESSER			[res: value < 0]
			COMP_LESSER_EQUAL	[res: value <= 0]
			COMP_GREATER		[res: value > 0]
			COMP_GREATER_EQUAL	[res: value >= 0]
		]
		res
	]

	compare-value: func [								;-- Compare function return integer!
		value1  [red-value!]
		value2  [red-value!]
		op		[comparison-op!]
		return: [integer!]
		/local
			action-compare res
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/compare-value"]]

		action-compare: as function! [
			value1  [red-value!]						;-- first operand
			value2  [red-value!]						;-- second operand
			op	    [integer!]							;-- type of comparison
			return: [integer!]
		] get-action-ptr value1 ACT_COMPARE

		switch TYPE_OF(value1) [
			TYPE_LOGIC	 [res: value1/data1 - value2/data1]
			TYPE_NATIVE
			TYPE_ACTION
			TYPE_FUNCTION
			TYPE_OP
			TYPE_ROUTINE [res: SIGN_COMPARE_RESULT(value1/data3 value2/data3)]
			TYPE_NONE
			TYPE_UNSET	 [res: 0]
			default		 [res: action-compare value1 value2 op]
		]
		res
	]

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

		action-absolute: as function! [
			return:	[red-value!]						;-- absoluted value
		] get-action-ptr* ACT_ABSOLUTE
		action-absolute
	]

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

		action-add: as function! [
			return:	[red-value!]						;-- addition resulting value
		] get-action-ptr* ACT_ADD
		action-add
	]

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

		action-divide: as function! [
			return:	[red-value!]						;-- division resulting value
		] get-action-ptr* ACT_DIVIDE
		action-divide
	]

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

		action-multiply: as function! [
			return:	[red-value!]						;-- multiplication resulting value
		] get-action-ptr* ACT_MULTIPLY
		action-multiply
	]

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

		negate-action stack/arguments
	]

	negate-action: func [								;-- negate is a Red/System keyword
		value	[red-value!]
		return:	[red-value!]
		/local
			action-negate
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/negate"]]

		action-negate: as function! [
			value	[red-value!]
			return:	[red-value!]						;-- negated value
		] get-action-ptr value ACT_NEGATE

		action-negate value
	]

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

		action-power: as function! [
			return:	[red-value!]						;-- addition resulting value
		] get-action-ptr* ACT_POWER
		action-power
	]

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

		action-remainder: as function! [
			return:	  [red-value!]
		] get-action-ptr* ACT_REMAINDER
		action-remainder
	]

	round*: func [
		_to		  [integer!]
		even	  [integer!]
		down	  [integer!]
		half-down [integer!]
		floor	  [integer!]
		ceil	  [integer!]
		half-ceil [integer!]
		/local
			scale [red-value!]
	][
		scale: stack/arguments + _to
		round
			stack/arguments
			scale
			as logic! even	+ 1
			as logic! down	+ 1
			as logic! half-down + 1
			as logic! floor + 1
			as logic! ceil  + 1
			as logic! half-ceil + 1
	]

	round: func [
		value		[red-value!]
		scale		[red-value!]
		_even?		[logic!]
		down?		[logic!]
		half-down?	[logic!]
		floor?		[logic!]
		ceil?		[logic!]
		half-ceil?	[logic!]
		return:		[red-value!]
		/local
			action-round
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/round"]]

		action-round: as function! [
			value		[red-value!]
			scale		[red-value!]
			_even?		[logic!]
			down?		[logic!]
			half-down?	[logic!]
			floor?		[logic!]
			ceil?		[logic!]
			half-ceil?	[logic!]
			return:		[red-value!]
		] get-action-ptr value ACT_ROUND

		action-round value scale _even? down? half-down? floor? ceil? half-ceil?
	]

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

		action-subtract: as function! [
			return:	[red-value!]						;-- addition resulting value
		] get-action-ptr* ACT_SUBTRACT
		action-subtract
	]

	even?*: func [
		return:	[red-logic!]
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/even?"]]

		logic/box even? stack/arguments
	]

	even?: func [
		value	[red-value!]
		return: [logic!]
		/local
			action-even?
	][
		action-even?: as function! [
			value	[red-value!]
			return: [logic!]							;-- TRUE if value is even.
		] get-action-ptr value ACT_EVEN?

		action-even? value
	]

	odd?*: func [
		return:	[red-logic!]
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/odd?"]]

		logic/box odd? stack/arguments
	]

	odd?: func [
		value	[red-value!]
		return: [logic!]
		/local
			action-odd?
	][
		action-odd?: as function! [
			value	[red-value!]
			return: [logic!]							;-- TRUE if value is odd.
		] get-action-ptr value ACT_ODD?

		action-odd? value
	]

	and~*: func [
		return:	[red-value!]
		/local
			action-and~
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/and~"]]

		action-and~: as function! [
			return:	[red-value!]						;-- division resulting value
		] get-action-ptr* ACT_AND~
		action-and~
	]

	complement*: does [
		stack/set-last complement stack/arguments
	]

	complement: func [
		value	[red-value!]
		return:	[red-value!]
		/local
			action-complement
	][
		action-complement: as function! [
			value	[red-value!]
			return:	[red-value!]						;-- complemented value
		] get-action-ptr value ACT_COMPLEMENT

		action-complement value
	]

	or~*: func [
		return:	[red-value!]
		/local
			action-or~
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/or~"]]

		action-or~: as function! [
			return:	[red-value!]						;-- division resulting value
		] get-action-ptr* ACT_OR~
		action-or~
	]

	xor~*: func [
		return:	[red-value!]
		/local
			action-xor~
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/xor~"]]

		action-xor~: as function! [
			return:	[red-value!]						;-- division resulting value
		] get-action-ptr* ACT_XOR~
		action-xor~
	]

	append*: func [
		part  [integer!]
		only  [integer!]
		dup   [integer!]
	][
		; assert ANY-SERIES?(TYPE_OF(stack/arguments))
		insert
			as red-series! stack/arguments
			stack/arguments + 1
			stack/arguments + part
			as logic! only + 1
			stack/arguments + dup
			yes
	]

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

		action-at: as function! [
			return:	[red-value!]						;-- picked value from series
		] get-action-ptr* ACT_AT
		action-at
	]

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

		action-back: as function! [
			return:	[red-value!]						;-- picked value from series
		] get-action-ptr* ACT_BACK
		action-back
	]

	change*: func [][]

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

	clear: func [
		value	[red-value!]
		return:	[red-value!]
		/local
			action-clear
	][
		action-clear: as function! [
			value	[red-value!]
			return:	[red-value!]						;-- argument series
		] get-action-ptr value ACT_CLEAR

		action-clear value
	]

	copy*: func [
		part	[integer!]
		deep	[integer!]
		types	[integer!]
		return:	[red-value!]
	][
		stack/set-last copy
			as red-series! stack/arguments
			stack/push*
			stack/arguments + part
			as logic! deep + 1
			stack/arguments + types
	]

	copy: func [
		series  [red-series!]
		new		[red-value!]
		part	[red-value!]
		deep?	[logic!]
		types	[red-value!]
		return:	[red-value!]
		/local
			action-copy
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/copy"]]

		new/header: series/header

		action-copy: as function! [
			series  [red-series!]
			new		[red-value!]
			part	[red-value!]
			deep?	[logic!]
			types	[red-value!]
			return: [red-series!]
		] get-action-ptr as red-value! series ACT_COPY

		action-copy series new part deep? types
		new
	]

	find*: func [
		part	 [integer!]
		only	 [integer!]
		case-arg [integer!]
		any-arg  [integer!]
		with-arg [integer!]
		skip	 [integer!]
		last	 [integer!]
		reverse	 [integer!]
		tail	 [integer!]
		match	 [integer!]
	][
		; assert ANY-SERIES?(TYPE_OF(stack/arguments))
		stack/set-last find
			as red-series! stack/arguments
			stack/arguments + 1
			stack/arguments + part
			as logic! only + 1
			as logic! case-arg + 1
			as logic! any-arg + 1
			as red-string!  stack/arguments + with-arg
			as red-integer! stack/arguments + skip
			as logic! last + 1
			as logic! reverse + 1
			as logic! tail + 1
			as logic! match + 1
	]

	find: func [
		series   [red-series!]
		value    [red-value!]
		part	 [red-value!]
		only?	 [logic!]
		case?	 [logic!]
		any?	 [logic!]
		with-arg [red-string!]
		skip	 [red-integer!]
		last?	 [logic!]
		reverse? [logic!]
		tail?	 [logic!]
		match?	 [logic!]
		return:  [red-value!]
		/local
			action-find
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/find"]]

		action-find: as function! [
			series   [red-series!]
			value    [red-value!]
			part	 [red-value!]
			only?	 [logic!]
			case?	 [logic!]
			any?	 [logic!]
			with-arg [red-string!]
			skip	 [red-integer!]
			last?	 [logic!]
			reverse? [logic!]
			tail?	 [logic!]
			match?	 [logic!]
			return:  [red-value!]
		] get-action-ptr as red-value! series ACT_FIND

		action-find series value part only? case? any? with-arg skip last? reverse? tail? match?
	]

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

		action-head: as function! [
			return:	[red-value!]						;-- picked value from series
		] get-action-ptr* ACT_HEAD
		action-head
	]

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

		action-head?: as function! [
			return:	[red-value!]						;-- picked value from series
		] get-action-ptr* ACT_HEAD?
		action-head?
	]

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

		action-index?: as function! [
			return:	[red-value!]						;-- picked value from series
		] get-action-ptr* ACT_INDEX?
		action-index?
	]

	insert*: func [
		part  [integer!]
		only  [integer!]
		dup   [integer!]
	][
		; assert ANY-SERIES?(TYPE_OF(stack/arguments))
		insert
			as red-series! stack/arguments
			stack/arguments + 1
			stack/arguments + part
			as logic! only + 1
			stack/arguments + dup
			no
	]

	insert: func [
		series  [red-series!]
		value   [red-value!]
		part	[red-value!]
		only?	[logic!]
		dup		[red-value!]
		append? [logic!]
		return:	[red-value!]
		/local
			action-insert
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/insert"]]

		action-insert: as function! [
			series  [red-series!]
			value   [red-value!]
			part	[red-value!]
			only?	[logic!]
			dup		[red-value!]
			append? [logic!]
			return:	[red-value!]						;-- series after insertion position
		] get-action-ptr as red-value! series ACT_INSERT

		action-insert series value part only? dup append?
	]

	length?*: func [
		return:	[red-integer!]
		/local
			int	  [red-integer!]
			value [integer!]
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/length?"]]

		int: as red-integer! stack/arguments
		value: length? stack/arguments					;-- must be set before slot is modified
		either value = -1 [
			none/push-last
		][
			int/value:  value
			int/header: TYPE_INTEGER
		]
		int
	]

	length?: func [
		value	[red-value!]
		return: [integer!]
		/local
			action-length?
	][
		action-length?: as function! [
			value	[red-value!]
			return:	[integer!]							;-- length of series
		] get-action-ptr value ACT_LENGTH?

		action-length? value
	]

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

		action-next: as function! [
			return:	[red-value!]						;-- next value from series
		] get-action-ptr* ACT_NEXT
		action-next
	]

	pick*: func [
		return:	 [red-value!]
	][
		stack/set-last pick
			as red-series! stack/arguments
			get-index-argument
			stack/arguments + 1
	]

	pick: func [
		series	[red-series!]
		index	[integer!]
		boxed	[red-value!]							;-- boxed index value
		return:	[red-value!]
		/local
			action-pick
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/pick"]]

		action-pick: as function! [
			series	[red-series!]
			index	[integer!]
			boxed	[red-value!]						;-- boxed index value
			return:	[red-value!]						;-- picked value from series
		] get-action-ptr as red-value! series ACT_PICK

		action-pick series index boxed
	]

	poke*: func [
		return:	[red-value!]
	][
		poke
			as red-series! stack/arguments
			get-index-argument
			stack/arguments + 2
			stack/arguments + 1

		stack/set-last stack/arguments
	]

	poke: func [
		series	[red-series!]
		index	[integer!]								;-- unboxed value
		data	[red-value!]
		boxed	[red-value!]							;-- boxed index value
		/local
			action-poke
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/poke"]]

		action-poke: as function! [
			series	[red-series!]
			index	[integer!]
			data	[red-value!]
			boxed	[red-value!]
			return:	[red-value!]						;-- picked value from series
		] get-action-ptr as red-value! series ACT_POKE

		action-poke series index data boxed
	]

	remove*: func [
		part [integer!]
	][
		remove
			as red-series! stack/arguments
			stack/arguments + part
	]

	remove: func [
		series  [red-series!]
		part	[red-value!]
		return:	[red-value!]
		/local
			action-remove
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/remove"]]

		action-remove: as function! [
			series	[red-series!]
			part	[red-value!]
			return:	[red-value!]
		] get-action-ptr as red-value! series ACT_REMOVE

		action-remove series part
	]

	reverse*: func [
		part [integer!]
	][
		reverse
			as red-series! stack/arguments
			stack/arguments + part
	]

	reverse: func [
		series  [red-series!]
		part	[red-value!]
		return:	[red-value!]
		/local
			action-reverse
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/reverse"]]

		action-reverse: as function! [
			series	[red-series!]
			part	[red-value!]
			return:	[red-value!]
		] get-action-ptr as red-value! series ACT_REVERSE

		action-reverse series part
	]

	select*: func [
		part	 [integer!]
		only	 [integer!]
		case-arg [integer!]
		any-arg  [integer!]
		with-arg [integer!]
		skip	 [integer!]
		last	 [integer!]
		reverse	 [integer!]
	][
		; assert ANY-SERIES?(TYPE_OF(stack/arguments))
		stack/set-last select
			as red-series! stack/arguments
			stack/arguments + 1
			stack/arguments + part
			as logic! only + 1
			as logic! case-arg + 1
			as logic! any-arg + 1
			as red-string!  stack/arguments + with-arg
			as red-integer! stack/arguments + skip
			as logic! last + 1
			as logic! reverse + 1
	]

	select: func [
		series   [red-series!]
		value    [red-value!]
		part	 [red-value!]
		only?	 [logic!]
		case?	 [logic!]
		any?	 [logic!]
		with-arg [red-string!]
		skip	 [red-integer!]
		last?	 [logic!]
		reverse? [logic!]
		return:  [red-value!]
		/local
			action-select
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/select"]]

		action-select: as function! [
			series   [red-series!]
			value    [red-value!]
			part	 [red-value!]
			only?	 [logic!]
			case?	 [logic!]
			any?	 [logic!]
			with-arg [red-string!]
			skip	 [red-integer!]
			last?	 [logic!]
			reverse? [logic!]
			return:  [red-value!]
		] get-action-ptr as red-value! series ACT_SELECT

		action-select series value part only? case? any? with-arg skip last? reverse?
	]

	sort*: func [
		case-arg [integer!]
		skip-arg [integer!]
		compare  [integer!]
		part	 [integer!]
		all-arg  [integer!]
		reverse	 [integer!]
	][
		; assert ANY-SERIES?(TYPE_OF(stack/arguments))
		stack/set-last sort
			as red-series!   stack/arguments
			as logic!		 case-arg + 1
			as red-integer!  stack/arguments + skip-arg
			as red-function! stack/arguments + compare
			stack/arguments + part
			as logic! all-arg + 1
			as logic! reverse + 1
	]

	sort: func [
		series   [red-series!]
		case?    [logic!]
		skip	 [red-integer!]
		compare	 [red-function!]
		part	 [red-value!]
		all?	 [logic!]
		reverse? [logic!]
		return:  [red-value!]
		/local
			action-sort
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/sort"]]

		action-sort: as function! [
			series   [red-series!]
			case?    [logic!]
			skip	 [red-integer!]
			compare	 [red-function!]
			part	 [red-value!]
			all?	 [logic!]
			reverse? [logic!]
			return:  [red-value!]
		] get-action-ptr as red-value! series ACT_SORT

		action-sort series case? skip compare part all? reverse?
	]

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

		action-skip: as function! [
			return:	[red-value!]						;-- picked value from series
		] get-action-ptr* ACT_SKIP
		action-skip
	]

	swap*: func [
		return: [red-series!]
	][
		swap
			as red-series! stack/arguments
			as red-series! stack/arguments + 1
	]

	swap: func [
		series1 [red-series!]
		series2	[red-series!]
		return:	[red-series!]
		/local
			action-swap
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/swap"]]

		action-swap: as function! [
			series1	[red-series!]
			series2	[red-series!]
			return:	[red-series!]
		] get-action-ptr as red-value! series1 ACT_SWAP

		action-swap series1 series2
	]

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

		action-tail: as function! [
			return:	[red-value!]						;-- picked value from series
		] get-action-ptr* ACT_TAIL
		action-tail
	]

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

		action-tail?: as function! [
			return:	[red-value!]						;-- picked value from series
		] get-action-ptr* ACT_TAIL?
		action-tail?
	]

	take*: func [
		part	[integer!]
		deep	[integer!]
		last	[integer!]
		return:	[red-value!]
	][
		stack/set-last take
			as red-series! stack/arguments
			stack/arguments + part
			as logic! deep + 1
			as logic! last + 1
	]

	take: func [
		series  [red-series!]
		part	[red-value!]
		deep?	[logic!]
		last?	[logic!]
		return:	[red-value!]
		/local
			action-take
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/take"]]

		action-take: as function! [
			series  [red-series!]
			part	[red-value!]
			deep?	[logic!]
			last?	[logic!]
			return: [red-value!]
		] get-action-ptr as red-value! series ACT_TAKE

		action-take series part deep? last?
	]

	trim*: func [
		head	[integer!]
		tail	[integer!]
		auto	[integer!]
		lines	[integer!]
		_all	[integer!]
		with-arg [integer!]
		return:	[red-series!]
	][
		trim
			as red-series! stack/arguments
			as logic! head  + 1
			as logic! tail  + 1
			as logic! auto  + 1
			as logic! lines + 1
			as logic! _all  + 1
			stack/arguments + with-arg
	]

	trim: func [
		series  [red-series!]
		head?	[logic!]
		tail?	[logic!]
		auto?	[logic!]
		lines?	[logic!]
		all?	[logic!]
		with-arg [red-value!]
		return:	[red-series!]
		/local
			action-trim
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/trim"]]

		action-trim: as function! [
			series  [red-series!]
			head?	[logic!]
			tail?	[logic!]
			auto?	[logic!]
			lines?	[logic!]
			all?	[logic!]
			with-arg [red-value!]
			return:	[red-series!]
		] get-action-ptr as red-value! series ACT_TRIM

		action-trim series head? tail? auto? lines? all? with-arg
	]

	create*: func [][]
	close*: func [][]
	delete*: func [][]
	modify*: func [][]
	open*: func [][]
	open?*: func [][]
	query*: func [][]
	read*: func [][]
	rename*: func [][]
	update*: func [][]
	write*: func [][]

	init: does [
		table: as int-ptr! allocate ACTIONS_NB * size? integer!

		register [
			;-- General actions --
			:make*
			:random*
			:reflect*
			:to*
			:form*
			:mold*
			:eval-path*
			null			;set-path
			:compare
			;-- Scalar actions --
			:absolute*
			:add*
			:divide*
			:multiply*
			:negate*
			:power*
			:remainder*
			:round*
			:subtract*
			:even?*
			:odd?*
			;-- Bitwise actions --
			:and~*
			:complement*
			:or~*
			:xor~*
			;-- Series actions --
			:append*
			:at*
			:back*
			null			;change
			:clear*
			:copy*
			:find*
			:head*
			:head?*
			:index?*
			:insert*
			:length?*
			:next*
			:pick*
			:poke*
			:remove*
			:reverse*
			:select*
			:sort*
			:skip*
			:swap*
			:tail*
			:tail?*
			:take*
			:trim*
			;-- I/O actions --
			null			;create
			null			;close
			null			;delete
			null			;modify
			null			;open
			null			;open?
			null			;query
			null			;read
			null			;rename
			null			;update
			null			;write
		]
	]
]

Red/System [
	Title:   "Red action functions"
	Author:  "Nenad Rakocevic"
	File: 	 %actions.reds
	Tabs:	 4
	Rights:  "Copyright (C) 2011-2012 Nenad Rakocevic. All rights reserved."
	License: {
		Distributed under the Boost Software License, Version 1.0.
		See https://github.com/dockimbel/Red/blob/master/BSL-License.txt
	}
]

actions: context [
	verbose: 0

	table: declare int-ptr!

	register: func [
		[variadic]
		count	[integer!]
		list	[int-ptr!]
		/local
			offset [integer!]
			index  [integer!]
	][
		offset: 0
		index:  1

		until [
			table/index: list/value
			index: index + 1
			list: list + 1
			count: count - 1
			zero? count
		]
		assert index = (ACTIONS_NB + 1)
	]

	get-action-ptr-from: func [
		type	[integer!]								;-- datatype ID
		action	[integer!]								;-- action ID
		return: [integer!]								;-- action pointer (datatype-dependent)
		/local
			index [integer!]
	][
		index: type << 8 + action
		index: action-table/index						;-- lookup action function pointer

		if zero? index [
			print-line [
				"^/*** Script error: action " action
				" not defined for type: " type
			]
			halt
		]
		index
	]

	;@@ temporary stack-oriented version kept until internal API fully changed
	get-action-ptr*: func [
		action	[integer!]								;-- action ID
		return: [integer!]								;-- action pointer (datatype-dependent)
		/local
			arg  [red-value!]
	][
		arg: stack/arguments
		get-action-ptr-from TYPE_OF(arg) action
	]

	get-action-ptr: func [
		value	[red-value!]							;-- any-type! value
		action	[integer!]								;-- action ID
		return: [integer!]								;-- action pointer (datatype-dependent)
	][
		get-action-ptr-from TYPE_OF(value) action
	]

	get-index-argument: func [
		return:	 [integer!]
		/local
			arg  [red-value!]
			int  [red-integer!]
			char [red-char!]
			bool [red-logic!]
	][
		arg: stack/arguments + 1
		switch TYPE_OF(arg) [
			TYPE_INTEGER [int:  as red-integer! arg int/value]
			TYPE_CHAR 	 [char: as red-char! 	arg char/value]
			TYPE_LOGIC	 [bool: as red-logic! 	arg 2 - as-integer bool/value]
			default		 [0]
		]
	]

	;--- Actions polymorphic calls ---

	make*: func [
		return:	 [red-value!]
	][
		stack/set-last make stack/arguments stack/arguments + 1
	]

	make: func [
		proto 	 [red-value!]
		spec	 [red-value!]
		return:	 [red-value!]
		/local
			dt	 [red-datatype!]
			int  [red-integer!]
			type [integer!]
			action-make
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/make"]]

		type: TYPE_OF(proto)
		if type = TYPE_DATATYPE [
			dt: as red-datatype! proto
			type: dt/value
		]

		action-make: as function! [
			proto 	 [red-value!]
			spec	 [red-value!]
			return:	 [red-value!]						;-- newly created value
		] get-action-ptr-from type ACT_MAKE

		action-make proto spec
	]

	random*: func [
		seed	[integer!]
		secure	[integer!]
		only	[integer!]
		return:	[red-value!]
	][
		random
			as red-value! stack/arguments
			as logic! seed + 1
			as logic! secure + 1
			as logic! only + 1
	]

	random: func [
		value   [red-value!]
		seed?	[logic!]
		secure? [logic!]
		only?	[logic!]
		return: [red-value!]
		/local
			action-random
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/random"]]

		action-random: as function! [
			value	[red-value!]
			seed?	[logic!]
			secure? [logic!]
			only?	[logic!]
			return: [red-value!]
		] get-action-ptr value ACT_RANDOM

		action-random value seed? secure? only?
	]

	reflect*: func [
		return: [red-block!]
	][
		reflect stack/arguments as red-word! stack/arguments + 1
	]

	reflect: func [
		value	[red-value!]
		field	[red-word!]
		return: [red-block!]
		/local
			action-reflect
	][
		action-reflect: as function! [
			value	[red-value!]
			field	[integer!]
			return:	[red-block!]
		] get-action-ptr-from TYPE_OF(value) ACT_REFLECT

		action-reflect value field/symbol
	]

	to*: func [
		return: [red-value!]
	][
		to as red-datatype! stack/arguments stack/arguments + 1
	]

	to: func [
		type	[red-datatype!]
		spec	[red-value!]
		return: [red-value!]
		/local
			action-to
	][
		if TYPE_OF(spec) = type/value [return stack/set-last spec]

		action-to: as function! [
			type	[red-datatype!]
			spec	[red-value!]
			return: [red-value!]
		] get-action-ptr-from TYPE_OF(spec) ACT_TO

		action-to type spec
	]

	form*: func [
		part	   [integer!]
		/local
			arg	   [red-value!]
			buffer [red-string!]
			int    [red-integer!]
			limit  [integer!]
	][
		arg: stack/arguments + part

		limit: either part >= 0 [
			int: as red-integer! arg
			int/value
		][0]

		stack/keep										;-- keep last value
		buffer: string/rs-make-at stack/push* 16		;@@ /part argument
		limit: form stack/arguments buffer arg limit

		if all [part >= 0 negative? limit][
			string/truncate-from-tail GET_BUFFER(buffer) limit
		]
		stack/set-last as red-value! buffer
	]

	form: func [
		value   [red-value!]							;-- FORM argument
		buffer  [red-string!]							;-- FORM buffer
		arg		[red-value!]							;-- max bytes count
		part	[integer!]
		return: [integer!]
		/local
			action-form
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/form"]]

		action-form: as function! [
			value	[red-value!]						;-- FORM argument
			buffer	[red-string!]						;-- FORM buffer
			arg		[red-value!]						;-- max bytes count
			part	[integer!]
			return: [integer!]							;-- remaining part count
		] get-action-ptr value ACT_FORM

		action-form value buffer arg part
	]

	mold*: func [
		only	[integer!]
		_all	[integer!]
		flat	[integer!]
		part	[integer!]
		/local
			arg	   [red-value!]
			buffer [red-string!]
			int    [red-integer!]
			limit  [integer!]
	][
		arg: stack/arguments + part

		limit: either part >= 0 [
			int: as red-integer! arg
			int/value
		][0]

		stack/keep										;-- keep last value
		buffer: string/rs-make-at stack/push* 16		;@@ /part argument
		limit: mold
			stack/arguments
			buffer
			as logic! only + 1
			as logic! _all + 1
			as logic! flat + 1
			arg
			limit
			0

		if all [part >= 0 negative? limit][
			string/truncate-from-tail GET_BUFFER(buffer) limit
		]
		stack/set-last as red-value! buffer
	]

	mold: func [
		value    [red-value!]							;-- MOLD argument
		buffer   [red-string!]							;-- MOLD buffer
		only?	 [logic!]
		all?	 [logic!]
		flat?	 [logic!]
		arg		 [red-value!]
		part     [integer!]								;-- max bytes count
		indent	 [integer!]
		return:  [integer!]
		/local
			action-mold
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/mold"]]

		action-mold: as function! [
			value	 [red-value!]						;-- FORM argument
			buffer	 [red-string!]						;-- FORM buffer
			only?	 [logic!]
			all?	 [logic!]
			flat?	 [logic!]
			part-arg [red-value!]
			part	 [integer!]							;-- max bytes count
			indent	 [integer!]
			return:  [integer!]							;-- remaining part count
		] get-action-ptr value ACT_MOLD

		action-mold value buffer only? all? flat? arg part indent
	]

	eval-path*: func [
		set?	[logic!]
		return:	[red-value!]
		/local
			value [red-value!]
	][
		value: either set? [stack/arguments + 2][null]
		stack/set-last eval-path
			stack/arguments
			stack/arguments + 1
			value
	]

	eval-path: func [
		parent	[red-value!]
		element	[red-value!]
		value	[red-value!]
		return:	[red-value!]
		/local
			action-path
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/eval-path"]]

		action-path: as function! [
			parent	[red-value!]
			element	[red-value!]
			value	[red-value!]
			return:	[red-value!]
		] get-action-ptr parent ACT_EVALPATH

		action-path parent element value
	]

	set-path*: func [][]

	compare*: func [
		op		[comparison-op!]
		return: [red-logic!]
		/local
			result [red-logic!]
	][
		result: as red-logic! stack/arguments
		result/value: compare stack/arguments stack/arguments + 1 op
		result/header: TYPE_LOGIC
		result
	]

	compare: func [
		value1  [red-value!]
		value2  [red-value!]
		op	    [comparison-op!]
		return: [logic!]
		/local
			action-compare value res
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/compare"]]

		action-compare: as function! [
			value1  [red-value!]						;-- first operand
			value2  [red-value!]						;-- second operand
			op	    [integer!]							;-- type of comparison
			return: [integer!]
		] get-action-ptr value1 ACT_COMPARE

		value: action-compare value1 value2 op
		if value = -2 [
			switch op [
				COMP_EQUAL
				COMP_STRICT_EQUAL [value]
				COMP_NOT_EQUAL 	  [value: 0]
				default [
					--NOT_IMPLEMENTED--					;@@ add error handling
					value
				]
			]
		]
		switch op [
			COMP_EQUAL
			COMP_STRICT_EQUAL 	[res: value = 0]
			COMP_NOT_EQUAL 		[res: value <> 0]
			COMP_LESSER			[res: value < 0]
			COMP_LESSER_EQUAL	[res: value <= 0]
			COMP_GREATER		[res: value > 0]
			COMP_GREATER_EQUAL	[res: value >= 0]
		]
		res
	]

	compare-value: func [								;-- Compare function return integer!
		value1  [red-value!]
		value2  [red-value!]
		op		[comparison-op!]
		return: [integer!]
		/local
			action-compare res
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/compare-value"]]

		action-compare: as function! [
			value1  [red-value!]						;-- first operand
			value2  [red-value!]						;-- second operand
			op	    [integer!]							;-- type of comparison
			return: [integer!]
		] get-action-ptr value1 ACT_COMPARE

		switch TYPE_OF(value1) [
			TYPE_LOGIC	 [res: value1/data1 - value2/data1]
			TYPE_NATIVE
			TYPE_ACTION
			TYPE_FUNCTION
			TYPE_OP
			TYPE_ROUTINE [res: SIGN_COMPARE_RESULT(value1/data3 value2/data3)]
			TYPE_NONE
			TYPE_UNSET	 [res: 0]
			default		 [res: action-compare value1 value2 op]
		]
		res
	]

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

		action-absolute: as function! [
			return:	[red-value!]						;-- absoluted value
		] get-action-ptr* ACT_ABSOLUTE
		action-absolute
	]

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

		action-add: as function! [
			return:	[red-value!]						;-- addition resulting value
		] get-action-ptr* ACT_ADD
		action-add
	]

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

		action-divide: as function! [
			return:	[red-value!]						;-- division resulting value
		] get-action-ptr* ACT_DIVIDE
		action-divide
	]

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

		action-multiply: as function! [
			return:	[red-value!]						;-- multiplication resulting value
		] get-action-ptr* ACT_MULTIPLY
		action-multiply
	]

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

		negate-action stack/arguments
	]

	negate-action: func [								;-- negate is a Red/System keyword
		value	[red-value!]
		return:	[red-value!]
		/local
			action-negate
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/negate"]]

		action-negate: as function! [
			value	[red-value!]
			return:	[red-value!]						;-- negated value
		] get-action-ptr value ACT_NEGATE

		action-negate value
	]

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

		action-power: as function! [
			return:	[red-value!]						;-- addition resulting value
		] get-action-ptr* ACT_POWER
		action-power
	]

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

		action-remainder: as function! [
			return:	  [red-value!]
		] get-action-ptr* ACT_REMAINDER
		action-remainder
	]

	round*: func [
		_to		  [integer!]
		even	  [integer!]
		down	  [integer!]
		half-down [integer!]
		floor	  [integer!]
		ceil	  [integer!]
		half-ceil [integer!]
		/local
			scale [red-value!]
	][
		scale: stack/arguments + _to
		round
			stack/arguments
			scale
			as logic! even	+ 1
			as logic! down	+ 1
			as logic! half-down + 1
			as logic! floor + 1
			as logic! ceil  + 1
			as logic! half-ceil + 1
	]

	round: func [
		value		[red-value!]
		scale		[red-value!]
		_even?		[logic!]
		down?		[logic!]
		half-down?	[logic!]
		floor?		[logic!]
		ceil?		[logic!]
		half-ceil?	[logic!]
		return:		[red-value!]
		/local
			action-round
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/round"]]

		action-round: as function! [
			value		[red-value!]
			scale		[red-value!]
			_even?		[logic!]
			down?		[logic!]
			half-down?	[logic!]
			floor?		[logic!]
			ceil?		[logic!]
			half-ceil?	[logic!]
			return:		[red-value!]
		] get-action-ptr value ACT_ROUND

		action-round value scale _even? down? half-down? floor? ceil? half-ceil?
	]

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

		action-subtract: as function! [
			return:	[red-value!]						;-- addition resulting value
		] get-action-ptr* ACT_SUBTRACT
		action-subtract
	]

	even?*: func [
		return:	[red-logic!]
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/even?"]]

		logic/box even? stack/arguments
	]

	even?: func [
		value	[red-value!]
		return: [logic!]
		/local
			action-even?
	][
		action-even?: as function! [
			value	[red-value!]
			return: [logic!]							;-- TRUE if value is even.
		] get-action-ptr value ACT_EVEN?

		action-even? value
	]

	odd?*: func [
		return:	[red-logic!]
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/odd?"]]

		logic/box odd? stack/arguments
	]

	odd?: func [
		value	[red-value!]
		return: [logic!]
		/local
			action-odd?
	][
		action-odd?: as function! [
			value	[red-value!]
			return: [logic!]							;-- TRUE if value is odd.
		] get-action-ptr value ACT_ODD?

		action-odd? value
	]

	and~*: func [
		return:	[red-value!]
		/local
			action-and~
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/and~"]]

		action-and~: as function! [
			return:	[red-value!]						;-- division resulting value
		] get-action-ptr* ACT_AND~
		action-and~
	]

	complement*: does [
		stack/set-last complement stack/arguments
	]

	complement: func [
		value	[red-value!]
		return:	[red-value!]
		/local
			action-complement
	][
		action-complement: as function! [
			value	[red-value!]
			return:	[red-value!]						;-- complemented value
		] get-action-ptr value ACT_COMPLEMENT

		action-complement value
	]

	or~*: func [
		return:	[red-value!]
		/local
			action-or~
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/or~"]]

		action-or~: as function! [
			return:	[red-value!]						;-- division resulting value
		] get-action-ptr* ACT_OR~
		action-or~
	]

	xor~*: func [
		return:	[red-value!]
		/local
			action-xor~
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/xor~"]]

		action-xor~: as function! [
			return:	[red-value!]						;-- division resulting value
		] get-action-ptr* ACT_XOR~
		action-xor~
	]

	append*: func [
		part  [integer!]
		only  [integer!]
		dup   [integer!]
	][
		; assert ANY-SERIES?(TYPE_OF(stack/arguments))
		insert
			as red-series! stack/arguments
			stack/arguments + 1
			stack/arguments + part
			as logic! only + 1
			stack/arguments + dup
			yes
	]

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

		action-at: as function! [
			return:	[red-value!]						;-- picked value from series
		] get-action-ptr* ACT_AT
		action-at
	]

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

		action-back: as function! [
			return:	[red-value!]						;-- picked value from series
		] get-action-ptr* ACT_BACK
		action-back
	]

	change*: func [][]

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

	clear: func [
		value	[red-value!]
		return:	[red-value!]
		/local
			action-clear
	][
		action-clear: as function! [
			value	[red-value!]
			return:	[red-value!]						;-- argument series
		] get-action-ptr value ACT_CLEAR

		action-clear value
	]

	copy*: func [
		part	[integer!]
		deep	[integer!]
		types	[integer!]
		return:	[red-value!]
	][
		stack/set-last copy
			as red-series! stack/arguments
			stack/push*
			stack/arguments + part
			as logic! deep + 1
			stack/arguments + types
	]

	copy: func [
		series  [red-series!]
		new		[red-value!]
		part	[red-value!]
		deep?	[logic!]
		types	[red-value!]
		return:	[red-value!]
		/local
			action-copy
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/copy"]]

		new/header: series/header

		action-copy: as function! [
			series  [red-series!]
			new		[red-value!]
			part	[red-value!]
			deep?	[logic!]
			types	[red-value!]
			return: [red-series!]
		] get-action-ptr as red-value! series ACT_COPY

		action-copy series new part deep? types
		new
	]

	find*: func [
		part	 [integer!]
		only	 [integer!]
		case-arg [integer!]
		any-arg  [integer!]
		with-arg [integer!]
		skip	 [integer!]
		last	 [integer!]
		reverse	 [integer!]
		tail	 [integer!]
		match	 [integer!]
	][
		; assert ANY-SERIES?(TYPE_OF(stack/arguments))
		stack/set-last find
			as red-series! stack/arguments
			stack/arguments + 1
			stack/arguments + part
			as logic! only + 1
			as logic! case-arg + 1
			as logic! any-arg + 1
			as red-string!  stack/arguments + with-arg
			as red-integer! stack/arguments + skip
			as logic! last + 1
			as logic! reverse + 1
			as logic! tail + 1
			as logic! match + 1
	]

	find: func [
		series   [red-series!]
		value    [red-value!]
		part	 [red-value!]
		only?	 [logic!]
		case?	 [logic!]
		any?	 [logic!]
		with-arg [red-string!]
		skip	 [red-integer!]
		last?	 [logic!]
		reverse? [logic!]
		tail?	 [logic!]
		match?	 [logic!]
		return:  [red-value!]
		/local
			action-find
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/find"]]

		action-find: as function! [
			series   [red-series!]
			value    [red-value!]
			part	 [red-value!]
			only?	 [logic!]
			case?	 [logic!]
			any?	 [logic!]
			with-arg [red-string!]
			skip	 [red-integer!]
			last?	 [logic!]
			reverse? [logic!]
			tail?	 [logic!]
			match?	 [logic!]
			return:  [red-value!]
		] get-action-ptr as red-value! series ACT_FIND

		action-find series value part only? case? any? with-arg skip last? reverse? tail? match?
	]

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

		action-head: as function! [
			return:	[red-value!]						;-- picked value from series
		] get-action-ptr* ACT_HEAD
		action-head
	]

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

		action-head?: as function! [
			return:	[red-value!]						;-- picked value from series
		] get-action-ptr* ACT_HEAD?
		action-head?
	]

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

		action-index?: as function! [
			return:	[red-value!]						;-- picked value from series
		] get-action-ptr* ACT_INDEX?
		action-index?
	]

	insert*: func [
		part  [integer!]
		only  [integer!]
		dup   [integer!]
	][
		; assert ANY-SERIES?(TYPE_OF(stack/arguments))
		insert
			as red-series! stack/arguments
			stack/arguments + 1
			stack/arguments + part
			as logic! only + 1
			stack/arguments + dup
			no
	]

	insert: func [
		series  [red-series!]
		value   [red-value!]
		part	[red-value!]
		only?	[logic!]
		dup		[red-value!]
		append? [logic!]
		return:	[red-value!]
		/local
			action-insert
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/insert"]]

		action-insert: as function! [
			series  [red-series!]
			value   [red-value!]
			part	[red-value!]
			only?	[logic!]
			dup		[red-value!]
			append? [logic!]
			return:	[red-value!]						;-- series after insertion position
		] get-action-ptr as red-value! series ACT_INSERT

		action-insert series value part only? dup append?
	]

	length?*: func [
		return:	[red-integer!]
		/local
			int	  [red-integer!]
			value [integer!]
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/length?"]]

		int: as red-integer! stack/arguments
		value: length? stack/arguments					;-- must be set before slot is modified
		either value = -1 [
			none/push-last
		][
			int/value:  value
			int/header: TYPE_INTEGER
		]
		int
	]

	length?: func [
		value	[red-value!]
		return: [integer!]
		/local
			action-length?
	][
		action-length?: as function! [
			value	[red-value!]
			return:	[integer!]							;-- length of series
		] get-action-ptr value ACT_LENGTH?

		action-length? value
	]

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

		action-next: as function! [
			return:	[red-value!]						;-- next value from series
		] get-action-ptr* ACT_NEXT
		action-next
	]

	pick*: func [
		return:	 [red-value!]
	][
		stack/set-last pick
			as red-series! stack/arguments
			get-index-argument
			stack/arguments + 1
	]

	pick: func [
		series	[red-series!]
		index	[integer!]
		boxed	[red-value!]							;-- boxed index value
		return:	[red-value!]
		/local
			action-pick
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/pick"]]

		action-pick: as function! [
			series	[red-series!]
			index	[integer!]
			boxed	[red-value!]						;-- boxed index value
			return:	[red-value!]						;-- picked value from series
		] get-action-ptr as red-value! series ACT_PICK

		action-pick series index boxed
	]

	poke*: func [
		return:	[red-value!]
	][
		poke
			as red-series! stack/arguments
			get-index-argument
			stack/arguments + 2
			stack/arguments + 1

		stack/set-last stack/arguments
	]

	poke: func [
		series	[red-series!]
		index	[integer!]								;-- unboxed value
		data	[red-value!]
		boxed	[red-value!]							;-- boxed index value
		/local
			action-poke
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/poke"]]

		action-poke: as function! [
			series	[red-series!]
			index	[integer!]
			data	[red-value!]
			boxed	[red-value!]
			return:	[red-value!]						;-- picked value from series
		] get-action-ptr as red-value! series ACT_POKE

		action-poke series index data boxed
	]

	remove*: func [
		part [integer!]
	][
		remove
			as red-series! stack/arguments
			stack/arguments + part
	]

	remove: func [
		series  [red-series!]
		part	[red-value!]
		return:	[red-value!]
		/local
			action-remove
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/remove"]]

		action-remove: as function! [
			series	[red-series!]
			part	[red-value!]
			return:	[red-value!]
		] get-action-ptr as red-value! series ACT_REMOVE

		action-remove series part
	]

	reverse*: func [
		part [integer!]
	][
		reverse
			as red-series! stack/arguments
			stack/arguments + part
	]

	reverse: func [
		series  [red-series!]
		part	[red-value!]
		return:	[red-value!]
		/local
			action-reverse
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/reverse"]]

		action-reverse: as function! [
			series	[red-series!]
			part	[red-value!]
			return:	[red-value!]
		] get-action-ptr as red-value! series ACT_REVERSE

		action-reverse series part
	]

	select*: func [
		part	 [integer!]
		only	 [integer!]
		case-arg [integer!]
		any-arg  [integer!]
		with-arg [integer!]
		skip	 [integer!]
		last	 [integer!]
		reverse	 [integer!]
	][
		; assert ANY-SERIES?(TYPE_OF(stack/arguments))
		stack/set-last select
			as red-series! stack/arguments
			stack/arguments + 1
			stack/arguments + part
			as logic! only + 1
			as logic! case-arg + 1
			as logic! any-arg + 1
			as red-string!  stack/arguments + with-arg
			as red-integer! stack/arguments + skip
			as logic! last + 1
			as logic! reverse + 1
	]

	select: func [
		series   [red-series!]
		value    [red-value!]
		part	 [red-value!]
		only?	 [logic!]
		case?	 [logic!]
		any?	 [logic!]
		with-arg [red-string!]
		skip	 [red-integer!]
		last?	 [logic!]
		reverse? [logic!]
		return:  [red-value!]
		/local
			action-select
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/select"]]

		action-select: as function! [
			series   [red-series!]
			value    [red-value!]
			part	 [red-value!]
			only?	 [logic!]
			case?	 [logic!]
			any?	 [logic!]
			with-arg [red-string!]
			skip	 [red-integer!]
			last?	 [logic!]
			reverse? [logic!]
			return:  [red-value!]
		] get-action-ptr as red-value! series ACT_SELECT

		action-select series value part only? case? any? with-arg skip last? reverse?
	]

	sort*: func [
		case-arg [integer!]
		skip-arg [integer!]
		compare  [integer!]
		part	 [integer!]
		all-arg  [integer!]
		reverse	 [integer!]
	][
		; assert ANY-SERIES?(TYPE_OF(stack/arguments))
		stack/set-last sort
			as red-series!   stack/arguments
			as logic!		 case-arg + 1
			as red-integer!  stack/arguments + skip-arg
			as red-function! stack/arguments + compare
			stack/arguments + part
			as logic! all-arg + 1
			as logic! reverse + 1
	]

	sort: func [
		series   [red-series!]
		case?    [logic!]
		skip	 [red-integer!]
		compare	 [red-function!]
		part	 [red-value!]
		all?	 [logic!]
		reverse? [logic!]
		return:  [red-value!]
		/local
			action-sort
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/sort"]]

		action-sort: as function! [
			series   [red-series!]
			case?    [logic!]
			skip	 [red-integer!]
			compare	 [red-function!]
			part	 [red-value!]
			all?	 [logic!]
			reverse? [logic!]
			return:  [red-value!]
		] get-action-ptr as red-value! series ACT_SORT

		action-sort series case? skip compare part all? reverse?
	]

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

		action-skip: as function! [
			return:	[red-value!]						;-- picked value from series
		] get-action-ptr* ACT_SKIP
		action-skip
	]

	swap*: func [
		return: [red-series!]
	][
		swap
			as red-series! stack/arguments
			as red-series! stack/arguments + 1
	]

	swap: func [
		series1 [red-series!]
		series2	[red-series!]
		return:	[red-series!]
		/local
			action-swap
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/swap"]]

		action-swap: as function! [
			series1	[red-series!]
			series2	[red-series!]
			return:	[red-series!]
		] get-action-ptr as red-value! series1 ACT_SWAP

		action-swap series1 series2
	]

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

		action-tail: as function! [
			return:	[red-value!]						;-- picked value from series
		] get-action-ptr* ACT_TAIL
		action-tail
	]

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

		action-tail?: as function! [
			return:	[red-value!]						;-- picked value from series
		] get-action-ptr* ACT_TAIL?
		action-tail?
	]

	take*: func [
		part	[integer!]
		deep	[integer!]
		last	[integer!]
		return:	[red-value!]
	][
		stack/set-last take
			as red-series! stack/arguments
			stack/arguments + part
			as logic! deep + 1
			as logic! last + 1
	]

	take: func [
		series  [red-series!]
		part	[red-value!]
		deep?	[logic!]
		last?	[logic!]
		return:	[red-value!]
		/local
			action-take
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/take"]]

		action-take: as function! [
			series  [red-series!]
			part	[red-value!]
			deep?	[logic!]
			last?	[logic!]
			return: [red-value!]
		] get-action-ptr as red-value! series ACT_TAKE

		action-take series part deep? last?
	]

	trim*: func [
		head	[integer!]
		tail	[integer!]
		auto	[integer!]
		lines	[integer!]
		_all	[integer!]
		with-arg [integer!]
		return:	[red-series!]
	][
		trim
			as red-series! stack/arguments
			as logic! head  + 1
			as logic! tail  + 1
			as logic! auto  + 1
			as logic! lines + 1
			as logic! _all  + 1
			stack/arguments + with-arg
	]

	trim: func [
		series  [red-series!]
		head?	[logic!]
		tail?	[logic!]
		auto?	[logic!]
		lines?	[logic!]
		all?	[logic!]
		with-arg [red-value!]
		return:	[red-series!]
		/local
			action-trim
	][
		#if debug? = yes [if verbose > 0 [print-line "actions/trim"]]

		action-trim: as function! [
			series  [red-series!]
			head?	[logic!]
			tail?	[logic!]
			auto?	[logic!]
			lines?	[logic!]
			all?	[logic!]
			with-arg [red-value!]
			return:	[red-series!]
		] get-action-ptr as red-value! series ACT_TRIM

		action-trim series head? tail? auto? lines? all? with-arg
	]

	create*: func [][]
	close*: func [][]
	delete*: func [][]
	modify*: func [][]
	open*: func [][]
	open?*: func [][]
	query*: func [][]
	read*: func [][]
	rename*: func [][]
	update*: func [][]
	write*: func [][]

	init: does [
		table: as int-ptr! allocate ACTIONS_NB * size? integer!

		register [
			;-- General actions --
			:make*
			:random*
			:reflect*
			:to*
			:form*
			:mold*
			:eval-path*
			null			;set-path
			:compare
			;-- Scalar actions --
			:absolute*
			:add*
			:divide*
			:multiply*
			:negate*
			:power*
			:remainder*
			:round*
			:subtract*
			:even?*
			:odd?*
			;-- Bitwise actions --
			:and~*
			:complement*
			:or~*
			:xor~*
			;-- Series actions --
			:append*
			:at*
			:back*
			null			;change
			:clear*
			:copy*
			:find*
			:head*
			:head?*
			:index?*
			:insert*
			:length?*
			:next*
			:pick*
			:poke*
			:remove*
			:reverse*
			:select*
			:sort*
			:skip*
			:swap*
			:tail*
			:tail?*
			:take*
			:trim*
			;-- I/O actions --
			null			;create
			null			;close
			null			;delete
			null			;modify
			null			;open
			null			;open?
			null			;query
			null			;read
			null			;rename
			null			;update
			null			;write
		]
	]
]


cleanup

cleanup

Red []

do https://raw.githubusercontent.com/tentamen/red-utils/master/range.red

input: read/lines %../../resources/2018/day03

digit: charset "0123456789"

claims: []

; parse
foreach line input [
  parse line [
    "#"
    copy id some digit (id: to integer! id)
    space "@" space
    copy x some digit (x: to integer! x)
    ","
    copy y some digit (y: to integer! y)
    ":" space
    copy width some digit (width: to integer! width)
    "x"
    copy height some digit (height: to integer! height)
    (repend claims [id x y width height])
  ]
]

; part 1
m: make hash! []

foreach [id x y width height] claims [
  foreach i x .. (x + width - 1) [
    foreach j y .. (y + height - 1) [
      square: as-pair i j
      either n: find m square [
        append n/2 id
      ] [
        append m square
        repend/only m [id]
      ]
    ]
  ]
]

count: 0
foreach [square ids] m [
  if (length? ids) > 1 [count: count + 1]
]

print count ; 124850

Red []

input: read/lines %../../resources/2018/day03

digit: charset "0123456789"

claims: []

; parse
foreach line input [
  parse line [
    "#"
    copy id some digit (id: to integer! id)
    space "@" space
    copy x some digit (x: to integer! x)
    ","
    copy y some digit (y: to integer! y)
    ":" space
    copy w some digit (w: to integer! w)
    "x"
    copy h some digit (h: to integer! h)
    (repend claims [id x y w h])
  ]
]

; part 1
m: make hash! []

foreach [id x y w h] claims [
  i: x
  while [i < (x + w)] [
    j: y
    while [j < (y + h)] [
      square: as-pair i j
      either n: find m square [
        append n/2 id
      ] [
        append m square
        repend/only m [id]
      ]
      j: j + 1
    ]
    i: i + 1
  ]
]

count: 0
foreach [square ids] m [
  if (length? ids) > 1 [count: count + 1]
]

print count ; 124850


FEAT: added a new PAD function.

FEAT: added a new PAD function.

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

comment: func [value][]

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

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

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

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

quote: func [
	:value
][
	:value
]

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

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

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

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

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

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

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

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

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

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

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

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

pad: func [
	"Align a string to a given size prepending whitespaces"
	str [string!]		"String to pad"
	n	[integer!]		"Size (in characters) to align to"
	/left				"Align the string to the left side"
	return: [string!]	"Modified input string at head"
][
	head insert/dup
		any [all [left str] tail str]
		#" "
		(n - length? str)
]

;------------------------------------------
;-				Aliases					  -
;------------------------------------------

;empty?: :tail?
atan2: :arctangent2
object: :context

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

comment: func [value][]

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

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

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

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

quote: func [
	:value
][
	:value
]

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

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

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

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

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

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

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

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

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

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

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

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

;------------------------------------------
;-				Aliases					  -
;------------------------------------------

;empty?: :tail?
atan2: :arctangent2
object: :context