adding vector.map, string.char

fixing 0-trip-count case in (for)

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));

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);

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)
 {

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))) ||
+            if (!iscons(v) || !iscons(cdr_(cdr_(f))) || cdr_(v) != NIL)
-                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

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);

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)

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)

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