shithub: sl

Info  •  Files  •  Log  •  Branches

read: better whitespace handling

--- a/boot/sl.boot

+++ b/boot/sl.boot

@@ -426,8 +426,8 @@

                                                                   #fn(del!)) remprop)

             repl #fn("n0IIb4b5705042172514238424_5142385258485>2_51485<5047660:" #(*prompt* #fn(io-flush)

                                                                                    *io-out* #0#

-                                                                                   #fn("n02021{227351S;3q047484517585513M07584513@076504277851@30q@=079855147:5047;85w<61:" #(#fn("n02071D62:" #(#fn(read)

-  *io-in*)) #fn("n1207151422061:" #(#fn(io-discardbuffer) *io-in* #fn(raise)))

+                                                                                   #fn("n02021{227351S;3q047484517585513M07584513@076504277851@30q@=079855147:5047;85w<61:" #(#fn("n0207122D63:" #(#fn(read)

+  *io-in* :whitespace)) #fn("n1207151422061:" #(#fn(io-discardbuffer) *io-in* #fn(raise)))

   #fn(io-eof?) *io-in* load-process void? *prompt* #fn(io-flush) *io-out* print newline void that) prompt)

                                                                                    #fn("n020A>121{370F<60:q:" #(#fn("n0A<60:")

   #fn("n1700514D:" #(top-level-exception-handler))) reploop) newline) repl)

--- a/src/io.c

+++ b/src/io.c

@@ -6,7 +6,7 @@

 #include "io.h"

 static sl_v sl_linesym, sl_blocksym, sl_memorysym, sl_nonesym;

-static sl_v sl_ioinsym;

+static sl_v sl_ioinsym, sl_whitespace;

 sl_v sl_iooutsym;

 sl_type *sl_iotype;

@@ -146,11 +146,20 @@

 BUILTIN("read", read)

 {

-	if(nargs > 1)

-		argcount(nargs, 2);

+	bool ws = false;

+	if(nargs >= 2 && nargs <= 3){

+		int i;

+		if(args[i = 0] == sl_whitespace || (nargs > 2 && args[i = 1] == sl_whitespace)){

+			ws = args[++i] != sl_nil;

+			if(i < 2) // (read :whitespace T io)

+				args[0] = args[2];

+			nargs -= 2;

+		}

+	}

+	argcount(nargs, 1);

 	sl_v a = nargs == 0 ? sym_value(sl_ioinsym) : args[0];

 	sl_gc_handle(&a);

-	sl_v v = sl_read_sexpr(a, nargs > 1 && args[1] == sl_t);

+	sl_v v = sl_read_sexpr(a, ws);

 	sl_free_gc_handles(1);

 	return ios_eof(toio(a)) ? sl_eof : v;

 }

@@ -469,6 +478,7 @@

 	sl_linesym = mk_csym(":line");

 	sl_blocksym = mk_csym(":block");

 	sl_memorysym = mk_csym(":memory");

+	sl_whitespace = mk_csym(":whitespace");

 	sl_ioinsym = mk_csym("*io-in*");

 	sl_iooutsym = mk_csym("*io-out*");

 	sl_iotype = define_opaque_type(sl_iosym, sizeof(sl_ios), &io_vtable, nil);

--- a/src/read.c

+++ b/src/read.c

@@ -204,13 +204,16 @@

 	sl_fx x;

 	int ch, base;

-	if(ctx->toktype != TOK_NONE)

+	if(ctx->toktype != TOK_NONE){

+		ctx->ws = false;

 		return ctx->toktype;

+	}

 	c = nextchar(ctx);

 	ctx->loc = RS->loc;

-	ctx->ws = false;

-	if(ios_eof(RS) || isspace(c))

+	if(ios_eof(RS) || isspace(c)){

+		ctx->ws = false;

 		return TOK_NONE;

+	}

 	if(c == '(')

 		ctx->toktype = TOK_OPEN;

 	else if(c == ')')

@@ -346,6 +349,7 @@

 			    (c == 'x' && (base = 16))) && (isdigit_base(ctx->buf[1], base) || ctx->buf[1] == '-')){

 				if(!sl_read_numtok(&ctx->buf[1], &ctx->tokval, base))

 					parse_error(&ctx->loc, "invalid base %d constant", base);

+				ctx->ws = false;

 				return (ctx->toktype = TOK_NUM);

 			}

@@ -363,17 +367,23 @@

 			ctx->toktype = TOK_COMMAAT;

 		else if(ch == '.')

 			ctx->toktype = TOK_COMMADOT;

-		else

+		else{

+			ctx->ws = false;

 			return ctx->toktype;

+		}

 		ios_getc(RS);

 	}else{

 		bool ok = read_token(ctx, c, 0);

 		const char *s = ctx->buf;

 		if(!ok){

-			if(s[0] == '.' && s[1] == '\0')

+			if(s[0] == '.' && s[1] == '\0'){

+				ctx->ws = false;

 				return (ctx->toktype = TOK_DOT);

-			if(sl_read_numtok(s, &ctx->tokval, 0))

+			}

+			if(sl_read_numtok(s, &ctx->tokval, 0)){

+				ctx->ws = false;

 				return (ctx->toktype = TOK_NUM);

+			}

 		}

 		ctx->toktype = TOK_SYM;

 		if(strcasecmp(s, "nil") == 0)

@@ -388,6 +398,7 @@

 				ctx->toktype = TOK_GENSYM;

 		}

 	}

+	ctx->ws = false;

 	return ctx->toktype;

 }

--- a/src/system.sl

+++ b/src/system.sl

@@ -1346,7 +1346,7 @@

   (*prompt*)

   (io-flush *io-out*)

   (def (prompt)

-    (let ((v (trycatch (read *io-in* T)

+    (let ((v (trycatch (read *io-in* :whitespace T)

                        (λ (e) (io-discardbuffer *io-in*)

                               (raise e)))))

       (and (not (io-eof? *io-in*))