shithub: femtolisp

--- a/femtolisp/builtins.c

+++ b/femtolisp/builtins.c

@@ -439,6 +439,22 @@

     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 @@

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

--- a/femtolisp/cvalues.c

+++ b/femtolisp/cvalues.c

@@ -14,7 +14,7 @@

     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 @@

     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 @@

     ALIGN2 = struct_aligns[1];

     ALIGN4 = struct_aligns[3];

     ALIGN8 = struct_aligns[7];

+    ALIGNPTR = struct_aligns[sizeof(void*)-1];

     cv_intern(uint32);

     cv_intern(pointer);

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

--- a/femtolisp/flisp.c

+++ b/femtolisp/flisp.c

@@ -104,7 +104,6 @@

 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,8 +1139,7 @@

             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

@@ -1148,6 +1146,7 @@

             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

--- a/femtolisp/flisp.h

+++ b/femtolisp/flisp.h

@@ -51,6 +51,8 @@

 #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 @@

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

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

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

--- a/femtolisp/todo

+++ b/femtolisp/todo

@@ -112,7 +112,7 @@

 * 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 @@

   . 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         - 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.map     - (string.map f s)

 *string.encode  - to utf8

 *string.decode  - from utf8 to UCS

- string.width   - # columns

 IOStream API

@@ -861,3 +861,9 @@

 * 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