FEAT: preliminary work on a low-level tokenizer for Red values.

build/includes.r

@@ -69,6 +69,7 @@ write %build/bin/sources.r set-cache [
 		%ownership.reds
 		%stack.reds
 		%tools.reds
+		%tokenizer.reds
 		%unicode.reds
 		%simple-io.reds
 		%clipboard.reds

environment/lexer.red

@@ -97,52 +97,30 @@ system/lexer: context [
 			2  [binary/decode-2  p len unit]
 			64 [binary/decode-64 p len unit]
 		]
-		if ret/node = null [ret/header: TYPE_NONE]			;-- return NONE!
+		if ret/node = null [ret/header: TYPE_NONE]		;-- return NONE!
 	]
 
 	make-tuple: routine [
 		start  [string!]
 		end	   [string!]
 		/local
-			str  [series!]
-			c	 [integer!]
-			n	 [integer!]
-			m	 [integer!]
+			s    [series!]
+			err	 [integer!]
 			len  [integer!]
 			unit [integer!]
-			size [integer!]
 			p	 [byte-ptr!]
 			tp	 [byte-ptr!]
 			ret  [red-value!]
 	][
-		str:  GET_BUFFER(start)
-		unit: GET_UNIT(str)
+		s:	  GET_BUFFER(start)
+		unit: GET_UNIT(s)
 		p:	  string/rs-head start
 		len:  end/head - start/head
-		ret: stack/arguments
-		tp: (as byte-ptr! ret) + 4
-
-		n: 0
-		size: 0
-		until [
-			c: string/get-char p unit
-			either c = as-integer #"." [
-				size: size + 1
-				tp/size: as byte! n
-				n: 0
-			][
-				m: n * 10
-				n: m
-				m: n + c - #"0"
-				n: m
-			]
-			p: p + unit
-			len: len - 1
-			zero? len
-		]
-		size: size + 1									;-- last number
-		tp/size: as byte! n
-		ret/header: TYPE_TUPLE or (size << 19)
+		ret:  stack/arguments
+		err:  0
+
+		tokenizer/scan-tuple p len unit	:err ret
+		assert err = 0									;-- pre-checked validity
 		ret
 	]
 
@@ -151,107 +129,53 @@ system/lexer: context [
 		end	   [string!]
 		type   [datatype!]
 		/local
-			str  [series!]
-			c	 [integer!]
-			n	 [integer!]
-			m	 [integer!]
+			s	 [series!]
 			len  [integer!]
 			unit [integer!]
 			p	 [byte-ptr!]
-			neg? [logic!]
+			err	 [integer!]
+			i	 [integer!]
 	][
 		if type/value <> TYPE_INTEGER [
 			make-float start end type					;-- float! escape path
 			exit
 		]
-		str:  GET_BUFFER(start)
-		unit: GET_UNIT(str)
+		s:	  GET_BUFFER(start)
+		unit: GET_UNIT(s)
 		p:	  string/rs-head start
 		len:  end/head - start/head
-		neg?: no
-
-		c: string/get-char p unit
-		if any [
-			c = as-integer #"+" 
-			c = as-integer #"-"
-		][
-			neg?: c = as-integer #"-"
-			p: p + unit
-			len: len - 1
-		]
-		n: 0
-		until [
-			c: (string/get-char p unit) - #"0"
-			if c >= 0 [									;-- skip #"'"
-				m: n * 10
-
-				if system/cpu/overflow? [
-					type/value: TYPE_FLOAT
-					make-float start end type			;-- fallback to float! loading
-					exit
-				]
-				n: m
-
-				if all [neg? n = 2147483640 c = 8][
-					integer/box 80000000h				;-- special exit trap for -2147483648
-					exit
-				]
+		err:  0
 
-				m: n + c
-
-				if system/cpu/overflow? [
-					type/value: TYPE_FLOAT
-					make-float start end type			;-- fallback to float! loading
-					exit
-				]
-				n: m
-			]
-			p: p + unit
-			len: len - 1
-			zero? len
-		]
-		integer/box either neg? [0 - n][n]
+		i: tokenizer/scan-integer p len unit :err
+
+		if err <> 0 [
+			type/value: TYPE_FLOAT
+			make-float start end type			;-- fallback to float! loading
+			exit
+		]			
+		integer/box i
 	]
 
 	make-float: routine [
 		start [string!]
 		end	  [string!]
 		type  [datatype!]
 		/local
-			str  [series!]
-			cp	 [integer!]
+			s	 [series!]
 			unit [integer!]
 			len  [integer!]
 			p	 [byte-ptr!]
-			tail [byte-ptr!]
-			cur	 [byte-ptr!]
-			s0	 [byte-ptr!]
+			err	 [integer!]
 			f	 [float!]
 	][
-		cur: as byte-ptr! "0000000000000000000000000000000"		;-- 32 bytes including NUL
-
-		str:  GET_BUFFER(start)
-		unit: GET_UNIT(str)
+		s:	  GET_BUFFER(start)
+		unit: GET_UNIT(s)
 		p:	  string/rs-head start
 		len:  end/head - start/head
-		tail: p + (len << (unit >> 1))
-
-		if len > 31 [cur: allocate len + 1]
-		s0:   cur
-
-		until [											;-- convert to ascii string
-			cp: string/get-char p unit
-			if cp <> as-integer #"'" [					;-- skip #"'"
-				if cp = as-integer #"," [cp: as-integer #"."]
-				cur/1: as-byte cp
-				cur: cur + 1
-			]
-			p: p + unit
-			p = tail
-		]
-		cur/1: #"^@"									;-- replace the byte with null so to-float can use it as end of input
-		f: string/to-float s0
-		if len > 31 [free s0]
+		err:  0
+
+		f: tokenizer/scan-float p len unit :err
+
 		either type/value = TYPE_FLOAT [float/box f][percent/box f / 100.0]
 	]
 

