diff --git a/femtolisp/flisp.c b/femtolisp/flisp.c index ca994e1..6f9c9a0 100644 --- a/femtolisp/flisp.c +++ b/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"); diff --git a/femtolisp/flisp.h b/femtolisp/flisp.h index b04fa0d..19ccdd6 100644 --- a/femtolisp/flisp.h +++ b/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)) diff --git a/femtolisp/iostream.c b/femtolisp/iostream.c index 85349c9..a769c60 100644 --- a/femtolisp/iostream.c +++ b/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 } }; diff --git a/femtolisp/read.c b/femtolisp/read.c index e59468d..d13f6e2 100644 --- a/femtolisp/read.c +++ b/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); } diff --git a/femtolisp/table.c b/femtolisp/table.c index 58f5375..ca4a5e7 100644 --- a/femtolisp/table.c +++ b/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 }