FEAT: added binary! datatype

build/includes.r

@@ -60,6 +60,7 @@ write %build/bin/sources.r set-cache [
 			%action.reds
 			%block.reds
 			%bitset.reds
+			%binary.reds
 			%char.reds
 			%common.reds
 			%context.reds

compiler.r

@@ -428,14 +428,7 @@ red: context [
 		]
 		blk
 	]
-
-	emit-load-string: func [buffer [string! file! url!]][
-		emit to path! reduce [to word! form type? buffer 'rs-load]
-		emit form buffer
-		emit length? buffer
-		emit 'UTF-8
-	]
-
+
 	emit-open-frame: func [name [word!] /local type][
 		unless find symbols name [add-symbol name]
 		emit case [
@@ -1502,7 +1495,12 @@ red: context [
 					emit compose [as red-string! get-root (idx)]
 					insert-lf -5
 				]
-				binary!	[]
+				binary!	[
+					idx: redbin/emit-string/root value
+					emit to path! reduce [to word! form type? value 'push]
+					emit compose [as red-binary! get-root (idx)]
+					insert-lf -5
+				]
 			][
 				throw-error ["comp-literal: unsupported type" mold value]
 			]

environment/datatypes.red

@@ -29,7 +29,7 @@ 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
+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

environment/functions.red

@@ -72,6 +72,7 @@ last:	func ["Returns the last value in a series"  s [series!]][pick back tail s
 
 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]
+binary?:	 func ["Returns true if the value is this type" value [any-type!]] [binary!		= 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]

environment/lexer.red

@@ -12,10 +12,37 @@ Red [
 
 system/lexer: context [
 
+	make-binary: routine [
+		start  [string!]
+		end    [string!]
+		base   [integer!]
+		/local
+			s	 [series!]
+			p	 [byte-ptr!]
+			len  [integer!]
+			unit [integer!]
+			ret  [red-binary!]
+	][
+		s:  GET_BUFFER(start)
+		unit: GET_UNIT(s)
+		p:	  string/rs-head start
+		len:  end/head - start/head
+
+		ret: as red-binary! stack/arguments
+		ret/head: 0
+		ret/header: TYPE_BINARY
+		ret/node: switch base [
+			16 [binary/decode-16 p len unit]
+			2  [binary/decode-2  p len unit]
+			64 [binary/decode-64 p len unit]
+		]
+	]
+
 	make-tuple: routine [
 		start  [string!]
 		end	   [string!]
 		/local
+			str  [series!]
 			c	 [integer!]
 			n	 [integer!]
 			m	 [integer!]
@@ -62,6 +89,7 @@ system/lexer: context [
 		end	   [string!]
 		type   [datatype!]
 		/local
+			str  [series!]
 			c	 [integer!]
 			n	 [integer!]
 			m	 [integer!]
@@ -280,9 +308,9 @@ system/lexer: context [
 			digit hexa-upper hexa-lower hexa hexa-char not-word-char not-word-1st
 			not-file-char not-str-char not-mstr-char caret-char
 			non-printable-char integer-end ws-ASCII ws-U+2k control-char
-			four half non-zero path-end
+			four half non-zero path-end base base64-char
 	][
-		cs:		[- - - - - - - - - - - - - - - - - - - -]	;-- memoized bitsets
+		cs:		[- - - - - - - - - - - - - - - - - - - - -]	;-- memoized bitsets
 		stack:	clear []
 		count?:	yes										;-- if TRUE, lines counter is enabled
 		line: 	1
@@ -334,12 +362,15 @@ system/lexer: context [
 			cs/18: charset "012345"						;-- half
 		    cs/19: charset "123456789"					;-- non-zero
 		    cs/20: charset {^{"[]();}					;-- path-end
+		    cs/21: union union cs/1						;-- base64-char
+		    		charset [#"A" - #"Z" #"a" - #"z"]
+		    		charset {+/=}
 		]
 		set [
 			digit hexa-upper hexa-lower hexa hexa-char not-word-char not-word-1st
 			not-file-char not-str-char not-mstr-char caret-char
 			non-printable-char integer-end ws-ASCII ws-U+2k control-char
-			four half non-zero path-end
+			four half non-zero path-end base64-char
 		] cs
 
 		byte: [
@@ -455,6 +486,26 @@ system/lexer: context [
 
 		string-rule: [(type: string!) line-string | multiline-string]
 
+		base-2-rule: [
+			"2#{" s: any [counted-newline | 8 [#"0" | #"1" ] | ws-no-count] e: #"}"
+			(base: 2)
+		]
+
+		base-16-rule: [
+			"#{" s: any [counted-newline | 2 hexa-char | ws-no-count] e: #"}"
+			(base: 16)
+		]
+
+		base-64-rule: [						;@@ correct me!
+			"64#{" s: any [counted-newline | base64-char | ws-no-count] e: #"}"			
+			(base: 64)
+		]
+
+		binary-rule: [
+			(type: binary!)
+			base-16-rule | base-2-rule | base-64-rule
+		]
+
 		file-rule: [
 			#"%" [
 				line-string (process: make-string type: file!)
@@ -678,7 +729,7 @@ system/lexer: context [
 				| block-rule
 				| paren-rule
 				| string-rule		(store stack do make-string)
-				;| binary-rule	  	(stack/push load-binary s e)
+				| binary-rule		(store stack make-binary s e base)
 				| map-rule
 				| issue-rule
 			]

environment/scalars.red

@@ -38,7 +38,7 @@ any-block!:		union any-path! make typeset! [block! paren! hash!]
 any-function!:	make typeset! [native! action! op! function! routine!]
 any-object!:	make typeset! [object! error!]
 any-string!:	make typeset! [string! file! url!]
-series!:		union make typeset! [vector!] union any-block! any-string!
+series!:		union make typeset! [binary! vector!] union any-block! any-string!
 immediate!:		union scalar! union any-word! make typeset! [none! logic! datatype! typeset!]
 default!:		union series! union immediate! union any-object! union any-function! make typeset! [map! bitset!]
 any-type!:		union default! internal!