runtime/datatypes/float.reds

@@ -518,13 +518,14 @@ float: context [
 		type	[integer!]								;-- target type
 		return:	[red-float!]
 		/local
-			int [red-integer!]
-			tm	[red-time!]
-			_1	[integer!]
-			_2	[integer!]
-			_3	[integer!]
-			_4	[integer!]
-			val [red-value!]
+			int	 [red-integer!]
+			tm	 [red-time!]
+			str  [red-string!]
+			p	 [byte-ptr!]
+			err	 [integer!]
+			unit [integer!]
+			len	 [integer!]
+			s	 [series!]
 	][
 		#if debug? = yes [if verbose > 0 [print-line "float/to"]]
 
@@ -540,23 +541,15 @@ float: context [
 				proto/value: tm/time
 			]
 			TYPE_ANY_STRING [
-				_4: 0
-				val: as red-value! :_4
-				copy-cell spec val					;-- save spec, load-value will change it
-
-				proto: as red-float! load-value as red-string! spec
-				switch TYPE_OF(proto) [
-					TYPE_FLOAT	
-					TYPE_PERCENT [0]				;-- most common case
-					TYPE_INTEGER [
-						int: as red-integer! proto
-						proto/value: as float! int/value
-					]
-					default [
-						fire [TO_ERROR(script bad-to-arg) datatype/push type val]
-					]
-				]
-				proto/header: type
+				err: 0
+				str: as red-string! spec
+				s: GET_BUFFER(str)
+				unit: GET_UNIT(s)
+				p: (as byte-ptr! s/offset) + (str/head << log-b unit)
+				len: (as-integer s/tail - p) >> log-b unit
+
+				proto/value: tokenizer/scan-float p len unit :err
+				if err <> 0 [fire [TO_ERROR(script bad-to-arg) datatype/push type spec]]
 			]
 			TYPE_BINARY [
 				proto/value: from-binary as red-binary! spec

runtime/datatypes/integer.reds

@@ -385,8 +385,14 @@ integer: context [
 		/local
 			int  [red-integer!]
 			fl	 [red-float!]
+			str	 [red-string!]
 			t	 [red-time!]
-			val	 [red-value! value]
+			p	 [byte-ptr!]
+			err	 [integer!]
+			i	 [integer!]
+			unit [integer!]
+			len	 [integer!]
+			s	 [series!]
 	][
 		#if debug? = yes [if verbose > 0 [print-line "integer/to"]]
 
@@ -419,21 +425,17 @@ integer: context [
 				int/value: date/to-epoch as red-date! spec
 			]
 			TYPE_ANY_STRING [
-				copy-cell spec val					;-- save spec, load-value will change it
-
-				proto: load-value as red-string! spec
-
-				either TYPE_OF(proto) = TYPE_FLOAT [
-					fl: as red-float! proto
-					if overflow? fl [fire [TO_ERROR(script too-long)]]
-					int: as red-integer! proto
-					int/header: TYPE_INTEGER
-					int/value: as-integer fl/value
-				][
-					if TYPE_OF(proto) <> TYPE_INTEGER [ 
-						fire [TO_ERROR(script bad-to-arg) datatype/push TYPE_INTEGER val]
-					]
+				err: 0
+				str: as red-string! spec
+				s: GET_BUFFER(str)
+				unit: GET_UNIT(s)
+				p: (as byte-ptr! s/offset) + (str/head << log-b unit)
+				len: (as-integer s/tail - p) >> log-b unit
+				i: tokenizer/scan-integer p len unit :err
+				if err <> 0 [
+					fire [TO_ERROR(script bad-to-arg) datatype/push TYPE_INTEGER spec]
 				]
+				int/value: i
 			]
 			default [fire [TO_ERROR(script bad-to-arg) datatype/push TYPE_INTEGER spec]]
 		]

runtime/datatypes/string.reds

@@ -67,6 +67,7 @@ string: context [
 
 	to-float: func [
 		s		[byte-ptr!]
+		e		[int-ptr!]
 		return: [float!]
 		/local
 			s0	[byte-ptr!]
@@ -83,7 +84,7 @@ string: context [
 				return float/QNaN
 			]
 		]
-		strtod s0 null
+		strtod s0 as byte-ptr! e
 	]
 
 	byte-to-hex: func [

runtime/red.reds

@@ -117,6 +117,7 @@ red: context [
 	#include %crypto.reds
 	#include %stack.reds
 	#include %interpreter.reds
+	#include %tokenizer.reds
 	#include %simple-io.reds							;-- temporary file IO support
 	#include %clipboard.reds
 	#include %redbin.reds