adding io.print and io.princ

misc. touch-ups

femtolisp/builtins.c

@@ -35,30 +35,6 @@ value_t list_nth(value_t l, size_t n)
     return NIL;
 }
 
-value_t fl_print(value_t *args, u_int32_t nargs)
-{
-    unsigned i;
-    for (i=0; i < nargs; i++)
-        print(ios_stdout, args[i], 0);
-    ios_putc('\n', ios_stdout);
-    return nargs ? args[nargs-1] : NIL;
-}
-
-value_t fl_princ(value_t *args, u_int32_t nargs)
-{
-    unsigned i;
-    for (i=0; i < nargs; i++)
-        print(ios_stdout, args[i], 1);
-    return nargs ? args[nargs-1] : NIL;
-}
-
-value_t fl_read(value_t *args, u_int32_t nargs)
-{
-    (void)args;
-    argcount("read", nargs, 0);
-    return read_sexpr(ios_stdin);
-}
-
 value_t fl_load(value_t *args, u_int32_t nargs)
 {
     argcount("load", nargs, 1);
@@ -317,7 +293,7 @@ value_t fl_path_cwd(value_t *args, uint32_t nargs)
     }
     char *ptr = tostring(args[0], "path.cwd");
     if (set_cwd(ptr))
-        lerror(IOError, "could not cd to %s", ptr);
+        lerror(IOError, "path.cwd: could not cd to %s", ptr);
     return FL_T;
 }
 
