shithub: femtolisp

--- a/femtolisp/builtins.c

+++ b/femtolisp/builtins.c

@@ -35,30 +35,6 @@

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

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

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

--- a/femtolisp/cps.lsp

+++ b/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))

--- a/femtolisp/iostream.c

+++ b/femtolisp/iostream.c

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

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

@@ -14,7 +14,7 @@

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

-    ios_t *s = toiostream(args[0], "io.read");

+    if (nargs > 1)

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

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

--- a/femtolisp/system.lsp

+++ b/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 *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 (set s v) (eval (list 'set! s (list 'quote v))))

-(define (identity x) x)

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

--- a/femtolisp/todo

+++ b/femtolisp/todo

@@ -830,14 +830,15 @@

 IOStream API

- read             - (read[ stream]) ; get next sexpr from stream

- print

- princ

+*read             - (read[ stream]) ; get next sexpr from stream

+*print

+*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])