adding integer? and number->string

a bit more renaming

femtolisp/builtins.c

@@ -182,6 +182,35 @@ value_t fl_constantp(value_t *args, u_int32_t nargs)
     return FL_T;
 }
 
+value_t fl_integerp(value_t *args, u_int32_t nargs)
+{
+    argcount("integer?", nargs, 1);
+    value_t v = args[0];
+    if (isfixnum(v)) {
+        return FL_T;
+    }
+    else if (iscprim(v)) {
+        numerictype_t nt = cp_numtype((cprim_t*)ptr(v));
+        if (nt < T_FLOAT)
+            return FL_T;
+        void *data = cp_data((cprim_t*)ptr(v));
+        if (nt == T_FLOAT) {
+            float f = *(float*)data;
+            if (f < 0) f = -f;
+            if (f <= FLT_MAXINT && (float)(int32_t)f == f)
+                return FL_T;
+        }
+        else {
+            assert(nt == T_DOUBLE);
+            double d = *(double*)data;
+            if (d < 0) d = -d;
+            if (d <= DBL_MAXINT && (double)(int64_t)d == d)
+                return FL_T;
+        }
+    }
+    return FL_F;
+}
+
 value_t fl_fixnum(value_t *args, u_int32_t nargs)
 {
     argcount("fixnum", nargs, 1);
@@ -377,6 +406,7 @@ static builtinspec_t builtin_info[] = {
     { "intern", fl_intern },
     { "fixnum", fl_fixnum },
     { "truncate", fl_truncate },
+    { "integer?", fl_integerp },
 
     { "vector.alloc", fl_vector_alloc },
 

femtolisp/flisp.c

@@ -59,7 +59,7 @@ static char *builtin_names[] =
 
       "cons", "list", "car", "cdr", "set-car!", "set-cdr!",
       "eval", "eval*", "apply", "prog1", "raise",
-      "+", "-", "*", "/", "<", "~", "&", "!", "$",
+      "+", "-", "*", "/", "<", "lognot", "logand", "logior", "logxor",
       "vector", "aref", "aset!", "length", "assq", "compare", "for",
       "", "", "" };
 
@@ -1139,28 +1139,28 @@ static value_t eval_sexpr(value_t e, uint32_t penv, int tail)
             }
             break;
         case F_BNOT:
-            argcount("~", nargs, 1);
+            argcount("lognot", nargs, 1);
             if (isfixnum(Stack[SP-1]))
                 v = fixnum(~numval(Stack[SP-1]));
             else
                 v = fl_bitwise_not(Stack[SP-1]);
             break;
         case F_BAND:
-            argcount("&", nargs, 2);
+            argcount("logand", nargs, 2);
             if (bothfixnums(Stack[SP-1], Stack[SP-2]))
                 v = Stack[SP-1] & Stack[SP-2];
             else
                 v = fl_bitwise_op(Stack[SP-2], Stack[SP-1], 0, "&");
             break;
         case F_BOR:
-            argcount("!", nargs, 2);
+            argcount("logior", nargs, 2);
             if (bothfixnums(Stack[SP-1], Stack[SP-2]))
                 v = Stack[SP-1] | Stack[SP-2];
             else
                 v = fl_bitwise_op(Stack[SP-2], Stack[SP-1], 1, "!");
             break;
         case F_BXOR:
-            argcount("$", nargs, 2);
+            argcount("logxor", nargs, 2);
             if (bothfixnums(Stack[SP-1], Stack[SP-2]))
                 v = fixnum(numval(Stack[SP-1]) ^ numval(Stack[SP-2]));
             else

femtolisp/read.c

@@ -16,15 +16,6 @@ static int symchar(char c)
     return (!isspace(c) && !strchr(special, c));
 }
 
-static int isdigit_base(char c, int base)
-{
-    if (base < 11)
-        return (c >= '0' && c < '0'+base);
-    return ((c >= '0' && c <= '9') ||
-            (c >= 'a' && c < 'a'+base-10) ||
-            (c >= 'A' && c < 'A'+base-10));
-}
-
 static int isnumtok_base(char *tok, value_t *pval, int base)
 {
     char *end;

femtolisp/string.c

@@ -347,6 +347,27 @@ value_t fl_string_dec(value_t *args, u_int32_t nargs)
     return size_wrap(i);
 }
 
