FEAT: adding function ENUM for making standard enumeration objects from given specification

See the included test file for usage examples.

Author: Oldes

src/boot/errors.r

@@ -125,6 +125,8 @@ Script: [
 ;   face-reused:        [{Face object reused (in more than one pane):} :arg1]
 
 	invalid-handle:     {invalid handle}
+	invalid-value-for:  [{invalid value} :arg1 {for:} :arg2]
+
 ]
 
 Math: [

src/boot/sysobj.r

@@ -160,6 +160,8 @@ standard: context [
 			none
 	]
 
+	enum: none ; is defined later in %mezz-func.r file
+
 	error: context [ ; Template used for all errors:
 		code: 0
 		type: 'user
@@ -284,6 +286,7 @@ standard: context [
 			none
 	]
 
+	bincode: none
 	utype: none
 	font: none	; mezz-graphics.h
 	para: none	; mezz-graphics.h

src/mezz/mezz-func.r

@@ -78,3 +78,60 @@ task: func [
 ][
 	make task! copy/deep reduce [spec body]
 ]
+
+enum: function [
+	"Creates enumeration object from given specification"
+	spec [block!] "Specification with names and values."
+	title [string! word!] "Enumeration name"
+][
+	enum-value: 0
+	spec: copy spec
+	parse spec [any [
+		pos: word! insert enum-value (
+			change pos to set-word! pos/1
+			enum-value: enum-value + 1
+		)
+		| some set-word! pos: [
+			integer! | issue! | binary! | char!
+		] (
+			if error? try [
+				enum-value: to integer! pos/1
+				pos: change pos enum-value
+				enum-value: enum-value + 1
+			][
+				cause-error 'Script 'invalid-data reduce [pos]
+			]
+		) :pos
+		| pos: 1 skip (
+			cause-error 'Script 'invalid-data reduce [pos]
+		)
+		]
+	]
+	enum: make system/standard/enum spec
+	enum/title*: title
+	enum
+]
+
+system/standard/enum: context [
+	title*: none
+	assert: func[
+		"Checks if value exists as an enumeration. Throws error if not."
+		value [integer!]
+	][
+		unless find values-of self value [
+			cause-error 'Script 'invalid-value-for reduce [value title*]
+		]
+		true
+	]
+	name: func[
+		"Returns name of the emumeration by its value if value exists, else none."
+		value [integer!]
+		/local pos
+	][
+		all [
+			pos: find values-of self value
+			pick words-of self index? pos
+		]
+	]
+	;@@ add some other accessor functions?
+]

src/tests/run-tests.r3

@@ -17,6 +17,7 @@ wrap load %units/rsa-test.r3
 wrap load %units/dh-test.r3
 wrap load %units/port-test.r3
 wrap load %units/checksum-test.r3
+wrap load %units/enum-test.r3
 
 wrap load %units/crash-test.r3
 

src/tests/units/enum-test.r3

@@ -0,0 +1,52 @@
+Rebol [
+	Title:   "Rebol enum test script"
+	Author:  "Oldes"
+	File: 	 %enum-test.red
+	Tabs:	 4
+	Needs:   [%../quick-test-module.r3]
+]
+
+~~~start-file~~~ "Enum"
+
+===start-group=== "Basic enumeration"
+--test-- "enum with basic specification"
+	*FX-DX8: enum [
+		CHORUS
+		COMPRESSOR
+		DISTORTION
+		ECHO
+		FLANGER
+		GARGLE
+		I3DL2REVERB
+		PARAMEQ
+		REVERB
+	] "DX8 effect ID"
+
+	--assert object? *FX-DX8
+	--assert 0 = *FX-DX8/CHORUS
+	--assert 8 = *FX-DX8/REVERB
+	--assert found? find [ECHO FLANGER] *FX-DX8/name 4
+
+
+--test-- "enum with mixed specification"
+	*family: enum [
+		Alice: 1
+		Boban
+		Bolek
+		Lolek:  #{FF}
+		Brian
+	] 'Just-Some-Names
+
+	--assert object?  *family
+	--assert 'Boban = *family/name 2
+	--assert 'Lolek = *family/name 255
+	--assert none? *family/name 13
+	--assert true? *family/assert 1
+	--assert 256 = *family/Brian
+	--assert error? err: try [*family/assert 13]
+	--assert err/arg1 = 13 
+	--assert err/arg2 = 'Just-Some-Names
+
+===end-group===
+
+~~~end-file~~~