@@ -399,9 +375,6 @@ static builtinspec_t builtin_info[] = {
     { "environment", fl_global_env },
     { "constant?", fl_constantp },
 
-    { "print", fl_print },
-    { "princ", fl_princ },
-    { "read", fl_read },
     { "load", fl_load },
     { "exit", fl_exit },
     { "intern", fl_intern },

femtolisp/cps.lsp

@@ -24,17 +24,17 @@
 (define (funcall/cc f k . args)
   (if (and (pair? f) (eq (car f) 'lambda/cc))
       (apply f (cons k args))
-    (k (apply f args))))
+      (k (apply f args))))
 (define *funcall/cc-names*
   (list-to-vector
    (map (lambda (i) (intern (string 'funcall/cc- i)))
         (iota 6))))
 (define-macro (def-funcall/cc-n args)
-  (let* ((name (aref *funcall/cc-names* (length args))))
+  (let ((name (aref *funcall/cc-names* (length args))))
     `(define (,name f k ,@args)
        (if (and (pair? f) (eq (car f) 'lambda/cc))
            (f k ,@args)
-         (k (f ,@args))))))
+	   (k (f ,@args))))))
 (def-funcall/cc-n ())
 (def-funcall/cc-n (a0))
 (def-funcall/cc-n (a0 a1))

femtolisp/iostream.c

@@ -7,14 +7,14 @@
 #include "llt.h"
 #include "flisp.h"
 
-static value_t iostreamsym, rdsym, wrsym, apsym, crsym, truncsym;
+static value_t iostreamsym, rdsym, wrsym, apsym, crsym, truncsym, instrsym;
 static fltype_t *iostreamtype;
 
 void print_iostream(value_t v, ios_t *f, int princ)
 {
     (void)v;
     (void)princ;
-    fl_print_str("#<iostream>", f);
+    fl_print_str("#<io stream>", f);
 }
 
 void free_iostream(value_t self)
@@ -71,25 +71,54 @@ value_t fl_file(value_t *args, uint32_t nargs)
     value_t f = cvalue(iostreamtype, sizeof(ios_t));
     ios_t *s = value2c(ios_t*, f);
     if (ios_file(s, fname, r, w, c, t) == NULL)
-        lerror(IOError, "could not open file \"%s\"", fname);
+        lerror(IOError, "file: could not open \"%s\"", fname);
     if (a) ios_seek_end(s);
     return f;
 }
 
-value_t fl_ioread(value_t *args, u_int32_t nargs)
+value_t fl_read(value_t *args, u_int32_t nargs)
 {
-    argcount("io.read", nargs, 1);
+    if (nargs > 1)
-    ios_t *s = toiostream(args[0], "io.read");
+        argcount("read", nargs, 1);
+    ios_t *s;
+    if (nargs > 0)
+        s = toiostream(args[0], "read");
+    else
+        s = toiostream(symbol_value(instrsym), "read");
     value_t v = read_sexpr(s);
     if (ios_eof(s))
-        lerror(IOError, "end of file reached");
+        lerror(IOError, "read: end of file reached");
     return v;
 }
 
+static void do_ioprint(value_t *args, u_int32_t nargs, int princ, char *fname)
+{
+    if (nargs < 2)
+        argcount(fname, nargs, 2);
+    ios_t *s = toiostream(args[0], fname);
+    unsigned i;
+    for (i=1; i < nargs; i++) {
+        print(s, args[i], princ);
+        if (!princ) ios_putc('\n', s);
+    }
+}
+value_t fl_ioprint(value_t *args, u_int32_t nargs)
+{
+    do_ioprint(args, nargs, 0, "io.print");
+    return args[nargs-1];
+}
+value_t fl_ioprinc(value_t *args, u_int32_t nargs)
+{
+    do_ioprint(args, nargs, 1, "io.princ");
+    return args[nargs-1];
+}
+
 static builtinspec_t iostreamfunc_info[] = {
     { "iostream?", fl_iostreamp },
     { "file", fl_file },
-    { "io.read", fl_ioread },
+    { "read", fl_read },
+    { "io.print", fl_ioprint },
+    { "io.princ", fl_ioprinc },
     { NULL, NULL }
 };
 
@@ -101,14 +130,15 @@ void iostream_init()
     apsym = symbol(":append");
     crsym = symbol(":create");
     truncsym = symbol(":truncate");
+    instrsym = symbol("*input-stream*");
     iostreamtype = define_opaque_type(iostreamsym, sizeof(ios_t),
                                       &iostream_vtable, NULL);
     assign_global_builtins(iostreamfunc_info);
 
-    setc(symbol("*stdout*"), cvalue_from_ref(iostreamtype, &ios_stdout,
+    setc(symbol("*stdout*"), cvalue_from_ref(iostreamtype, ios_stdout,
                                              sizeof(ios_t), NIL));
-    setc(symbol("*stderr*"), cvalue_from_ref(iostreamtype, &ios_stderr,
+    setc(symbol("*stderr*"), cvalue_from_ref(iostreamtype, ios_stderr,
                                              sizeof(ios_t), NIL));
-    setc(symbol("*stdin*" ), cvalue_from_ref(iostreamtype, &ios_stdin,
+    setc(symbol("*stdin*" ), cvalue_from_ref(iostreamtype, ios_stdin,
                                              sizeof(ios_t), NIL));
 }

femtolisp/system.lsp

@@ -23,22 +23,27 @@
                (list 'set-syntax! (list 'quote (car form))
                      (list 'lambda (cdr form) (f-body body)))))
 
-(define-macro (label name fn)
-  (list (list 'lambda (list name) (list 'set! name fn)) #f))
-
 (define-macro (define form . body)
   (if (symbol? form)
       (list 'set! form (car body))
       (list 'set! (car form) (list 'lambda (cdr form) (f-body body)))))
 
-(define (set s v) (eval (list 'set! s (list 'quote v))))
+(define *output-stream* *stdout*)
+(define *input-stream*  *stdin*)
+(define (print . args)
+  (apply io.print (cons *output-stream* args)))
+(define (princ . args)
+  (apply io.princ (cons *output-stream* args)))
 
-(define (identity x) x)
+(define (set s v) (eval (list 'set! s (list 'quote v))))
 
 (define (map f lst)
   (if (atom? lst) lst
       (cons (f (car lst)) (map f (cdr lst)))))
 
+(define-macro (label name fn)
+  (list (list 'lambda (list name) (list 'set! name fn)) #f))
+
 (define-macro (let binds . body)
   ((lambda (lname)
      (begin
@@ -166,6 +171,7 @@
 (define (mod x y) (- x (* (/ x y) y)))
 (define remainder mod)
 (define (abs x)   (if (< x 0) (- x) x))
+(define (identity x) x)
 (define K prog1)  ; K combinator ;)
 
 (define (caar x) (car (car x)))

femtolisp/todo

@@ -830,14 +830,15 @@ String API
 
 IOStream API
 
- read             - (read[ stream]) ; get next sexpr from stream
+*read             - (read[ stream]) ; get next sexpr from stream
- print
+*print
- princ
+*princ
  iostream         - (stream[ cvalue-as-bytestream])
+ memstream
 *file
  io.eof
  io.write     - (io.write s cvalue)
-*io.read      - (io.read s ctype)
+ io.read      - (io.read s ctype [len])
  io.flush
  io.close
  io.pos       - (io.pos s [set-pos])