X-Git-Url: https://git.gag.com/?a=blobdiff_plain;f=src%2Flisp%2Fao_lisp_read.c;h=8c06e19898f93c2300e60711396063f1666eb50a;hb=e1acf5eb12aceda7aa838df031c1da1129d0fa5d;hp=ccb4ba3a896deacfacb0f00b361489700fb264d6;hpb=e2f4d25cd6f6f3787d4ee99264732d5b2ce23d4c;p=fw%2Faltos

diff --git a/src/lisp/ao_lisp_read.c b/src/lisp/ao_lisp_read.c
index ccb4ba3a..8c06e198 100644
--- a/src/lisp/ao_lisp_read.c
+++ b/src/lisp/ao_lisp_read.c
@@ -51,18 +51,18 @@ static const uint16_t	lex_classes[128] = {
 	PRINTABLE|WHITE,	/*    */
  	PRINTABLE,		/* ! */
  	PRINTABLE|STRINGC,	/* " */
- 	PRINTABLE|COMMENT,	/* # */
+ 	PRINTABLE|POUND,	/* # */
  	PRINTABLE,		/* $ */
  	PRINTABLE,		/* % */
  	PRINTABLE,		/* & */
- 	PRINTABLE|QUOTEC,	/* ' */
- 	PRINTABLE|BRA,		/* ( */
- 	PRINTABLE|KET,		/* ) */
+ 	PRINTABLE|SPECIAL,	/* ' */
+ 	PRINTABLE|SPECIAL,	/* ( */
+ 	PRINTABLE|SPECIAL,	/* ) */
  	PRINTABLE,		/* * */
  	PRINTABLE|SIGN,		/* + */
  	PRINTABLE,		/* , */
  	PRINTABLE|SIGN,		/* - */
- 	PRINTABLE,		/* . */
+ 	PRINTABLE|SPECIAL,	/* . */
  	PRINTABLE,		/* / */
  	PRINTABLE|DIGIT,	/* 0 */
  	PRINTABLE|DIGIT,	/* 1 */
@@ -142,7 +142,7 @@ static const uint16_t	lex_classes[128] = {
 	PRINTABLE,		/*  { */
 	PRINTABLE|VBAR,		/*  | */
 	PRINTABLE,		/*  } */
-	PRINTABLE|TWIDDLE,	/*  ~ */
+	PRINTABLE,		/*  ~ */
 	IGNORE,			/*  ^? */
 };
 
@@ -155,8 +155,9 @@ lex_get()
 	if (lex_unget_c) {
 		c = lex_unget_c;
 		lex_unget_c = 0;
-	} else
-		c = getchar();
+	} else {
+		c = ao_lisp_getc();
+	}
 	return c;
 }
 
@@ -167,18 +168,38 @@ lex_unget(int c)
 		lex_unget_c = c;
 }
 
+static uint16_t	lex_class;
+
+static int
+lexc(void)
+{
+	int	c;
+	do {
+		c = lex_get();
+		if (c == EOF) {
+			c = 0;
+			lex_class = ENDOFFILE;
+		} else {
+			c &= 0x7f;
+			lex_class = lex_classes[c];
+		}
+	} while (lex_class & IGNORE);
+	return c;
+}
+
 static int
