klisp

commit eea32057ab434149cd47c50f99cc898c1ac7f586
parent daf3604292113af11f269d25113edc52d75c1d1f
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Thu, 27 Oct 2011 14:50:12 -0300

Added support for a new single line comment syntax: '#!'. This also ignores the unix shell directive.

Diffstat:
M
src/kgports.c
 | 
4
----
M
src/kscript.c
 | 
24
------------------------
M
src/kscript.h
 | 
3
---
M
src/ktoken.c
 | 
19
+++++++++++++++----

4 files changed, 15 insertions(+), 35 deletions(-)
diff --git a/src/kgports.c b/src/kgports.c
@@ -331,10 +331,6 @@ void call_with_file(klisp_State *K, TValue *xparams, TValue ptree,
 /* GC: assume port is rooted */
 TValue read_all_expr(klisp_State *K, TValue port)
 {
-    /* support unix script directive #! */
-    int line_count = kscript_eat_directive(kport_file(port));
-    kport_line(port) += line_count;
-
     /* GC: root dummy and obj */
     TValue tail = kget_dummy1(K);
     TValue obj = KINERT;
diff --git a/src/kscript.c b/src/kscript.c
@@ -242,27 +242,3 @@ void kinit_script(klisp_State *K, int argc, char *argv[])
 #undef RSI
 #undef G
 }
-
-/* skips the unix script directive (#!), if present.
-   returns number of lines skipped */
-int kscript_eat_directive(FILE *fr)
-{
-  static const char pattern[] = "#! ";
-  int c, n = 0;
-
-  while (pattern[n] != '\0' && (c = getc(fr), c == pattern[n]))
-    n++;
-
-  if (pattern[n] == '\0') {
-    while (c = getc(fr), c != EOF && c != '\n')
-      ;
-    return 1;
-  } else {
-    ungetc(c, fr);
-    /* XXX/Temp notice that the standard doesn't guarantee that more than one
-       ungetc in a row will be honored. Andres Navarro */
-    while (n > 0)
-      ungetc(pattern[--n], fr);
-    return 0;
-  }
-}
diff --git a/src/kscript.h b/src/kscript.h
@@ -18,9 +18,6 @@ void kinit_script(klisp_State *K, int argc, char *argv[]);
 void do_script_exit(klisp_State *K, TValue *xparams, TValue obj);
 void do_script_error(klisp_State *K, TValue *xparams, TValue obj);
 
-/* unix script directive handling */
-int kscript_eat_directive(FILE *fr);
-
 /* default exit code in case of error according to SRFI-22 */
 
 #define KSCRIPT_DEFAULT_ERROR_EXIT_CODE   70
diff --git a/src/ktoken.c b/src/ktoken.c
@@ -290,8 +290,18 @@ TValue ktok_read_token(klisp_State *K)
 	case '"':
 	    return ktok_read_string(K);
 /* TODO use read_until_delimiter in all these cases */
-	case '#':
-	    return ktok_read_special(K);
+	case '#': {
+	    ktok_getc(K);
+	    chi = ktok_peekc(K);
+	    if ((chi != EOF) && (char) chi == '!') {
+		/* this handles the #! style script header too! */
+		ktok_ignore_single_line_comment(K);
+		continue;
+	    } else {
+		/* also handles EOF case */
+		return ktok_read_special(K);
+	    }
+	}
 	case '0': case '1': case '2': case '3': case '4': 
 	case '5': case '6': case '7': case '8': case '9': {
 	    /* positive number, no exactness or radix indicator */
@@ -562,8 +572,9 @@ struct kspecial_token {
 
 TValue ktok_read_special(klisp_State *K)
 {
-    /* the # is still pending (was only peeked) */
-    int32_t buf_len = ktok_read_until_delimiter(K);
+    /* the # is already consumed, add it manually */
+    ks_tbadd(K, '#');
+    int32_t buf_len = ktok_read_until_delimiter(K) + 1;
     char *buf = ks_tbget_buffer(K);
 
     if (buf_len < 2) {