From c3811312a7820de1b9a2aaca5ae7efa52cb611fa Mon Sep 17 00:00:00 2001 From: JeffBezanson Date: Sat, 2 Aug 2008 16:18:39 +0000 Subject: [PATCH] adding vector.map, string.char fixing 0-trip-count case in (for) --- femtolisp/builtins.c | 17 +++++++++++++++++ femtolisp/cvalues.c | 5 +++-- femtolisp/equal.c | 3 --- femtolisp/flisp.c | 5 ++--- femtolisp/flisp.h | 3 +++ femtolisp/print.c | 1 + femtolisp/system.lsp | 8 ++++++++ femtolisp/todo | 14 ++++++++++---- 8 files changed, 44 insertions(+), 12 deletions(-) diff --git a/femtolisp/builtins.c b/femtolisp/builtins.c index d0760d5..7ffc3a8 100644 --- a/femtolisp/builtins.c +++ b/femtolisp/builtins.c @@ -439,6 +439,22 @@ value_t fl_string_sub(value_t *args, u_int32_t nargs) return ns; } +value_t fl_string_char(value_t *args, u_int32_t nargs) +{ + argcount("string.char", nargs, 2); + char *s = tostring(args[0], "string.char"); + size_t len = cv_len((cvalue_t*)ptr(args[0])); + size_t i; + i = toulong(args[1], "string.char"); + if (i > len) + bounds_error("string.char", args[0], args[1]); + size_t sl = u8_seqlen(&s[i]); + if (sl > len || i > len-sl) + bounds_error("string.char", args[0], args[1]); + value_t ccode = fixnum(u8_nextchar(s, &i)); + return cvalue_char(&ccode, 1); +} + value_t fl_time_now(value_t *args, u_int32_t nargs) { argcount("time.now", nargs, 0); @@ -568,6 +584,7 @@ void builtins_init() set(symbol("string.length"), guestfunc(fl_string_length)); set(symbol("string.split"), guestfunc(fl_string_split)); set(symbol("string.sub"), guestfunc(fl_string_sub)); + set(symbol("string.char"), guestfunc(fl_string_char)); set(symbol("string.reverse"), guestfunc(fl_string_reverse)); set(symbol("string.encode"), guestfunc(fl_string_encode)); set(symbol("string.decode"), guestfunc(fl_string_decode)); diff --git a/femtolisp/cvalues.c b/femtolisp/cvalues.c index a83ca70..b4d7492 100644 --- a/femtolisp/cvalues.c +++ b/femtolisp/cvalues.c @@ -14,7 +14,7 @@ static int struct_aligns[8] = { sizeof(struct { char a; char i[6]; }), sizeof(struct { char a; char i[7]; }), sizeof(struct { char a; int64_t i; }) }; -static int ALIGN2, ALIGN4, ALIGN8; +static int ALIGN2, ALIGN4, ALIGN8, ALIGNPTR; typedef void (*cvinitfunc_t)(value_t*, u_int32_t, void*, void*); @@ -594,7 +594,7 @@ size_t ctype_sizeof(value_t type, int *palign) if (iscons(type)) { value_t hed = car_(type); if (hed == pointersym || hed == cfunctionsym || hed == lispvaluesym) { - *palign = struct_aligns[sizeof(void*)-1]; + *palign = ALIGNPTR; return sizeof(void*); } if (hed == arraysym) { @@ -872,6 +872,7 @@ void cvalues_init() ALIGN2 = struct_aligns[1]; ALIGN4 = struct_aligns[3]; ALIGN8 = struct_aligns[7]; + ALIGNPTR = struct_aligns[sizeof(void*)-1]; cv_intern(uint32); cv_intern(pointer); diff --git a/femtolisp/equal.c b/femtolisp/equal.c index 9efe485..d7cffae 100644 --- a/femtolisp/equal.c +++ b/femtolisp/equal.c @@ -7,9 +7,6 @@ #include "llt.h" #include "flisp.h" -// comparable with == -#define eq_comparable(a,b) (!(((a)|(b))&0x1)) - // is it a leaf? (i.e. does not lead to other values) static inline int leafp(value_t a) { diff --git a/femtolisp/flisp.c b/femtolisp/flisp.c index 4900ee0..f01c6f7 100644 --- a/femtolisp/flisp.c +++ b/femtolisp/flisp.c @@ -104,7 +104,6 @@ static unsigned char *curheap; static unsigned char *lim; static u_int32_t heapsize = 256*1024;//bytes static u_int32_t *consflags; -static u_int32_t printlabel; // error utilities ------------------------------------------------------------ @@ -1140,14 +1139,14 @@ static value_t eval_sexpr(value_t e, uint32_t penv, int tail) hi = tofixnum(Stack[SP-2], "for"); f = Stack[SP-1]; v = car(cdr(f)); - if (!iscons(v) || !iscons(cdr_(cdr_(f))) || - cdr_(v) != NIL) + if (!iscons(v) || !iscons(cdr_(cdr_(f))) || cdr_(v) != NIL) lerror(ArgError, "for: expected 1 argument lambda"); f = cdr_(f); PUSH(f); // save function cdr SP += 4; // make space Stack[SP-4] = fixnum(3); // env size Stack[SP-1] = cdr_(cdr_(f)); // cloenv + v = NIL; for(s=lo; s <= hi; s++) { f = Stack[SP-5]; Stack[SP-3] = car_(f); // lambda list diff --git a/femtolisp/flisp.h b/femtolisp/flisp.h index 9180c6a..42538c1 100644 --- a/femtolisp/flisp.h +++ b/femtolisp/flisp.h @@ -51,6 +51,8 @@ typedef struct _symbol_t { #define isvector(x) (isvectorish(x) && !(((value_t*)ptr(x))[0] & 0x2)) #define iscvalue(x) (isvectorish(x) && (((value_t*)ptr(x))[0] & 0x2)) #define selfevaluating(x) (tag(x)<0x2) +// comparable with == +#define eq_comparable(a,b) (!(((a)|(b))&0x1)) // distinguish a vector from a cvalue #define discriminateAsVector(x) (!(((value_t*)ptr(x))[0] & 0x2)) #define vector_size(v) (((size_t*)ptr(v))[0]>>2) @@ -226,6 +228,7 @@ value_t cvalue_pinned_cstring(char *str); int isstring(value_t v); int isnumber(value_t v); value_t cvalue_compare(value_t a, value_t b); +value_t cvalue_char(value_t *args, uint32_t nargs); value_t mk_double(double_t n); value_t mk_uint32(uint32_t n); diff --git a/femtolisp/print.c b/femtolisp/print.c index c4e656a..64d79ca 100644 --- a/femtolisp/print.c +++ b/femtolisp/print.c @@ -1,4 +1,5 @@ static ptrhash_t printconses; +static u_int32_t printlabel; static int HPOS, VPOS; static void outc(char c, FILE *f) diff --git a/femtolisp/system.lsp b/femtolisp/system.lsp index ef7c2d9..ed28145 100644 --- a/femtolisp/system.lsp +++ b/femtolisp/system.lsp @@ -411,6 +411,14 @@ (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) diff --git a/femtolisp/todo b/femtolisp/todo index 6707ecc..a1b2af3 100644 --- a/femtolisp/todo +++ b/femtolisp/todo @@ -112,7 +112,7 @@ for internal use: * a special version of apply that takes arguments on the stack, to avoid consing when implementing "call-with" style primitives like trycatch, hashtable-foreach, or the fl_apply API -- try this environment representation: +* try this environment representation: for all kinds of functions (except maybe builtin special forms) push all arguments on the stack, either evaluated or not. for lambdas, push the lambda list and next-env pointers. @@ -572,7 +572,7 @@ cvalues todo: . keep track of whether a cvalue leads to any lispvalues, so they can be automatically relocated (?) * float, double -- struct, union +- struct, union (may want to start with more general layout type) - pointer type, function type - finalizers and lifetime dependency tracking - functions autorelease, guestfunction @@ -769,8 +769,9 @@ String API *string - append/construct string.inc - (string.inc s i [nchars]) string.dec - string.char - char at byte offset string.count - # of chars between 2 byte offsets + string.width - # columns +*string.char - char at byte offset *string.sub - substring between 2 byte offsets *string.split - (string.split s sep-chars) string.trim - (string.trim s chars-at-start chars-at-end) @@ -779,7 +780,6 @@ String API string.map - (string.map f s) *string.encode - to utf8 *string.decode - from utf8 to UCS - string.width - # columns IOStream API @@ -861,3 +861,9 @@ switch to miser mode, otherwise default is ok, for example: * write try_predict_len that gives a length for easy cases like symbols, else -1. use it to avoid wrapping symbols around lines + +- print defun and defmacro more like lambda (2 spaces) + +- *print-pretty* to control it + +- if indent gets too large, dedent back to left edge