+value_t fl_numbertostring(value_t *args, u_int32_t nargs)
+{
+    if (nargs < 1 || nargs > 2)
+        argcount("number->string", nargs, 2);
+    value_t n = args[0];
+    int64_t num;
+    if (isfixnum(n))      num = numval(n);
+    else if (!iscprim(n)) type_error("number->string", "integer", n);
+    else num = conv_to_int64(cp_data((cprim_t*)ptr(n)),
+                             cp_numtype((cprim_t*)ptr(n)));
+    ulong radix = 10;
+    if (nargs == 2) {
+        radix = toulong(args[1], "number->string");
+        if (radix < 2 || radix > 36)
+            lerror(ArgError, "number->string: invalid radix");
+    }
+    char buf[128];
+    char *str = int2str(buf, sizeof(buf), num, radix);
+    return string_from_cstr(str);
+}
+
 static builtinspec_t stringfunc_info[] = {
     { "string", fl_string },
     { "string?", fl_stringp },
@@ -360,6 +381,9 @@ static builtinspec_t stringfunc_info[] = {
     { "string.reverse", fl_string_reverse },
     { "string.encode", fl_string_encode },
     { "string.decode", fl_string_decode },
+
+    { "number->string", fl_numbertostring },
+
     { NULL, NULL }
 };
 

femtolisp/todo

@@ -600,13 +600,10 @@ cvalues todo:
 * allow int constructors to accept other int cvalues
 * array constructor should accept any cvalue of the right size
 * make sure cvalues participate well in circular printing
-- lispvalue type
-  . keep track of whether a cvalue leads to any lispvalues, so they can
-    be automatically relocated (?)
 * float, double
 - struct, union (may want to start with more general layout type)
 - pointer type, function type
-- finalizers and lifetime dependency tracking
+* finalizers
 - functions autorelease, guestfunction
 - cref/cset/byteref/byteset
 * wchar type, wide character strings as (array wchar)
@@ -614,13 +611,13 @@ cvalues todo:
 - ccall
 - anonymous unions
 * fix princ for cvalues
-- make header size for primitives 8 bytes, even on 64-bit arch
+* make header size for primitives <= 8 bytes, even on 64-bit arch
 - more efficient read for #array(), so it doesn't need to build a pairlist
-- make sure shared pieces of types, like lists of enum values, can be
-  printed as shared structure to avoid duplication.
-- share more types, allocate less
+? lispvalue type
+  . keep track of whether a cvalue leads to any lispvalues, so they can
+    be automatically relocated (?)
 
-- string constructor/concatenator:
+* string constructor/concatenator:
 (string 'sym #char(65) #wchar(945) "blah" 23)
    ; gives "symA\u03B1blah23"
 "ccc"  reads to (array char)

llt/int2str.c

@@ -1,10 +1,10 @@
 #include <stdlib.h>
 #include "dtypes.h"
 
-char *int2str(char *dest, size_t n, long num, uint32_t base)
+char *int2str(char *dest, size_t len, int64_t num, uint32_t base)
 {
-    int i = n-1;
-    int b = (int)base, neg = 0;
+    int i = len-1, neg = 0;
+    int64_t b = (int64_t)base;
     char ch;
     if (num < 0) {
         num = -num;
@@ -26,3 +26,37 @@ char *int2str(char *dest, size_t n, long num, uint32_t base)
         dest[i--] = '-';
     return &dest[i+1];
 }
+
+int isdigit_base(char c, int base)
+{
+    if (base < 11)
+        return (c >= '0' && c < '0'+base);
+    return ((c >= '0' && c <= '9') ||
+            (c >= 'a' && c < 'a'+base-10) ||
+            (c >= 'A' && c < 'A'+base-10));
+}
+
+/* assumes valid base, returns 1 on error, 0 if OK */
+int str2int(char *str, size_t len, int64_t *res, uint32_t base)
+{
+    int64_t result, place;
+    char digit;
+    int i;
+
+    place = 1; result = 0;
+    for(i=len-1; i>=0; i--) {
+        digit = str[i];
+        if (!isdigit_base(digit, base))
+            return 1;
+        if (digit <= '9')
+            digit -= '0';
+        else if (digit >= 'a')
+            digit = digit-'a'+10;
+        else if (digit >= 'A')
+            digit = digit-'A'+10;
+        result += digit * place;
+        place *= base;
+    }
+    *res = result;
+    return 0;
+}

llt/utils.h

@@ -45,7 +45,9 @@ void snprint_cplx(char *s, size_t cnt, double re, double im,
                   // print spaces around sign in a+bi
                   int spflag);
 
-char *int2str(char *dest, size_t n, long num, uint32_t base);
+char *int2str(char *dest, size_t len, int64_t num, uint32_t base);
+int str2int(char *str, size_t len, int64_t *res, uint32_t base);
+int isdigit_base(char c, int base);
 
 extern double trunc(double x);