-lex_quoted (void)
+lex_quoted(void)
 {
 	int	c;
 	int	v;
 	int	count;
 
 	c = lex_get();
-//	if (jumping)
-//		return nil;
-	if (c == EOF)
-		return EOF;
+	if (c == EOF) {
+		lex_class = ENDOFFILE;
+		return 0;
+	}
+	lex_class = 0;
 	c &= 0x7f;
  	switch (c) {
 	case 'n':
@@ -205,8 +226,6 @@ lex_quoted (void)
 		count = 1;
 		while (count <= 3) {
 			c = lex_get();
-//			if (jumping)
-//				return nil;
 			if (c == EOF)
 				return EOF;
 			c &= 0x7f;
@@ -223,32 +242,6 @@ lex_quoted (void)
 	}
 }
 
-static uint16_t	lex_class;
-
-static int
-lexc(void)
-{
-	int	c;
-	do {
-		c = lex_get();
-		if (c == EOF) {
-			lex_class = ENDOFFILE;
-			c = 0;
-		} else {
-			c &= 0x7f;
-			lex_class = lex_classes[c];
-			if (lex_class & BACKSLASH) {
-				c = lex_quoted();
-				if (c == EOF)
-					lex_class = ENDOFFILE;
-				else
-					lex_class = PRINTABLE;
-			}
-		}
-	} while (lex_class & IGNORE);
-	return c;
-}
-
 #define AO_LISP_TOKEN_MAX	32
 
 static char	token_string[AO_LISP_TOKEN_MAX];
@@ -265,7 +258,7 @@ static inline void end_token(void) {
 }
 
 static int
-lex(void)
+_lex(void)
 {
 	int	c;
 
@@ -273,34 +266,89 @@ lex(void)
 	for (;;) {
 		c = lexc();
 		if (lex_class & ENDOFFILE)
-			return AO_LISP_NIL;
+			return END;
 
-//		if (jumping)
-//			return nil;
 		if (lex_class & WHITE)
 			continue;
 
-		if (lex_class & (BRA|KET|QUOTEC)) {
+		if (lex_class & COMMENT) {
+			while ((c = lexc()) != '\n') {
+				if (lex_class & ENDOFFILE)
+					return END;
+			}
+			continue;
+		}
+
+		if (lex_class & SPECIAL) {
 			add_token(c);
 			end_token();
 			switch (c) {
 			case '(':
+			case '[':
 				return OPEN;
 			case ')':
+			case ']':
 				return CLOSE;
 			case '\'':
 				return QUOTE;
+			case '.':
+				return DOT;
 			}
 		}
-		if (lex_class & TWIDDLE) {
-			token_int = lexc();
-			return NUM;
+		if (lex_class & POUND) {
+			c = lexc();
+			switch (c) {
+			case 't':
+				add_token(c);
+				end_token();
+				return BOOL;
+			case 'f':
+				add_token(c);
+				end_token();
+				return BOOL;
+			case '\\':
+				for (;;) {
+					int alphabetic;
+					c = lexc();
+					alphabetic = (('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z'));
+					if (token_len == 0) {
+						add_token(c);
+						if (!alphabetic)
+							break;
+					} else {
+						if (alphabetic)
+							add_token(c);
+						else {
+							lex_unget(c);
+							break;
+						}
+					}
+				}
+				end_token();
+				if (token_len == 1)
+					token_int = token_string[0];
+				else if (!strcmp(token_string, "space"))
+					token_int = ' ';
+				else if (!strcmp(token_string, "newline"))
+					token_int = '\n';
+				else if (!strcmp(token_string, "tab"))
+					token_int = '\t';
+				else if (!strcmp(token_string, "return"))
+					token_int = '\r';
+				else if (!strcmp(token_string, "formfeed"))
+					token_int = '\f';
+				else {
+					ao_lisp_error(AO_LISP_INVALID, "invalid character token #\\%s", token_string);
+					continue;
+				}
+				return NUM;
+			}
 		}
 		if (lex_class & STRINGC) {
 			for (;;) {
 				c = lexc();
-//				if (jumping)
-//					return nil;
+				if (lex_class & BACKSLASH)
+					c = lex_quoted();
 				if (lex_class & (STRINGC|ENDOFFILE)) {
 					end_token();
 					return STRING;
@@ -336,8 +384,6 @@ lex(void)
 				}
 				add_token (c);
 				c = lexc ();
-//				if (jumping)
-//					return nil;
 				if (lex_class & (NOTNAME)) {
 //					if (lex_class & ENDOFFILE)
 //						clearerr (f);
@@ -356,41 +402,92 @@ lex(void)
 	}
 }
 
+static inline int lex(void)
+{
+	int	parse_token = _lex();
+	DBGI("token %d (%s)\n", parse_token, token_string);
+	return parse_token;
+}
+
 static int parse_token;
-static uint8_t			been_here;
-static struct ao_lisp_cons	*read_cons;
-static struct ao_lisp_cons	*read_cons_tail;
-static struct ao_lisp_cons	*read_stack;
 
-static ao_lisp_poly
-read_item(void)
+struct ao_lisp_cons	*ao_lisp_read_cons;
+struct ao_lisp_cons	*ao_lisp_read_cons_tail;
+struct ao_lisp_cons	*ao_lisp_read_stack;
+
+#define READ_IN_QUOTE	0x01
+#define READ_SAW_DOT	0x02
+#define READ_DONE_DOT	0x04
+
+static int
+push_read_stack(int cons, int read_state)
+{
+	DBGI("push read stack %p 0x%x\n", ao_lisp_read_cons, read_state);
+	DBG_IN();
+	if (cons) {
+		ao_lisp_read_stack = ao_lisp_cons_cons(ao_lisp_cons_poly(ao_lisp_read_cons),
+						       ao_lisp__cons(ao_lisp_int_poly(read_state),
+								     ao_lisp_cons_poly(ao_lisp_read_stack)));
+		if (!ao_lisp_read_stack)
+			return 0;
+	}
+	ao_lisp_read_cons = NULL;
+	ao_lisp_read_cons_tail = NULL;
+	return 1;
+}
+
+static int
+pop_read_stack(int cons)
+{
+	int	read_state = 0;
+	if (cons) {
+		ao_lisp_read_cons = ao_lisp_poly_cons(ao_lisp_read_stack->car);
+		ao_lisp_read_stack = ao_lisp_poly_cons(ao_lisp_read_stack->cdr);
+		read_state = ao_lisp_poly_int(ao_lisp_read_stack->car);
+		ao_lisp_read_stack = ao_lisp_poly_cons(ao_lisp_read_stack->cdr);
+		for (ao_lisp_read_cons_tail = ao_lisp_read_cons;
+		     ao_lisp_read_cons_tail && ao_lisp_read_cons_tail->cdr;
+		     ao_lisp_read_cons_tail = ao_lisp_poly_cons(ao_lisp_read_cons_tail->cdr))
+			;
+	} else {
+		ao_lisp_read_cons = 0;
+		ao_lisp_read_cons_tail = 0;
+		ao_lisp_read_stack = 0;
+	}
+	DBG_OUT();
+	DBGI("pop read stack %p %d\n", ao_lisp_read_cons, read_state);
+	return read_state;
+}
+
+ao_poly
+ao_lisp_read(void)
 {
 	struct ao_lisp_atom	*atom;
 	char			*string;
 	int			cons;
-	ao_lisp_poly		v;
+	int			read_state;
+	ao_poly			v;
 
-	if (!been_here) {
-		ao_lisp_root_add(&ao_lisp_cons_type, &read_cons);
-		ao_lisp_root_add(&ao_lisp_cons_type, &read_cons_tail);
-		ao_lisp_root_add(&ao_lisp_cons_type, &read_stack);
-	}
 
 	cons = 0;
-	read_cons = read_cons_tail = read_stack = 0;
+	read_state = 0;
+	ao_lisp_read_cons = ao_lisp_read_cons_tail = ao_lisp_read_stack = 0;
 	for (;;) {
+		parse_token = lex();
 		while (parse_token == OPEN) {
-			if (cons++)
-				read_stack = ao_lisp_cons(ao_lisp_cons_poly(read_cons), read_stack);
-			read_cons = NULL;
-			read_cons_tail = NULL;
+			if (!push_read_stack(cons, read_state))
+				return AO_LISP_NIL;
+			cons++;
+			read_state = 0;
 			parse_token = lex();
 		}
 
 		switch (parse_token) {
-		case ENDOFFILE:
+		case END:
 		default:
-			v = AO_LISP_NIL;
+			if (cons)
+				ao_lisp_error(AO_LISP_EOF, "unexpected end of file");
+			return _ao_lisp_atom_eof;
 			break;
 		case NAME:
 			atom = ao_lisp_atom_intern(token_string);
@@ -402,6 +499,12 @@ read_item(void)
 		case NUM:
 			v = ao_lisp_int_poly(token_int);
 			break;
+		case BOOL:
+			if (token_string[0] == 't')
+				v = _ao_lisp_bool_true;
+			else
+				v = _ao_lisp_bool_false;
+			break;
 		case STRING:
 			string = ao_lisp_string_copy(token_string);
 			if (string)
@@ -409,40 +512,67 @@ read_item(void)
 			else
 				v = AO_LISP_NIL;
 			break;
+		case QUOTE:
+			if (!push_read_stack(cons, read_state))
+				return AO_LISP_NIL;
+			cons++;
+			read_state = READ_IN_QUOTE;
+			v = _ao_lisp_atom_quote;
+			break;
 		case CLOSE:
-			if (cons)
-				v = ao_lisp_cons_poly(read_cons);
-			else
+			if (!cons) {
 				v = AO_LISP_NIL;
-			if (--cons) {
-				read_cons = ao_lisp_poly_cons(read_stack->car);
-				read_stack = read_stack->cdr;
-				for (read_cons_tail = read_cons;
-				     read_cons_tail && read_cons_tail->cdr;
-				     read_cons_tail = read_cons_tail->cdr)
-					;
+				break;
 			}
+			v = ao_lisp_cons_poly(ao_lisp_read_cons);
+			--cons;
+			read_state = pop_read_stack(cons);
 			break;
+		case DOT:
+			if (!cons) {
+				ao_lisp_error(AO_LISP_INVALID, ". outside of cons");
+				return AO_LISP_NIL;
+			}
+			if (!ao_lisp_read_cons) {
+				ao_lisp_error(AO_LISP_INVALID, ". first in cons");
+				return AO_LISP_NIL;
+			}
+			read_state |= READ_SAW_DOT;
+			continue;
 		}
 
-		if (!cons)
-			break;
+		/* loop over QUOTE ends */
+		for (;;) {
+			if (!cons)
+				return v;
 
-		struct ao_lisp_cons	*read = ao_lisp_cons(v, NULL);
-		if (read_cons_tail)
-			read_cons_tail->cdr = read;
-		else
-			read_cons = read;
-		read_cons_tail = read;
+			if (read_state & READ_DONE_DOT) {
+				ao_lisp_error(AO_LISP_INVALID, ". not last in cons");
+				return AO_LISP_NIL;
+			}
 
-		parse_token = lex();
+			if (read_state & READ_SAW_DOT) {
+				read_state |= READ_DONE_DOT;
+				ao_lisp_read_cons_tail->cdr = v;
+			} else {
+				struct ao_lisp_cons	*read = ao_lisp_cons_cons(v, AO_LISP_NIL);
+				if (!read)
+					return AO_LISP_NIL;
+
+				if (ao_lisp_read_cons_tail)
+					ao_lisp_read_cons_tail->cdr = ao_lisp_cons_poly(read);
+				else
+					ao_lisp_read_cons = read;
+				ao_lisp_read_cons_tail = read;
+			}
+
+			if (!(read_state & READ_IN_QUOTE) || !ao_lisp_read_cons->cdr)
+				break;
+
+			v = ao_lisp_cons_poly(ao_lisp_read_cons);
+			--cons;
+			read_state = pop_read_stack(cons);
+		}
 	}
 	return v;
 }
-
-ao_lisp_poly
-ao_lisp_read(void)
-{
-	parse_token = lex();
-	return read_item();
-}