klisp

commit 748a1a9e59a4a46546f8a37f95e7d3a547a39ffe
parent d10c7ef4e1ae70ab4e6914ec24c6c66fa21d6340
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Mon, 14 Nov 2011 20:20:15 -0300

Added multi-line nestable comments (syntax: "#| ... |#").

Diffstat:
M
src/kstate.c
 | 
2
++
M
src/kstate.h
 | 
2
++
M
src/ktoken.c
 | 
66
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++------

3 files changed, 64 insertions(+), 6 deletions(-)
diff --git a/src/kstate.c b/src/kstate.c
@@ -180,6 +180,8 @@ klisp_State *klisp_newstate (klisp_Alloc f, void *ud) {
     K->ktok_source_info.line = 1; 
     K->ktok_source_info.col = 0;
 
+    K->ktok_nested_comments = 0;
+
     ktok_init(K);
 
     /* initialize reader */
diff --git a/src/kstate.h b/src/kstate.h
@@ -132,6 +132,8 @@ struct klisp_State {
     int32_t ktok_buffer_idx;
     char *ktok_buffer;
 
+    int32_t ktok_nested_comments;
+
     /* reader */
     /* TODO: replace the list with a hashtable */
     TValue shared_dict;
diff --git a/src/ktoken.c b/src/ktoken.c
@@ -26,7 +26,6 @@
 */
 #include <stdio.h>
 #include <stdlib.h>
-#include <assert.h>
 #include <string.h>
 #include <ctype.h>
 #include <stdint.h>
@@ -153,7 +152,6 @@ void ktok_error(klisp_State *K, char *str)
 ** Underlying stream interface & source code location tracking
 */
 
-/* TODO check for error if getc returns EOF */
 int ktok_getc(klisp_State *K) {
     /* WORKAROUND: for stdin line buffering & reading of EOF */
     /* Is this really necessary?? double check */
@@ -166,6 +164,7 @@ int ktok_getc(klisp_State *K) {
 	    if (ferror(K->curr_in) != 0) {
 		/* clear error marker to allow retries later */
 		clearerr(K->curr_in);
+/* TODO put error info on the error obj */
 		ktok_error(K, "reading error");
 		return 0;
 	    } else { /* if (feof(K->curr_in) != 0) */
@@ -240,6 +239,7 @@ void ktok_set_source_info(klisp_State *K, TValue filename, int32_t line,
 */
 void ktok_ignore_whitespace(klisp_State *K);
 void ktok_ignore_single_line_comment(klisp_State *K);
+void ktok_ignore_multi_line_comment(klisp_State *K);
 bool ktok_check_delimiter(klisp_State *K);
 TValue ktok_read_string(klisp_State *K);
 TValue ktok_read_special(klisp_State *K);
@@ -255,7 +255,7 @@ int ktok_read_until_delimiter(klisp_State *K);
 */
 TValue ktok_read_token(klisp_State *K)
 {
-    assert(ks_tbisempty(K));
+    klisp_assert(ks_tbisempty(K));
 
     while(true) {
 	ktok_ignore_whitespace(K);
@@ -293,12 +293,25 @@ TValue ktok_read_token(klisp_State *K)
 	case '#': {
 	    ktok_getc(K);
 	    chi = ktok_peekc(K);
-	    if ((chi != EOF) && (char) chi == '!') {
+	    
+	    if (chi == EOF) {
+		ktok_error(K, "# constant is too short");
+		/* avoid warning */
+		return KINERT;
+	    }
+
+	    switch((char) chi) {
+	    case '!': /* single line comment (alternative syntax) */
 		/* this handles the #! style script header too! */
 		ktok_ignore_single_line_comment(K);
 		continue;
-	    } else {
-		/* also handles EOF case */
+	    case '|': /* nested/multiline comment */
+		ktok_getc(K); /* discard the '|' */
+		klisp_assert(K->ktok_nested_comments == 0);
+		K->ktok_nested_comments = 1;
+		ktok_ignore_multi_line_comment(K);
+		continue;
+	    default:
 		return ktok_read_special(K);
 	    }
 	}
@@ -330,8 +343,12 @@ TValue ktok_read_token(klisp_State *K)
 	    ** identifier-first-char (in the cases above)
 	    */
 	    return ktok_read_identifier(K);
+	case '|':
+	    /* TODO put special error msg if it was an unpaired '|#'
+	       comment close */
 	default:
 	    ktok_getc(K);
+	    /* TODO add char to error */
 	    ktok_error(K, "unrecognized token starting char");
 	    /* avoid warning */
 	    return KINERT;
@@ -350,6 +367,43 @@ void ktok_ignore_single_line_comment(klisp_State *K)
     } while (chi != EOF && chi != '\n');
 }
 
+void ktok_ignore_multi_line_comment(klisp_State *K)
+{
+    /* the first "#|' was already read */
+    klisp_assert(K->ktok_nested_comments > 0);
+    int chi;
+    while(K->ktok_nested_comments > 0) {
+	do {
+	    chi = ktok_getc(K);
+	    if (chi == EOF)
+		goto eof_error;
+	} while (chi != '|' && chi != '#');
+
+	char first_char = (char) chi;
+
+	do {
+	    chi = ktok_getc(K);
+	    if (chi == EOF)
+		goto eof_error;
+	} while (chi == first_char);
+
+	if (chi == '#') {
+	    /* close comment (first char was '|', so the seq is "|#") */
+	    --K->ktok_nested_comments;
+	} else if (chi == '|') {
+	    /* open comment (first char was '#', so the seq is "#|") */
+	    klisp_assert(K->ktok_nested_comments < 1000);
+	    ++K->ktok_nested_comments;
+	} 
+        /* else lone '#' or '|', just continue */
+    }
+    return;
+eof_error:
+    /* TODO show number of open multi comments and source file info
+       of the last */
+    ktok_error(K, "unterminated multi line comment");
+}
+
 void ktok_ignore_whitespace(klisp_State *K)
 {
     /* NOTE: if it's not whitespace do nothing (even on eof) */