adding io.peekc, top-level-bound? (alias)

fixing behavior of number?
fixing bugs in get-output-string, setting eof

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 string<? <)
@@ -94,6 +97,7 @@
 (define close-input-port io.close)
 (define close-output-port io.close)
 (define (read-char (s *input-stream*)) (io.getc s))
+(define (peek-char (s *input-stream*)) (io.peekc s))
 (define (write-char c (s *output-stream*)) (io.putc s c))
 (define (port-eof? p) (io.eof? p))
 (define (open-input-string str)
@@ -109,8 +113,9 @@
 (define (get-output-string b)
   (let ((p (io.pos b)))
     (io.seek b 0)
-    (prog1 (io.readall b)
-	   (io.seek b p))))
+    (let ((s (io.readall b)))
+      (io.seek b p)
+      (if (eof-object? s) "" s))))
 
 (define (open-input-file name) (file name :read))
 (define (open-output-file name) (file name :write :create))

femtolisp/flisp.c

@@ -713,7 +713,12 @@ value_t fl_cons(value_t a, value_t b)
 
 int isnumber(value_t v)
 {
-    return (isfixnum(v) || iscprim(v));
+    if (isfixnum(v)) return 1;
+    if (iscprim(v)) {
+        cprim_t *c = (cprim_t*)ptr(v);
+        return c->type != 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"));

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

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

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

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