From: Keith Packard <keithp@keithp.com>
Date: Thu, 4 Jan 2018 10:27:11 +0000 (-0800)
Subject: altos/scheme: Accept more escaped character constants
X-Git-Tag: 1.8.5~1^2~2^2~20
X-Git-Url: https://git.gag.com/?p=fw%2Faltos;a=commitdiff_plain;h=d34f01110d8770ac99556901143a54c3d492cde0

altos/scheme: Accept more escaped character constants

Allow all those specified in r7rs

Signed-off-by: Keith Packard <keithp@keithp.com>
---

diff --git a/src/scheme/ao_scheme_read.c b/src/scheme/ao_scheme_read.c
index 7d540aa5..f7e95a63 100644
--- a/src/scheme/ao_scheme_read.c
+++ b/src/scheme/ao_scheme_read.c
@@ -110,7 +110,7 @@ static const uint16_t	lex_classes[128] = {
 	PRINTABLE,		/*  Y */
 	PRINTABLE,		/*  Z */
 	PRINTABLE,		/*  [ */
-	PRINTABLE|BACKSLASH,	/*  \ */
+	PRINTABLE,		/*  \ */
 	PRINTABLE,		/*  ] */
 	PRINTABLE,		/*  ^ */
 	PRINTABLE,		/*  _ */
@@ -204,18 +204,20 @@ lex_quoted(void)
 	lex_class = 0;
 	c &= 0x7f;
  	switch (c) {
-	case 'n':
-		return '\n';
-	case 'f':
-		return '\f';
+	case 'a':
+		return '\a';
 	case 'b':
 		return '\b';
+	case 't':
+		return '\t';
+	case 'n':
+		return '\n';
 	case 'r':
 		return '\r';
+	case 'f':
+		return '\f';
 	case 'v':
 		return '\v';
-	case 't':
-		return '\t';
 	case '0':
 	case '1':
 	case '2':
@@ -422,7 +424,7 @@ _lex(void)
 		if (lex_class & STRINGC) {
 			for (;;) {
 				c = lexc();
-				if (lex_class & BACKSLASH)
+				if (c == '\\')
 					c = lex_quoted();
 				if (lex_class & (STRINGC|ENDOFFILE)) {
 					end_token();
@@ -636,7 +638,7 @@ ao_scheme_read(void)
 				v = _ao_scheme_bool_false;
 			break;
 		case STRING:
-			string = ao_scheme_string_make(token_string);
+			string = ao_scheme_string_new(token_string);
 			if (string)
 				v = ao_scheme_string_poly(string);
 			else
diff --git a/src/scheme/ao_scheme_read.h b/src/scheme/ao_scheme_read.h
index d0b9b36a..209a3a87 100644
--- a/src/scheme/ao_scheme_read.h
+++ b/src/scheme/ao_scheme_read.h
@@ -63,9 +63,8 @@
 # define ENDOFFILE	0x0080	/* end of file */
 # define COMMENT	0x0100	/* ; */
 # define IGNORE		0x0200	/* \0 - ' ' */
-# define BACKSLASH	0x0400	/* \ */
-# define STRINGC	0x0800	/* " */
-# define HEX_LETTER	0x1000	/* a-f A-F */
+# define STRINGC	0x0400	/* " */
+# define HEX_LETTER	0x0800	/* a-f A-F */
 
 # define NOTNAME	(STRINGC|COMMENT|ENDOFFILE|WHITE|SPECIAL)
 # define INTEGER	(DIGIT|SIGN)