FEAT: special integer notation (bit, octal, decimal and hexadecimal)

resolves: Oldes/Rebol-issues#1781

Author: Oldes

src/core/l-scan.c

@@ -751,6 +751,58 @@
 	return cp;
 }
 
+/***********************************************************************
+**
+*/  static const REBYTE* Prescan_Spec_Integer(const REBYTE *cp, REBINT base)
+/*
+**	Validate special integer notation:
+**		bit:          2#0101
+**		octal:        8#777
+**		decimal:     10#123
+**		hexadecimal: 16#FF or just 0#FF
+**
+***********************************************************************/
+{
+	REBCNT n, m;
+	REBYTE lex;
+	REBINT val;
+	if (base == 16) {
+		n = m = 16;
+		while (n > 0) {
+			lex = Lex_Map[*cp];
+			if (lex < LEX_WORD || (!(lex & LEX_VALUE) && lex < LEX_NUMBER))
+				break;
+			cp++;
+			n--;
+		}
+	}
+	else if (base == 2) {
+		n = m = 64; // max 64 bits
+		while (n > 0 && (*cp == '0' || *cp == '1')) {
+			cp++; n--;
+		}
+	}
+	else if (base == 8) {
+		n = m = 22; // max length 22 bytes
+		while (n > 0) {
+			val = *cp - '0';
+			if (val < 0 || val > 7)
+				break;
+			cp++; n--;
+		}
+	}
+	else if (base == 10) {
+		n = m = 18; // max length 18 digits
+		while (n > 0) {
+			if (!IS_LEX_NUMBER(*cp))
+				break;
+			cp++; n--;
+		}
+	}
+
+	return (n < m && IS_LEX_DELIMIT(*cp)) ? cp : 0;
+}
+
 
 /***********************************************************************
 **
@@ -1169,6 +1221,7 @@
 				}
 			}
 			if (*cp == '{') { /* BINARY #{12343132023902902302938290382} */
+		scan_binary:
 				scan_state->end = scan_state->begin;  /* save start */
 				scan_state->begin = cp;
 				// Originally there was used Scan_Quote collecting into BUF_MOLD, but this was not used later.
@@ -1212,12 +1265,42 @@
 		if (HAS_LEX_FLAG(flags, LEX_SPECIAL_AT)) return TOKEN_EMAIL;
 		if (HAS_LEX_FLAG(flags, LEX_SPECIAL_POUND)) {
 			if (cp == scan_state->begin) { // no +2 +16 +64 allowed
+				REBINT base = 0;
+				REBYTE c0 = cp[0];
 				if (
-					   (cp[0] == '6' && cp[1] == '4' && cp[2] == '#' && cp[3] == '{')
-					|| (cp[0] == '1' && cp[1] == '6' && cp[2] == '#' && cp[3] == '{') // rare
-				) {cp += 2; goto pound;}
-				if (cp[0] == '2' && cp[1] == '#' && cp[2] == '{')
-					{cp++; goto pound;} // very rare
+					   (c0 == '6' && cp[1] == '4' && cp[2] == '#')
+					|| (c0 == '1' && cp[1] == '6' && cp[2] == '#') // rare
+				) {
+					cp += 3;
+					if (cp[0] == '{') goto scan_binary;
+					if (c0 == '1') base = 16;
+				}
+				else if (cp[1] == '#') {
+					cp += 2;
+					if (c0 == '2') {
+						if (cp[0] == '{') goto scan_binary;   // very rare
+						base = 2;
+					}
+					else if (c0 == '0') {
+						base = 16;
+					}
+					else if (c0 == '8') {
+						base = 8;
+					}
+				}
+				else if (c0 == '1' && cp[1] == '0' && cp[2] == '#') // ultra rare
+				{
+					cp += 3;
+					base = 10;
+				}
+				
+				if (base) {
+					np = Prescan_Spec_Integer(cp, base);
+					if (np) {
+						scan_state->end = np;
+						return TOKEN_INTEGER_SPEC;
+					}
+				}
 			}
 
 #ifndef USE_NO_INFINITY
@@ -1744,6 +1827,10 @@ extern REBSER *Scan_Full_Block(SCAN_STATE *scan_state, REBYTE mode_char);
 			if(!MT_Map(value, value, 0)) Trap1(RE_INVALID_ARG, value);
 			break;
 
+		case TOKEN_INTEGER_SPEC:
+			Scan_Spec_Integer(bp, len, value);
+			break;
+
 		case TOKEN_EOF: continue;
 
 		default: ;

src/core/l-types.c

@@ -910,6 +910,67 @@ bad_hex:	Trap0(RE_INVALID_CHARS);
 	return ep;
 }
 
