From 37a23afb3ca391290714b9560768defd15b27c97 Mon Sep 17 00:00:00 2001 From: JeffBezanson Date: Sun, 23 Aug 2009 05:07:46 +0000 Subject: [PATCH] adding io.peekc, top-level-bound? (alias) fixing behavior of number? fixing bugs in get-output-string, setting eof --- femtolisp/aliases.scm | 9 +++++++-- femtolisp/flisp.c | 10 ++++++++-- femtolisp/iostream.c | 11 +++++++++++ femtolisp/todo | 4 ++-- llt/ios.c | 29 ++++++++++++++++++++++++++++- llt/ios.h | 1 + 6 files changed, 57 insertions(+), 7 deletions(-) diff --git a/femtolisp/aliases.scm b/femtolisp/aliases.scm index d6333f8..a25fca2 100644 --- a/femtolisp/aliases.scm +++ b/femtolisp/aliases.scm @@ -13,6 +13,7 @@ (equal? (car x) "noexpand")) (cadr x) x))))) +(define (command-line) *argv*) (define gensym (let (($gensym gensym)) @@ -61,6 +62,8 @@ (define char>? >) (define char<=? <=) (define char>=? >=) +(define (char-whitespace? c) (not (not (string.find *whitespace* c)))) +(define (char-numeric? c) (not (not (string.find "0123456789" c)))) (define string=? eqv?) (define stringtype != wchartype; + } + return 0; } // read ----------------------------------------------------------------------- @@ -1230,7 +1235,7 @@ static value_t apply_cl(uint32_t nargs) Stack[SP-1] = (issymbol(Stack[SP-1]) ? FL_T : FL_F); NEXT_OP; OP(OP_NUMBERP) v = Stack[SP-1]; - Stack[SP-1] = (isfixnum(v) || iscprim(v) ? FL_T:FL_F); NEXT_OP; + Stack[SP-1] = (isnumber(v) ? FL_T:FL_F); NEXT_OP; OP(OP_FIXNUMP) Stack[SP-1] = (isfixnum(Stack[SP-1]) ? FL_T : FL_F); NEXT_OP; OP(OP_BOUNDP) @@ -2145,6 +2150,7 @@ static void lisp_init(void) } setc(symbol("eq"), builtin(OP_EQ)); setc(symbol("procedure?"), builtin(OP_FUNCTIONP)); + setc(symbol("top-level-bound?"), builtin(OP_BOUNDP)); #ifdef LINUX setc(symbol("*os-name*"), symbol("linux")); diff --git a/femtolisp/iostream.c b/femtolisp/iostream.c index c89a743..f8cd27a 100644 --- a/femtolisp/iostream.c +++ b/femtolisp/iostream.c @@ -134,6 +134,16 @@ value_t fl_iogetc(value_t *args, u_int32_t nargs) return mk_wchar(wc); } +value_t fl_iopeekc(value_t *args, u_int32_t nargs) +{ + argcount("io.peekc", nargs, 1); + ios_t *s = toiostream(args[0], "io.peekc"); + uint32_t wc; + if (ios_peekutf8(s, &wc) == IOS_EOF) + return FL_EOF; + return mk_wchar(wc); +} + value_t fl_ioputc(value_t *args, u_int32_t nargs) { argcount("io.putc", nargs, 2); @@ -397,6 +407,7 @@ static builtinspec_t iostreamfunc_info[] = { { "io.pos", fl_iopos }, { "io.getc" , fl_iogetc }, { "io.putc" , fl_ioputc }, + { "io.peekc" , fl_iopeekc }, { "io.discardbuffer", fl_iopurge }, { "io.read", fl_ioread }, { "io.write", fl_iowrite }, diff --git a/femtolisp/todo b/femtolisp/todo index 7e581b7..1a17020 100644 --- a/femtolisp/todo +++ b/femtolisp/todo @@ -54,7 +54,7 @@ * (nconc x) => x for any x . (copy-list (list|append|nconc ...)) => (list|append|nconc ...) * (apply vector (list ...)) => (vector ...) - . (nconc (cons x nil) y) => (cons x y) + * (nconc (cons x nil) y) => (cons x y) * let form without initializers (let (a b) ...), defaults to nil * print (quote a) as 'a, same for ` etc. @@ -975,7 +975,7 @@ consolidated todo list as of 7/8: * fix make-system-image to save aliases of builtins * reading named characters, e.g. #\newline etc. - #+, #- reader macros -- printing improvements: *print-big*, keep track of horiz. position +- printing improvements: *print-length*, keep track of horiz. position per-stream so indenting works across print calls - remaining c types - remaining cvalues functions diff --git a/llt/ios.c b/llt/ios.c index da6c886..4a02015 100644 --- a/llt/ios.c +++ b/llt/ios.c @@ -247,6 +247,8 @@ static size_t _ios_read(ios_t *s, char *dest, size_t n, int all) if (s->bm == bm_mem || s->fd == -1) { // can't get any more data s->bpos += avail; + if (avail == 0 && n > 0) + s->_eof = 1; return avail; } @@ -450,7 +452,7 @@ size_t ios_trunc(ios_t *s, size_t size) int ios_eof(ios_t *s) { if (s->bm == bm_mem) - return (s->bpos >= s->size); + return (s->_eof ? 1 : 0); if (s->fd == -1) return 1; if (s->_eof) @@ -817,6 +819,7 @@ int ios_ungetc(int c, ios_t *s) if (s->bpos > 0) { s->bpos--; s->buf[s->bpos] = (char)c; + s->_eof = 0; return c; } if (s->size == s->maxsize) { @@ -826,6 +829,7 @@ int ios_ungetc(int c, ios_t *s) memmove(s->buf + 1, s->buf, s->size); s->buf[0] = (char)c; s->size++; + s->_eof = 0; return c; } @@ -856,6 +860,29 @@ int ios_getutf8(ios_t *s, uint32_t *pwc) return 1; } +int ios_peekutf8(ios_t *s, uint32_t *pwc) +{ + int c; + size_t sz; + char c0; + char buf[8]; + + c = ios_peekc(s); + if (c == IOS_EOF) + return IOS_EOF; + c0 = (char)c; + sz = u8_seqlen(&c0)-1; + if (sz == 0) { + *pwc = (uint32_t)c0; + return 1; + } + if (ios_readprep(s, sz) < sz) + return IOS_EOF; + size_t i = s->bpos; + *pwc = u8_nextchar(s->buf, &i); + return 1; +} + int ios_pututf8(ios_t *s, uint32_t wc) { char buf[8]; diff --git a/llt/ios.h b/llt/ios.h index a00b165..6d661b8 100644 --- a/llt/ios.h +++ b/llt/ios.h @@ -110,6 +110,7 @@ void hexdump(ios_t *dest, char *buffer, size_t len, size_t startoffs); /* high-level stream functions - input */ int ios_getnum(ios_t *s, char *data, uint32_t type); int ios_getutf8(ios_t *s, uint32_t *pwc); +int ios_peekutf8(ios_t *s, uint32_t *pwc); int ios_ungetutf8(ios_t *s, uint32_t wc); int ios_getstringz(ios_t *dest, ios_t *src); int ios_getstringn(ios_t *dest, ios_t *src, size_t nchars);