shithub: femtolisp

Info  •  Files  •  Log

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

--- a/femtolisp/flisp.c

+++ b/femtolisp/flisp.c

@@ -81,7 +81,7 @@

 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 @@

     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");

--- a/femtolisp/flisp.h

+++ b/femtolisp/flisp.h

@@ -153,7 +153,7 @@

 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))

--- a/femtolisp/iostream.c

+++ b/femtolisp/iostream.c

@@ -156,6 +156,17 @@

     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 @@

     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 @@

     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 @@

     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,6 +322,7 @@

     { "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 },

@@ -296,6 +329,7 @@

     { "io.read", fl_ioread },

     { "io.write", fl_iowrite },

     { "io.readuntil", fl_ioreaduntil },

+    { "io.copyuntil", fl_iocopyuntil },

     { "io.tostring!", fl_iotostring },

     { NULL, NULL }

 };

--- a/femtolisp/read.c

+++ b/femtolisp/read.c

@@ -206,6 +206,15 @@

             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);

         }

--- a/femtolisp/table.c

+++ b/femtolisp/table.c

@@ -134,7 +134,7 @@

     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 @@

             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 @@

     { "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 }