+/***********************************************************************
+**
+*/	const REBYTE *Scan_Spec_Integer(const REBYTE *cp, REBINT len, REBVAL *value)
+/*
+**		Scan and convert bit, octal, decimal or hexadecimal integer.
+**
+**		The input is expected to be pre-validated from l-scan!
+**
+***********************************************************************/
+{
+	REBU64 accum = 0;
+
+	if (*cp == '0') {
+		// base16: 0#beaf
+		cp  += 2;
+		len -= 2;
+base16:
+		while (len-- > 0) {
+			accum = (accum << 4) + (Lex_Map[*cp] & LEX_VALUE); // char num encoded into lex
+			cp++;
+		}
+	}
+	else if (*cp == '2') {
+		// base2: 2#0101
+		cp += 2;
+		len -= 2;
+		while (len-- > 0) {
+			accum *= 2;
+			if (*cp == '1') accum += 1;
+			cp++;
+		}
+	}
+	else if (*cp == '8') {
+		// base8: 8#140
+		cp += 2;
+		len -= 2;
+		while (len-- > 0) {
+			accum = (accum * 8) + (*cp - '0');
+			cp++;
+		}
+	}
+	else if (cp[1] == '6') {
+		// base16: 16#beaf
+		cp  += 3;
+		len -= 3;
+		goto base16;
+	}
+	else if (cp[1] == '0') {
+		// base10: 10#123
+		cp += 3;
+		len -= 3;
+		while (len-- > 0) {
+			accum = (accum * 10) + (*cp - '0');
+			cp++;
+		}
+	}
+	VAL_UNT64(value) = accum;
+	VAL_SET(value, REB_INTEGER);
+	return cp;
+}
+
 
 /***********************************************************************
 **

src/include/sys-scan.h

@@ -63,6 +63,7 @@ enum Value_Types {
 	TOKEN_REFINE,
 	TOKEN_CONSTRUCT,
 	TOKEN_MAP,
+	TOKEN_INTEGER_SPEC,
 	TOKEN_MAX
 };
 
@@ -99,7 +100,8 @@ const char *Token_Names[TOKEN_MAX] = {
  "PATH",
  "REFINE",
  "CONSTRUCT",
- "MAP"
+ "MAP",
+ "INTEGER_SPEC"
 };
 #endif
 

src/tests/units/lexer-test.r3

@@ -438,6 +438,52 @@ Rebol [
 	--test-- "-0"
 		--assert 0 = load "-0" ;@@ https://github.com/Oldes/Rebol-issues/issues/33
 
+===end-group===
+
+===start-group=== "Integer (bit/octal/decimal/hexadecimal)"
+	;@@ https://github.com/Oldes/Rebol-issues/issues/2197
+	--test-- "base2"
+		--assert  1 = transcode/one "2#01"
+		--assert  1 = transcode/one "2#01[]"
+		--assert  1 = transcode/one "2#01{}"
+		--assert  3 = transcode/one "2#11"
+		--assert  3 = transcode/one "2#011"
+		--assert  3 = transcode/one "2#000011"
+		--assert -1 = transcode/one "2#1111111111111111111111111111111111111111111111111111111111111111"
+		--assert error? transcode/one/error "2#12"
+		--assert error? transcode/one/error "2#11111111111111111111111111111111111111111111111111111111111111111"
+		--assert error? transcode/one/error "-2#11"
+	--test-- "base8"
+		--assert 666 = transcode/one "8#1232"
+		--assert 502 = transcode/one "8#766"
+		--assert  -1 = transcode/one "8#7777777777777777777777"
+		--assert error? transcode/one/error "8#88"
+		--assert error? transcode/one/error "8#77777777777777777777777"
+		--assert error? transcode/one/error "-8#123"
+	--test-- "base10"
+		--assert 123 = transcode/one "10#123"
+		--assert 999999999999999999 = transcode/one "10#999999999999999999"
+		--assert error? transcode/one/error "10#9999999999999999999"
+		--assert error? transcode/one/error "10#1A2"
+		--assert error? transcode/one/error "-10#123"
+	--test-- "base16"
+		--assert  15 = transcode/one "0#F"
+		--assert  15 = transcode/one "0#0F"
+		--assert 255 = transcode/one "0#FF"
+		--assert  -1 = transcode/one "0#FFFFFFFFFFFFFFFF"
+		--assert error? transcode/one/error "0#XA"
+		--assert error? transcode/one/error "0#FFFFFFFFFFFFFFFFF"
+		--assert error? transcode/one/error "-0#FF"
+		--assert  15 = transcode/one "16#F"
+		--assert  15 = transcode/one "16#0F"
+		--assert 255 = transcode/one "16#FF"
+		--assert  -1 = transcode/one "16#FFFFFFFFFFFFFFFF"
+		--assert error? transcode/one/error "16#XA"
+		--assert error? transcode/one/error "16#FFFFFFFFFFFFFFFFF"
+		--assert error? transcode/one/error "-16#FF"
+
+
+
 ===end-group===