adding integer? and number->string

a bit more renaming
This commit is contained in:
JeffBezanson 2009-02-01 05:41:43 +00:00
parent 17d81eb4e6
commit 2c1bb59486
7 changed files with 105 additions and 27 deletions

View File

@ -182,6 +182,35 @@ value_t fl_constantp(value_t *args, u_int32_t nargs)
return FL_T; 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) value_t fl_fixnum(value_t *args, u_int32_t nargs)
{ {
argcount("fixnum", nargs, 1); argcount("fixnum", nargs, 1);
@ -377,6 +406,7 @@ static builtinspec_t builtin_info[] = {
{ "intern", fl_intern }, { "intern", fl_intern },
{ "fixnum", fl_fixnum }, { "fixnum", fl_fixnum },
{ "truncate", fl_truncate }, { "truncate", fl_truncate },
{ "integer?", fl_integerp },
{ "vector.alloc", fl_vector_alloc }, { "vector.alloc", fl_vector_alloc },

View File

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

View File

@ -16,15 +16,6 @@ static int symchar(char c)
return (!isspace(c) && !strchr(special, 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) static int isnumtok_base(char *tok, value_t *pval, int base)
{ {
char *end; char *end;

View File

@ -347,6 +347,27 @@ value_t fl_string_dec(value_t *args, u_int32_t nargs)
return size_wrap(i); 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[] = { static builtinspec_t stringfunc_info[] = {
{ "string", fl_string }, { "string", fl_string },
{ "string?", fl_stringp }, { "string?", fl_stringp },
@ -360,6 +381,9 @@ static builtinspec_t stringfunc_info[] = {
{ "string.reverse", fl_string_reverse }, { "string.reverse", fl_string_reverse },
{ "string.encode", fl_string_encode }, { "string.encode", fl_string_encode },
{ "string.decode", fl_string_decode }, { "string.decode", fl_string_decode },
{ "number->string", fl_numbertostring },
{ NULL, NULL } { NULL, NULL }
}; };

View File

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

View File

@ -1,10 +1,10 @@
#include <stdlib.h> #include <stdlib.h>
#include "dtypes.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 i = len-1, neg = 0;
int b = (int)base, neg = 0; int64_t b = (int64_t)base;
char ch; char ch;
if (num < 0) { if (num < 0) {
num = -num; num = -num;
@ -26,3 +26,37 @@ char *int2str(char *dest, size_t n, long num, uint32_t base)
dest[i--] = '-'; dest[i--] = '-';
return &dest[i+1]; 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;
}

View File

@ -45,7 +45,9 @@ void snprint_cplx(char *s, size_t cnt, double re, double im,
// print spaces around sign in a+bi // print spaces around sign in a+bi
int spflag); 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); extern double trunc(double x);