Permalink
Browse files

making all builtins print readably; (builtin 'sym) function

hash table functions:
adding get,put,has,del,table.foldl,table.pairs,table.keys,table.values
  • Loading branch information...
1 parent b5dda68 commit dfacb4d897b5fb55e95e0f20f76bff16d816b3e5 @JeffBezanson JeffBezanson committed Dec 21, 2008
Showing with 158 additions and 87 deletions.
  1. +28 −7 femtolisp/cvalues.c
  2. +12 −12 femtolisp/flisp.c
  3. +2 −2 femtolisp/flisp.h
  4. +8 −1 femtolisp/print.c
  5. +20 −10 femtolisp/system.lsp
  6. +81 −52 femtolisp/table.c
  7. +1 −0 femtolisp/todo
  8. +5 −2 llt/htable.inc
  9. +1 −1 llt/htableh.inc
View
@@ -18,6 +18,7 @@ value_t structsym, arraysym, enumsym, cfunctionsym, voidsym, pointersym;
value_t unionsym;
static htable_t TypeTable;
+static htable_t reverse_dlsym_lookup_table;
static fltype_t *int8type, *uint8type;
static fltype_t *int16type, *uint16type;
static fltype_t *int32type, *uint32type;
@@ -802,8 +803,24 @@ value_t cvalue_set_int8(value_t *args, u_int32_t nargs)
return args[2];
}
-value_t cbuiltin(builtin_t f)
+value_t fl_builtin(value_t *args, u_int32_t nargs)
{
+ argcount("builtin", nargs, 1);
+ symbol_t *name = tosymbol(args[0], "builtin");
+ builtin_t f = (builtin_t)name->dlcache;
+ if (f == NULL) {
+ lerror(ArgError, "builtin: function not found");
+ }
+ return tagptr(f, TAG_BUILTIN);
+}
+
+value_t cbuiltin(char *name, builtin_t f)
+{
+ value_t sym = symbol(name);
+ ((symbol_t*)ptr(sym))->dlcache = f;
+ ptrhash_put(&reverse_dlsym_lookup_table, f, (void*)sym);
+ return tagptr(f, TAG_BUILTIN);
+ /*
value_t gf = cvalue(builtintype, sizeof(void*));
((cvalue_t*)ptr(gf))->data = f;
size_t nw = cv_nwords((cvalue_t*)ptr(gf));
@@ -813,16 +830,19 @@ value_t cbuiltin(builtin_t f)
cvalue_t *buf = malloc_aligned(nw * sizeof(value_t), 8);
memcpy(buf, ptr(gf), nw*sizeof(value_t));
return tagptr(buf, TAG_BUILTIN);
+ */
}
#define cv_intern(tok) tok##sym = symbol(#tok)
-#define ctor_cv_intern(tok) cv_intern(tok);set(tok##sym, cbuiltin(cvalue_##tok))
+#define ctor_cv_intern(tok) \
+ cv_intern(tok);set(tok##sym, cbuiltin(#tok, cvalue_##tok))
void types_init();
void cvalues_init()
{
htable_new(&TypeTable, 256);
+ htable_new(&reverse_dlsym_lookup_table, 256);
// compute struct field alignment required for primitives
ALIGN2 = sizeof(struct { char a; int16_t i; }) - 2;
@@ -857,11 +877,12 @@ void cvalues_init()
cv_intern(union);
cv_intern(void);
- set(symbol("c-value"), cbuiltin(cvalue_new));
- set(symbol("get-int8"), cbuiltin(cvalue_get_int8));
- set(symbol("set-int8"), cbuiltin(cvalue_set_int8));
- set(symbol("typeof"), cbuiltin(cvalue_typeof));
- set(symbol("sizeof"), cbuiltin(cvalue_sizeof));
+ set(symbol("c-value"), cbuiltin("c-value", cvalue_new));
+ set(symbol("get-int8"), cbuiltin("get-int8", cvalue_get_int8));
+ set(symbol("set-int8"), cbuiltin("set-int8", cvalue_set_int8));
+ set(symbol("typeof"), cbuiltin("typeof", cvalue_typeof));
+ set(symbol("sizeof"), cbuiltin("sizeof", cvalue_sizeof));
+ set(symbol("builtin"), cbuiltin("builtin", fl_builtin));
// todo: autorelease
stringtypesym = symbol("*string-type*");
View
@@ -69,7 +69,7 @@ uint32_t SP = 0;
value_t NIL, T, LAMBDA, QUOTE, IF, TRYCATCH;
value_t BACKQUOTE, COMMA, COMMAAT, COMMADOT;
value_t IOError, ParseError, TypeError, ArgError, UnboundError, MemoryError;
-value_t DivideError, BoundsError, Error;
+value_t DivideError, BoundsError, Error, KeyError;
value_t conssym, symbolsym, fixnumsym, vectorsym, builtinsym;
value_t defunsym, defmacrosym, forsym, labelsym, printprettysym;
value_t printwidthsym;
@@ -335,18 +335,18 @@ value_t alloc_vector(size_t n, int init)
return v;
}
+// cvalues --------------------------------------------------------------------
+
+#include "cvalues.c"
+#include "types.c"
+
// print ----------------------------------------------------------------------
static int isnumtok(char *tok, value_t *pval);
static int symchar(char c);
#include "print.c"
-// cvalues --------------------------------------------------------------------
-
-#include "cvalues.c"
-#include "types.c"
-
// collector ------------------------------------------------------------------
static value_t relocate(value_t v)
@@ -1193,9 +1193,8 @@ static value_t eval_sexpr(value_t e, uint32_t penv, int tail)
noeval = 1;
goto apply_lambda;
default:
- // a guest function is a cvalue tagged as a builtin
- cv = (cvalue_t*)ptr(f);
- v = ((builtin_t)cv->data)(&Stack[saveSP+1], nargs);
+ // function pointer tagged as a builtin
+ v = ((builtin_t)ptr(f))(&Stack[saveSP+1], nargs);
}
SP = saveSP;
return v;
@@ -1317,7 +1316,7 @@ static char *EXEDIR;
void assign_global_builtins(builtinspec_t *b)
{
while (b->name != NULL) {
- set(symbol(b->name), cbuiltin(b->fptr));
+ set(symbol(b->name), cbuiltin(b->name, b->fptr));
b++;
}
}
@@ -1350,6 +1349,7 @@ void lisp_init(void)
TypeError = symbol("type-error");
ArgError = symbol("arg-error");
UnboundError = symbol("unbound-error");
+ KeyError = symbol("key-error");
MemoryError = symbol("memory-error");
BoundsError = symbol("bounds-error");
DivideError = symbol("divide-error");
@@ -1389,8 +1389,8 @@ void lisp_init(void)
#endif
cvalues_init();
- set(symbol("gensym"), cbuiltin(gensym));
- set(symbol("hash"), cbuiltin(fl_hash));
+ set(symbol("gensym"), cbuiltin("gensym", gensym));
+ set(symbol("hash"), cbuiltin("hash", fl_hash));
char buf[1024];
char *exename = get_exename(buf, sizeof(buf));
View
@@ -148,7 +148,7 @@ void lerror(value_t e, char *format, ...) __attribute__ ((__noreturn__));
void raise(value_t e) __attribute__ ((__noreturn__));
void type_error(char *fname, char *expected, value_t got) __attribute__ ((__noreturn__));
void bounds_error(char *fname, value_t arr, value_t ind) __attribute__ ((__noreturn__));
-extern value_t ArgError, IOError;
+extern value_t ArgError, IOError, KeyError;
static inline void argcount(char *fname, int nargs, int c)
{
if (nargs != c)
@@ -245,7 +245,7 @@ size_t ctype_sizeof(value_t type, int *palign);
value_t cvalue_copy(value_t v);
value_t cvalue_from_data(fltype_t *type, void *data, size_t sz);
value_t cvalue_from_ref(fltype_t *type, void *ptr, size_t sz, value_t parent);
-value_t cbuiltin(builtin_t f);
+value_t cbuiltin(char *name, builtin_t f);
size_t cvalue_arraylen(value_t v);
value_t size_wrap(size_t sz);
size_t toulong(value_t n, char *fname);
View
@@ -332,7 +332,14 @@ void fl_print_child(ios_t *f, value_t v, int princ)
outs(builtin_names[uintval(v)], f);
break;
}
- cvalue_print(f, v, princ);
+ label = (value_t)ptrhash_get(&reverse_dlsym_lookup_table, ptr(v));
+ if (label == (value_t)HT_NOTFOUND) {
+ HPOS += ios_printf(f, "#<builtin @0x%08lx>",
+ (unsigned long)(builtin_t)ptr(v));
+ }
+ else {
+ HPOS += ios_printf(f, "#builtin(%s)", symbol_name(label));
+ }
break;
case TAG_CVALUE:
case TAG_VECTOR:
View
@@ -87,8 +87,8 @@
(define (cadr x) (car (cdr x)))
-(setq *special-forms* '(quote cond if and or while lambda label trycatch
- %top progn))
+;(setq *special-forms* '(quote cond if and or while lambda label trycatch
+; %top progn))
(defun macroexpand (e)
((label mexpand
@@ -420,14 +420,6 @@
(setq l (cons (aref v (- n i)) l))))
l))
-(defun vector.map (f v)
- (let* ((n (length v))
- (nv (vector.alloc n)))
- (for 0 (- n 1)
- (lambda (i)
- (aset nv i (f (aref v i)))))
- nv))
-
(defun self-evaluating-p (x)
(or (eq x nil)
(eq x T)
@@ -493,3 +485,21 @@
(prog1
,expr
(princ "Elapsed time: " (- (time.now) ,t0) " seconds\n")))))
+
+(defun vector.map (f v)
+ (let* ((n (length v))
+ (nv (vector.alloc n)))
+ (for 0 (- n 1)
+ (lambda (i)
+ (aset nv i (f (aref v i)))))
+ nv))
+
+(defun table.pairs (t)
+ (table.foldl (lambda (k v z) (cons (cons k v) z))
+ () t))
+(defun table.keys (t)
+ (table.foldl (lambda (k v z) (cons k z))
+ () t))
+(defun table.values (t)
+ (table.foldl (lambda (k v z) (cons v z))
+ () t))
Oops, something went wrong.

0 comments on commit dfacb4d

Please sign in to comment.