X-Git-Url: https://git.gag.com/?a=blobdiff_plain;f=src%2Flisp%2Fao_lisp_read.c;h=0ca12a81f6fcc843c24ba2f046970f7e8a83a37c;hb=ed6967cef5d82baacafe1c23229f44d58c838326;hp=c5a238cc5513132bbbda6107173995d3335e3dfa;hpb=6d2f271a45759bd792d299f04a424d3382ef4798;p=fw%2Faltos

diff --git a/src/lisp/ao_lisp_read.c b/src/lisp/ao_lisp_read.c
index c5a238cc..0ca12a81 100644
--- a/src/lisp/ao_lisp_read.c
+++ b/src/lisp/ao_lisp_read.c
@@ -15,6 +15,7 @@
 #include "ao_lisp.h"
 #include "ao_lisp_read.h"
 #include <math.h>
+#include <stdlib.h>
 
 static const uint16_t	lex_classes[128] = {
 	IGNORE,		/* ^@ */
@@ -61,7 +62,7 @@ static const uint16_t	lex_classes[128] = {
  	PRINTABLE|SPECIAL,	/* ) */
  	PRINTABLE,		/* * */
  	PRINTABLE|SIGN,		/* + */
- 	PRINTABLE,		/* , */
+ 	PRINTABLE|SPECIAL,	/* , */
  	PRINTABLE|SIGN,		/* - */
  	PRINTABLE|DOTC|FLOATC,	/* . */
  	PRINTABLE,		/* / */
@@ -113,7 +114,7 @@ static const uint16_t	lex_classes[128] = {
 	PRINTABLE,		/*  ] */
 	PRINTABLE,		/*  ^ */
 	PRINTABLE,		/*  _ */
-  	PRINTABLE,		/*  ` */
+  	PRINTABLE|SPECIAL,	/*  ` */
 	PRINTABLE,		/*  a */
 	PRINTABLE,		/*  b */
 	PRINTABLE,		/*  c */
@@ -314,6 +315,18 @@ _lex(void)
 				return QUOTE;
 			case '.':
 				return DOT;
+			case '`':
+				return QUASIQUOTE;
+			case ',':
+				c = lexc();
+				if (c == '@') {
+					add_token(c);
+					end_token();
+					return UNQUOTE_SPLICING;
+				} else {
+					lex_unget(c);
+					return UNQUOTE;
+				}
 			}
 		}
 		if (lex_class & POUND) {
@@ -433,7 +446,7 @@ _lex(void)
 						return NUM;
 					}
 					if (isfloat && hasdigit) {
-						token_float = atof(token_string);
+						token_float = strtof(token_string, NULL);
 						return FLOAT;
 					}
 					for (u = 0; u < NUM_NAMED_FLOATS; u++)
@@ -451,7 +464,7 @@ _lex(void)
 static inline int lex(void)
 {
 	int	parse_token = _lex();
-	DBGI("token %d (%s)\n", parse_token, token_string);
+	RDBGI("token %d (%s)\n", parse_token, token_string);
 	return parse_token;
 }
 
@@ -468,8 +481,8 @@ struct ao_lisp_cons	*ao_lisp_read_stack;
 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();
+	RDBGI("push read stack %p 0x%x\n", ao_lisp_read_cons, read_state);
+	RDBG_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),
@@ -500,8 +513,8 @@ pop_read_stack(int cons)
 		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);
+	RDBG_OUT();
+	RDBGI("pop read stack %p %d\n", ao_lisp_read_cons, read_state);
 	return read_state;
 }
 
@@ -512,8 +525,7 @@ ao_lisp_read(void)
 	char			*string;
 	int			cons;
 	int			read_state;
-	ao_poly			v;
-
+	ao_poly			v = AO_LISP_NIL;
 
 	cons = 0;
 	read_state = 0;
@@ -562,11 +574,27 @@ ao_lisp_read(void)
 				v = AO_LISP_NIL;
 			break;
 		case QUOTE:
+		case QUASIQUOTE:
+		case UNQUOTE:
+		case UNQUOTE_SPLICING:
 			if (!push_read_stack(cons, read_state))
 				return AO_LISP_NIL;
 			cons++;
 			read_state = READ_IN_QUOTE;
-			v = _ao_lisp_atom_quote;
+			switch (parse_token) {
+			case QUOTE:
+				v = _ao_lisp_atom_quote;
+				break;
+			case QUASIQUOTE:
+				v = _ao_lisp_atom_quasiquote;
+				break;
+			case UNQUOTE:
+				v = _ao_lisp_atom_unquote;
+				break;
+			case UNQUOTE_SPLICING:
+				v = _ao_lisp_atom_unquote2dsplicing;
+				break;
+			}
 			break;
 		case CLOSE:
 			if (!cons) {