From 79e12b2dcbe71f78a6c93656a2e440ca09595913 Mon Sep 17 00:00:00 2001 From: JeffBezanson Date: Mon, 9 Feb 2009 05:38:40 +0000 Subject: [PATCH] adding io.print and io.princ misc. touch-ups --- femtolisp/builtins.c | 29 +----------------------- femtolisp/cps.lsp | 6 ++--- femtolisp/iostream.c | 52 ++++++++++++++++++++++++++++++++++---------- femtolisp/system.lsp | 16 +++++++++----- femtolisp/todo | 9 ++++---- 5 files changed, 61 insertions(+), 51 deletions(-) diff --git a/femtolisp/builtins.c b/femtolisp/builtins.c index 6a9648a..9348058 100644 --- a/femtolisp/builtins.c +++ b/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 }, diff --git a/femtolisp/cps.lsp b/femtolisp/cps.lsp index cd0873d..7ae471c 100644 --- 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)) diff --git a/femtolisp/iostream.c b/femtolisp/iostream.c index a9dac00..f7072b0 100644 --- a/femtolisp/iostream.c +++ b/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("#", f); + fl_print_str("#", 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); - 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 @@ 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)); } diff --git a/femtolisp/system.lsp b/femtolisp/system.lsp index 39b79b5..d6fadfa 100644 --- 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 (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))) diff --git a/femtolisp/todo b/femtolisp/todo index e7f5093..69f3661 100644 --- a/femtolisp/todo +++ b/femtolisp/todo @@ -830,14 +830,15 @@ String API 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])