ref: 8197197ced7ee888594d4cecc1cf4617848652ef
parent: 209b77a534b953d8197b6d0dc2ddb4db16f8fb80
author: JeffBezanson <[email protected]>
date: Sun Jan 4 21:45:21 EST 2009
misc. cleanup adding without-delimited-continuations adding skeleton for stream objects
--- a/femtolisp/cps.lsp
+++ b/femtolisp/cps.lsp
@@ -155,6 +155,9 @@
`(let ((,v (lambda/cc (,g ,val) (,g (,k ,val)))))
,(cps- E *top-k*))))
+ ((eq (car form) 'without-delimited-continuations)
+ `(,k ,(cadr form)))
+
((and (constantp (car form))
(builtinp (eval (car form))))
(builtincall->cps form k))
@@ -298,7 +301,7 @@
(let ((x 0))
(while (< x 10)
- (progn (#.print x) (setq x (+ 1 x)))))
+ (progn (print x) (setq x (+ 1 x)))))
=>
(let ((x 0))
(reset
@@ -305,7 +308,7 @@
(let ((l nil))
(let ((k (shift k (k k))))
(if (< x 10)
- (progn (setq l (progn (#.print x)
+ (progn (setq l (progn (print x)
(setq x (+ 1 x))))
(k k))
l)))))
--- a/femtolisp/cvalues.c
+++ b/femtolisp/cvalues.c
@@ -827,7 +827,8 @@
#define ctor_cv_intern(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()
{@@ -879,7 +880,23 @@
wcstringtypesym = symbol("*wcstring-type*");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*"); setc(emptystringsym, cvalue_static_cstring(""));--- a/femtolisp/flisp.c
+++ b/femtolisp/flisp.c
@@ -30,7 +30,7 @@
* strings
- hash tables
- by Jeff Bezanson (C) 2008
+ by Jeff Bezanson (C) 2009
Distributed under the BSD License
*/
--- /dev/null
+++ b/femtolisp/stream.c
@@ -1,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);
+}
--- a/femtolisp/system.lsp
+++ b/femtolisp/system.lsp
@@ -1,5 +1,5 @@
; femtoLisp standard library
-; by Jeff Bezanson (C) 2008
+; by Jeff Bezanson (C) 2009
; Distributed under the BSD License
; convert a sequence of body statements to a single expression.
@@ -165,12 +165,12 @@
(defun listp (a) (or (eq a ()) (consp a)))
-(defun nthcdr (n lst)
+(defun nthcdr (lst n)
(if (<= n 0) lst
- (nthcdr (- n 1) (cdr lst))))
+ (nthcdr (cdr lst) (- n 1))))
(defun list-ref (lst n)
- (car (nthcdr n lst)))
+ (car (nthcdr lst n)))
(defun list* l
(if (atom (cdr l))
@@ -376,11 +376,11 @@
(cdadr rplacd cadr)
(cddar rplacd cdar)
(cdddr rplacd cddr)
+ (list-ref rplaca nthcdr)
(get put identity)
(aref aset identity)
(symbol-function set identity)
(symbol-value set identity)
- (symbol-plist set-symbol-plist identity)
(symbol-syntax set-syntax identity)))
(defun setf-place-mutator (place val)
--- a/femtolisp/table.c
+++ b/femtolisp/table.c
@@ -76,10 +76,9 @@
static htable_t *totable(value_t v, char *fname)
{- if (ishashtable(v))
- return (htable_t*)cv_data((cvalue_t*)ptr(v));
- type_error(fname, "table", v);
- return NULL;
+ if (!ishashtable(v))
+ type_error(fname, "table", v);
+ return (htable_t*)cv_data((cvalue_t*)ptr(v));
}
value_t fl_table(value_t *args, uint32_t nargs)
--- a/femtolisp/todo
+++ b/femtolisp/todo
@@ -834,8 +834,8 @@
IOStream API
read - (read[ stream]) ; get next sexpr from stream
- print, sprint
- princ, sprinc
+ princ
iostream - (stream[ cvalue-as-bytestream])
file
stream.eof
--- a/femtolisp/types.c
+++ b/femtolisp/types.c
@@ -93,27 +93,3 @@
}
}
}
-
-#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));
-}