X-Git-Url: https://git.gag.com/?a=blobdiff_plain;f=src%2Fscheme%2Fao_scheme_read.c;h=7d540aa5af22f26991dacd194371bbc9673215a6;hb=e030fba5ab556c88af918d08e1b62e63d6605638;hp=dce480ab1745197f0b858be9ef25b1bd57b6b846;hpb=d8c9024f3829dc3f241b16869f165f3ee01764f3;p=fw%2Faltos

diff --git a/src/scheme/ao_scheme_read.c b/src/scheme/ao_scheme_read.c
index dce480ab..7d540aa5 100644
--- a/src/scheme/ao_scheme_read.c
+++ b/src/scheme/ao_scheme_read.c
@@ -53,7 +53,7 @@ static const uint16_t	lex_classes[128] = {
 	PRINTABLE|WHITE,	/*    */
  	PRINTABLE,		/* ! */
  	PRINTABLE|STRINGC,	/* " */
- 	PRINTABLE|POUND,	/* # */
+ 	PRINTABLE,		/* # */
  	PRINTABLE,		/* $ */
  	PRINTABLE,		/* % */
  	PRINTABLE,		/* & */
@@ -83,12 +83,12 @@ static const uint16_t	lex_classes[128] = {
  	PRINTABLE,		/* > */
  	PRINTABLE,		/* ? */
   	PRINTABLE,		/*  @ */
-	PRINTABLE,		/*  A */
-	PRINTABLE,		/*  B */
-	PRINTABLE,		/*  C */
-	PRINTABLE,		/*  D */
-	PRINTABLE|FLOATC,	/*  E */
-	PRINTABLE,		/*  F */
+	PRINTABLE|HEX_LETTER,	/*  A */
+	PRINTABLE|HEX_LETTER,	/*  B */
+	PRINTABLE|HEX_LETTER,	/*  C */
+	PRINTABLE|HEX_LETTER,	/*  D */
+	PRINTABLE|FLOATC|HEX_LETTER,/*  E */
+	PRINTABLE|HEX_LETTER,	/*  F */
 	PRINTABLE,		/*  G */
 	PRINTABLE,		/*  H */
 	PRINTABLE,		/*  I */
@@ -115,12 +115,12 @@ static const uint16_t	lex_classes[128] = {
 	PRINTABLE,		/*  ^ */
 	PRINTABLE,		/*  _ */
   	PRINTABLE|SPECIAL_QUASI,	/*  ` */
-	PRINTABLE,		/*  a */
-	PRINTABLE,		/*  b */
-	PRINTABLE,		/*  c */
-	PRINTABLE,		/*  d */
-	PRINTABLE|FLOATC,	/*  e */
-	PRINTABLE,		/*  f */
+	PRINTABLE|HEX_LETTER,	/*  a */
+	PRINTABLE|HEX_LETTER,	/*  b */
+	PRINTABLE|HEX_LETTER,	/*  c */
+	PRINTABLE|HEX_LETTER,	/*  d */
+	PRINTABLE|FLOATC|HEX_LETTER,/*  e */
+	PRINTABLE|HEX_LETTER,	/*  f */
 	PRINTABLE,		/*  g */
 	PRINTABLE,		/*  h */
 	PRINTABLE,		/*  i */
@@ -284,6 +284,30 @@ static const struct namedfloat namedfloats[] = {
 #define NUM_NAMED_FLOATS	(sizeof namedfloats / sizeof namedfloats[0])
 #endif
 
+static int
+parse_int(int base)
+{
+	int	cval;
+	int	c;
+
+	token_int = 0;
+	for (;;) {
+		c = lexc();
+		if ((lex_class & HEX_DIGIT) == 0) {
+			lex_unget(c);
+			end_token();
+			return NUM;
+		}
+		add_token(c);
+		if ('0' <= c && c <= '9')
+			cval = c - '0';
+		else
+			cval = (c | ('a' - 'A')) - 'a' + 10;
+		token_int = token_int * base + cval;
+	}
+	return NUM;
+}
+
 static int
 _lex(void)
 {
@@ -336,7 +360,7 @@ _lex(void)
 #endif
 			}
 		}
-		if (lex_class & POUND) {
+		if (c == '#') {
 			c = lexc();
 			switch (c) {
 			case 't':
@@ -387,6 +411,12 @@ _lex(void)
 					continue;
 				}
 				return NUM;
+			case 'x':
+				return parse_int(16);
+			case 'o':
+				return parse_int(8);
+			case 'b':
+				return parse_int(2);
 			}
 		}
 		if (lex_class & STRINGC) {
@@ -486,7 +516,7 @@ _lex(void)
 static inline int lex(void)
 {
 	int	parse_token = _lex();
-	RDBGI("token %d (%s)\n", parse_token, token_string);
+	RDBGI("token %d \"%s\"\n", parse_token, token_string);
 	return parse_token;
 }
 
@@ -510,7 +540,7 @@ push_read_stack(int read_state)
 	RDBG_IN();
 	if (ao_scheme_read_list) {
 		ao_scheme_read_stack = ao_scheme_cons_cons(ao_scheme_cons_poly(ao_scheme_read_cons),
-						       ao_scheme__cons(ao_scheme_int_poly(read_state),
+						       ao_scheme_cons(ao_scheme_int_poly(read_state),
 								     ao_scheme_cons_poly(ao_scheme_read_stack)));
 		if (!ao_scheme_read_stack)
 			return 0;
@@ -535,10 +565,11 @@ pop_read_stack(void)
 		     ao_scheme_read_cons_tail = ao_scheme_poly_cons(ao_scheme_read_cons_tail->cdr))
 			;
 	} else {
-		ao_scheme_read_cons = 0;
-		ao_scheme_read_cons_tail = 0;
-		ao_scheme_read_stack = 0;
 		read_state = ao_scheme_read_state;
+		ao_scheme_read_cons = NULL;
+		ao_scheme_read_cons_tail = NULL;
+		ao_scheme_read_stack = NULL;
+		ao_scheme_read_state = 0;
 	}
 	RDBG_OUT();
 	RDBGI("pop read stack %p %d\n", ao_scheme_read_cons, read_state);
@@ -555,13 +586,13 @@ ao_poly
 ao_scheme_read(void)
 {
 	struct ao_scheme_atom	*atom;
-	char			*string;
+	struct ao_scheme_string	*string;
 	int			read_state;
 	ao_poly			v = AO_SCHEME_NIL;
 
 	ao_scheme_read_list = 0;
 	read_state = 0;
-	ao_scheme_read_cons = ao_scheme_read_cons_tail = ao_scheme_read_stack = 0;
+	ao_scheme_read_cons = ao_scheme_read_cons_tail = ao_scheme_read_stack = NULL;
 	for (;;) {
 		parse_token = lex();
 		while (is_open(parse_token)) {
@@ -605,7 +636,7 @@ ao_scheme_read(void)
 				v = _ao_scheme_bool_false;
 			break;
 		case STRING:
-			string = ao_scheme_string_copy(token_string);
+			string = ao_scheme_string_make(token_string);
 			if (string)
 				v = ao_scheme_string_poly(string);
 			else
@@ -647,8 +678,10 @@ ao_scheme_read(void)
 			--ao_scheme_read_list;
 			read_state = pop_read_stack();
 #ifdef AO_SCHEME_FEATURE_VECTOR
-			if (read_state & READ_SAW_VECTOR)
+			if (read_state & READ_SAW_VECTOR) {
 				v = ao_scheme_vector_poly(ao_scheme_list_to_vector(ao_scheme_poly_cons(v)));
+				read_state &= ~READ_SAW_VECTOR;
+			}
 #endif
 			break;
 		case DOT: