parent
1097597437
commit
79e12b2dcb
|
@ -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 },
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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);
|
||||
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));
|
||||
}
|
||||
|
|
|
@ -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)))
|
||||
|
|
|
@ -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])
|
||||
|
|
Loading…
Reference in New Issue