adding some error messages

adding io.seek, io.copyuntil
adding #\uHHHH hex character literal read syntax

femtolisp/flisp.c

@@ -81,7 +81,7 @@ uint32_t SP = 0;
 value_t NIL, FL_T, FL_F, LAMBDA, QUOTE, IF, TRYCATCH;
 value_t BACKQUOTE, COMMA, COMMAAT, COMMADOT;
 value_t IOError, ParseError, TypeError, ArgError, UnboundError, MemoryError;
-value_t DivideError, BoundsError, Error, KeyError;
+value_t DivideError, BoundsError, Error, KeyError, EnumerationError;
 value_t conssym, symbolsym, fixnumsym, vectorsym, builtinsym;
 value_t definesym, defmacrosym, forsym, labelsym, printprettysym, setqsym;
 value_t printwidthsym, tsym, Tsym, fsym, Fsym, booleansym, nullsym, elsesym;
@@ -1491,6 +1491,7 @@ static void lisp_init(void)
     MemoryError = symbol("memory-error");
     BoundsError = symbol("bounds-error");
     DivideError = symbol("divide-error");
+    EnumerationError = symbol("enumeration-error");
     Error = symbol("error");
     conssym = symbol("cons");
     symbolsym = symbol("symbol");

femtolisp/flisp.h

@@ -153,7 +153,7 @@ void lerror(value_t e, char *format, ...) __attribute__ ((__noreturn__));
 void raise(value_t e) __attribute__ ((__noreturn__));
 void type_error(char *fname, char *expected, value_t got) __attribute__ ((__noreturn__));
 void bounds_error(char *fname, value_t arr, value_t ind) __attribute__ ((__noreturn__));
-extern value_t ArgError, IOError, KeyError, MemoryError;
+extern value_t ArgError, IOError, KeyError, MemoryError, EnumerationError;
 static inline void argcount(char *fname, uint32_t nargs, uint32_t c)
 {
     if (__unlikely(nargs != c))

femtolisp/iostream.c

@@ -156,6 +156,17 @@ value_t fl_ioeof(value_t *args, u_int32_t nargs)
     return (ios_eof(s) ? FL_T : FL_F);
 }
 
+value_t fl_ioseek(value_t *args, u_int32_t nargs)
+{
+    argcount("io.seek", nargs, 2);
+    ios_t *s = toiostream(args[0], "io.seek");
+    size_t pos = toulong(args[1], "io.seek");
+    off_t res = ios_seek(s, (off_t)pos);
+    if (res == -1)
+        return FL_F;
+    return FL_T;
+}
+
 static void do_ioprint(value_t *args, u_int32_t nargs, int princ, char *fname)
 {
     if (nargs < 2)
@@ -227,6 +238,18 @@ value_t fl_dump(value_t *args, u_int32_t nargs)
     return FL_T;
 }
 
+static char get_delim_arg(value_t arg, char *fname)
+{
+    size_t uldelim = toulong(arg, fname);
+    if (uldelim > 0x7f) {
+        // wchars > 0x7f, or anything else > 0xff, are out of range
+        if ((iscprim(arg) && cp_class((cprim_t*)ptr(arg))==wchartype) ||
+            uldelim > 0xff)
+            lerror(ArgError, "%s: delimiter out of range", fname);
+    }
+    return (char)uldelim;
+}
+
 value_t fl_ioreaduntil(value_t *args, u_int32_t nargs)
 {
     argcount("io.readuntil", nargs, 2);
@@ -236,7 +259,7 @@ value_t fl_ioreaduntil(value_t *args, u_int32_t nargs)
     ios_t dest;
     ios_mem(&dest, 0);
     ios_setbuf(&dest, data, 80, 0);
-    char delim = (char)toulong(args[1], "io.readuntil");
+    char delim = get_delim_arg(args[1], "io.readuntil");
     ios_t *src = toiostream(args[0], "io.readuntil");
     size_t n = ios_copyuntil(&dest, src, delim);
     cv->len = n;
@@ -251,6 +274,15 @@ value_t fl_ioreaduntil(value_t *args, u_int32_t nargs)
     return str;
 }
 
+value_t fl_iocopyuntil(value_t *args, u_int32_t nargs)
+{
+    argcount("io.copyuntil", nargs, 3);
+    ios_t *dest = toiostream(args[0], "io.copyuntil");
+    ios_t *src = toiostream(args[1], "io.copyuntil");
+    char delim = get_delim_arg(args[2], "io.copyuntil");
+    return size_wrap(ios_copyuntil(dest, src, delim));
+}
+
 value_t stream_to_string(value_t *ps)
 {
     value_t str;
@@ -290,12 +322,14 @@ static builtinspec_t iostreamfunc_info[] = {
     { "io.flush", fl_ioflush },
     { "io.close", fl_ioclose },
     { "io.eof?" , fl_ioeof },
+    { "io.seek" , fl_ioseek },
     { "io.getc" , fl_iogetc },
     { "io.putc" , fl_ioputc },
     { "io.discardbuffer", fl_iopurge },
     { "io.read", fl_ioread },
     { "io.write", fl_iowrite },
     { "io.readuntil", fl_ioreaduntil },
+    { "io.copyuntil", fl_iocopyuntil },
     { "io.tostring!", fl_iotostring },
     { NULL, NULL }
 };

femtolisp/read.c

@@ -206,6 +206,15 @@ static u_int32_t peek()
             uint32_t cval;
             if (ios_getutf8(F, &cval) == IOS_EOF)
                 lerror(ParseError, "read: end of input in character constant");
+            if (cval == (uint32_t)'u' || cval == (uint32_t)'U') {
+                read_token('u', 0);
+                if (buf[1] != '\0') {  // not a solitary 'u' or 'U'
+                    if (!read_numtok(&buf[1], &tokval, 16))
+                        lerror(ParseError,
+                               "read: invalid hex character constant");
+                    cval = numval(tokval);
+                }
+            }
             toktype = TOK_NUM;
             tokval = mk_wchar(cval);
         }

femtolisp/table.c

@@ -134,7 +134,7 @@ value_t fl_table_get(value_t *args, uint32_t nargs)
     return v;
 }
 
-// (has table key)
+// (has? table key)
 value_t fl_table_has(value_t *args, uint32_t nargs)
 {
     argcount("has", nargs, 2);
@@ -168,7 +168,10 @@ value_t fl_table_foldl(value_t *args, uint32_t nargs)
             car_(cdr_(cdr_(c))) = args[1];
             args[1] = apply(args[0], c);
             // reload pointer
-            table = ((htable_t*)cv_data((cvalue_t*)ptr(args[2])))->table;
+            h = (htable_t*)cv_data((cvalue_t*)ptr(args[2]));
+            if (h->size != n)
+                lerror(EnumerationError, "table.foldl: table modified");
+            table = h->table;
         }
     }
     (void)POP();
@@ -180,7 +183,7 @@ static builtinspec_t tablefunc_info[] = {
     { "table?", fl_tablep },
     { "put!", fl_table_put },
     { "get", fl_table_get },
-    { "has", fl_table_has },
+    { "has?", fl_table_has },
     { "del!", fl_table_del },
     { "table.foldl", fl_table_foldl },
     { NULL, NULL }