support '(a b c) syntax for quoting

jaz303 · Jan 7, 2012 · ba8593c · ba8593c
1 parent e11c23f
commit ba8593c
Show file tree

Hide file tree

Showing 6 changed files with 41 additions and 17 deletions.
diff --git a/include/lispy/lispy.h b/include/lispy/lispy.h
@@ -28,6 +28,7 @@ typedef enum token {
 	T_ATOM			=  7,
 	T_IDENT			=  8,
 	T_NIL           =  9,
+	T_QUOTE         =  10,
 } token_t;
 
 /* Forward Declarations */

diff --git a/include/lispy/parser.h b/include/lispy/parser.h
@@ -4,6 +4,6 @@
 #include "lispy/lispy.h"
 
 int         parser_init(parser_t *parser, lexer_t *lexer, env_t *env);
-list_t*     parser_parse(parser_t *parser);
+VALUE       parser_parse(parser_t *parser);
 
 #endif
diff --git a/src/lexer.c b/src/lexer.c
@@ -273,6 +273,7 @@ token_t lexer_next(lexer_t *l) {
 		case 0:		{ emit(T_EOF); }
 		case '(':	{ next(); emit(T_L_PAREN); }
 		case ')':	{ next(); emit(T_R_PAREN); }
+        case '\'':  { next(); emit(T_QUOTE); }
 		case '"':	return scan_string(l);
 		case '#':	return scan_boolean_or_nil(l);
 		case ':':	return scan_atom(l);

diff --git a/src/lispy.c b/src/lispy.c
@@ -43,9 +43,12 @@ int main(int argc, char *argv[]) {
 
                     parser_init(&parser, &lexer, &env);
 
-                    list_t *list = parser_parse(&parser);
-                    if (list) {
-                        out = eval(&env, &env.binding, list);
+                    VALUE value = parser_parse(&parser);
+                    if (IS_LIST(value)) {
+                        out = eval(&env, &env.binding, value);
+                    } else if (value != NULL) {
+                        printf("error: top level object must be list\n");
+                        exit(1);
                     } else {
                         printf("parse error: %s\n", parser.error);
                         exit(1);

diff --git a/src/parser.c b/src/parser.c
@@ -22,17 +22,17 @@ int parser_init(parser_t *p, lexer_t *lexer, env_t *env) {
     return 1;
 }
 
-list_t *parser_parse(parser_t *p) {
+VALUE parser_parse(parser_t *p) {
 	lexer_next(p->lexer);
-	list_t *ast;
-	if (parse_list(p, &ast)) {
-		if (accept_tok(T_EOF)) {
-			return ast;
-		} else {
-			PARSE_ERROR("expecting EOF");
-		}
+    VALUE ast;
+	if (parse_value(p, &ast)) {
+	    if (accept_tok(T_EOF)) {
+            return ast;
+	    } else {
+            PARSE_ERROR("expecting EOF");
+	    }
 	}
-	return NULL;
+    return kError;
 }
 
 struct tmp_list_node;
@@ -122,6 +122,26 @@ int parse_value(parser_t *p, VALUE *value) {
 		{
 			return parse_list(p, (list_t**)value);
 		}
+		case T_QUOTE:
+		{
+		    accept();
+
+            list_t *to_quote;
+            if (!parse_list(p, &to_quote)) {
+                return 0;
+            }
+
+            *value = gc_alloc_list(&p->env->gc, 2);
+            if (!*value) {
+                PARSE_ERROR("failed to allocate list object");
+                return 0;
+            }
+
+            list_set(*value, 0, MK_IDENT(intern_table_put(&p->env->intern, "quote")));
+            list_set(*value, 1, to_quote);
+
+            return 1;
+        }
 		case T_TRUE:
 		{
 			*value = kTrue;

diff --git a/src/repl.c b/src/repl.c
@@ -29,13 +29,12 @@ void repl_run(env_t *env) {
         lexer_reset(&lexer, buffer);
         parser_init(&parser, &lexer, env);
 
-        list_t *list = parser_parse(&parser);
-
-        if (list) {
+        VALUE value = parser_parse(&parser);
+        if (value != kError) {
             if (setjmp(env->error_jmp)) {
                 printf("Error: %s\n", env->error);
             } else {
-                pretty_print(env, eval(env, &env->binding, list), 0);
+                pretty_print(env, eval(env, &env->binding, value), 0);
             }
         } else {
             printf("parse error: %s\n", parser.error);