misc. cleanup

adding without-delimited-continuations

adding skeleton for stream objects
This commit is contained in:
JeffBezanson 2009-01-05 02:45:21 +00:00
parent 209b77a534
commit 8197197ced
8 changed files with 91 additions and 40 deletions

View File

@ -155,6 +155,9 @@
`(let ((,v (lambda/cc (,g ,val) (,g (,k ,val))))) `(let ((,v (lambda/cc (,g ,val) (,g (,k ,val)))))
,(cps- E *top-k*)))) ,(cps- E *top-k*))))
((eq (car form) 'without-delimited-continuations)
`(,k ,(cadr form)))
((and (constantp (car form)) ((and (constantp (car form))
(builtinp (eval (car form)))) (builtinp (eval (car form))))
(builtincall->cps form k)) (builtincall->cps form k))
@ -298,14 +301,14 @@ todo:
(let ((x 0)) (let ((x 0))
(while (< x 10) (while (< x 10)
(progn (#.print x) (setq x (+ 1 x))))) (progn (print x) (setq x (+ 1 x)))))
=> =>
(let ((x 0)) (let ((x 0))
(reset (reset
(let ((l nil)) (let ((l nil))
(let ((k (shift k (k k)))) (let ((k (shift k (k k))))
(if (< x 10) (if (< x 10)
(progn (setq l (progn (#.print x) (progn (setq l (progn (print x)
(setq x (+ 1 x)))) (setq x (+ 1 x))))
(k k)) (k k))
l))))) l)))))

View File

@ -827,7 +827,8 @@ value_t cbuiltin(char *name, builtin_t f)
#define ctor_cv_intern(tok) \ #define ctor_cv_intern(tok) \
cv_intern(tok);set(tok##sym, cbuiltin(#tok, cvalue_##tok)) cv_intern(tok);set(tok##sym, cbuiltin(#tok, cvalue_##tok))
void types_init(); #define mk_primtype(name) \
name##type=get_type(name##sym);name##type->init = &cvalue_##name##_init
void cvalues_init() void cvalues_init()
{ {
@ -879,7 +880,23 @@ void cvalues_init()
wcstringtypesym = symbol("*wcstring-type*"); wcstringtypesym = symbol("*wcstring-type*");
setc(wcstringtypesym, list2(arraysym, wcharsym)); setc(wcstringtypesym, list2(arraysym, wcharsym));
types_init(); mk_primtype(int8);
mk_primtype(uint8);
mk_primtype(int16);
mk_primtype(uint16);
mk_primtype(int32);
mk_primtype(uint32);
mk_primtype(int64);
mk_primtype(uint64);
mk_primtype(long);
mk_primtype(ulong);
mk_primtype(byte);
mk_primtype(wchar);
mk_primtype(float);
mk_primtype(double);
stringtype = get_type(symbol_value(stringtypesym));
wcstringtype = get_type(symbol_value(wcstringtypesym));
emptystringsym = symbol("*empty-string*"); emptystringsym = symbol("*empty-string*");
setc(emptystringsym, cvalue_static_cstring("")); setc(emptystringsym, cvalue_static_cstring(""));

View File

@ -30,7 +30,7 @@
* strings * strings
- hash tables - hash tables
by Jeff Bezanson (C) 2008 by Jeff Bezanson (C) 2009
Distributed under the BSD License Distributed under the BSD License
*/ */

56
femtolisp/stream.c Normal file
View File

@ -0,0 +1,56 @@
#include <stdlib.h>
#include <stdio.h>
#include <stdarg.h>
#include <string.h>
#include <assert.h>
#include <sys/types.h>
#include "llt.h"
#include "flisp.h"
static value_t streamsym;
static fltype_t *streamtype;
void print_stream(value_t v, ios_t *f, int princ)
{
}
void free_stream(value_t self)
{
}
void relocate_stream(value_t oldv, value_t newv)
{
}
cvtable_t stream_vtable = { print_stream, relocate_stream, free_stream, NULL };
int isstream(value_t v)
{
return iscvalue(v) && cv_class((cvalue_t*)ptr(v)) == streamtype;
}
value_t fl_streamp(value_t *args, uint32_t nargs)
{
argcount("streamp", nargs, 1);
return isstream(args[0]) ? T : NIL;
}
static ios_t *tostream(value_t v, char *fname)
{
if (!isstream(v))
type_error(fname, "stream", v);
return (ios_t*)cv_data((cvalue_t*)ptr(v));
}
static builtinspec_t streamfunc_info[] = {
{ "streamp", fl_streamp },
{ NULL, NULL }
};
void stream_init()
{
streamsym = symbol("stream");
streamtype = define_opaque_type(streamsym, sizeof(ios_t),
&stream_vtable, NULL);
assign_global_builtins(streamfunc_info);
}

View File

@ -1,5 +1,5 @@
; femtoLisp standard library ; femtoLisp standard library
; by Jeff Bezanson (C) 2008 ; by Jeff Bezanson (C) 2009
; Distributed under the BSD License ; Distributed under the BSD License
; convert a sequence of body statements to a single expression. ; convert a sequence of body statements to a single expression.
@ -165,12 +165,12 @@
(defun listp (a) (or (eq a ()) (consp a))) (defun listp (a) (or (eq a ()) (consp a)))
(defun nthcdr (n lst) (defun nthcdr (lst n)
(if (<= n 0) lst (if (<= n 0) lst
(nthcdr (- n 1) (cdr lst)))) (nthcdr (cdr lst) (- n 1))))
(defun list-ref (lst n) (defun list-ref (lst n)
(car (nthcdr n lst))) (car (nthcdr lst n)))
(defun list* l (defun list* l
(if (atom (cdr l)) (if (atom (cdr l))
@ -376,11 +376,11 @@
(cdadr rplacd cadr) (cdadr rplacd cadr)
(cddar rplacd cdar) (cddar rplacd cdar)
(cdddr rplacd cddr) (cdddr rplacd cddr)
(list-ref rplaca nthcdr)
(get put identity) (get put identity)
(aref aset identity) (aref aset identity)
(symbol-function set identity) (symbol-function set identity)
(symbol-value set identity) (symbol-value set identity)
(symbol-plist set-symbol-plist identity)
(symbol-syntax set-syntax identity))) (symbol-syntax set-syntax identity)))
(defun setf-place-mutator (place val) (defun setf-place-mutator (place val)

View File

@ -76,10 +76,9 @@ value_t fl_tablep(value_t *args, uint32_t nargs)
static htable_t *totable(value_t v, char *fname) static htable_t *totable(value_t v, char *fname)
{ {
if (ishashtable(v)) if (!ishashtable(v))
return (htable_t*)cv_data((cvalue_t*)ptr(v)); type_error(fname, "table", v);
type_error(fname, "table", v); return (htable_t*)cv_data((cvalue_t*)ptr(v));
return NULL;
} }
value_t fl_table(value_t *args, uint32_t nargs) value_t fl_table(value_t *args, uint32_t nargs)

View File

@ -834,8 +834,8 @@ String API
IOStream API IOStream API
read - (read[ stream]) ; get next sexpr from stream read - (read[ stream]) ; get next sexpr from stream
print, sprint print
princ, sprinc princ
iostream - (stream[ cvalue-as-bytestream]) iostream - (stream[ cvalue-as-bytestream])
file file
stream.eof stream.eof

View File

@ -93,27 +93,3 @@ void relocate_typetable()
} }
} }
} }
#define mk_primtype(name) \
name##type=get_type(name##sym);name##type->init = &cvalue_##name##_init
void types_init()
{
mk_primtype(int8);
mk_primtype(uint8);
mk_primtype(int16);
mk_primtype(uint16);
mk_primtype(int32);
mk_primtype(uint32);
mk_primtype(int64);
mk_primtype(uint64);
mk_primtype(long);
mk_primtype(ulong);
mk_primtype(byte);
mk_primtype(wchar);
mk_primtype(float);
mk_primtype(double);
stringtype = get_type(symbol_value(stringtypesym));
wcstringtype = get_type(symbol_value(wcstringtypesym));
}