ref: 8f93c9dfc67de6759f713809d7faa37c5cb7a30c
parent: 9023705d27dc25a46f43a60257811a9b0a8ddac0
author: JeffBezanson <[email protected]>
date: Mon Mar 23 15:49:08 EDT 2009
adding string->number
--- a/femtolisp/flisp.h
+++ b/femtolisp/flisp.h
@@ -141,6 +141,7 @@
value_t equal(value_t a, value_t b); // T or nil
int equal_lispvalue(value_t a, value_t b);
uptrint_t hash_lispvalue(value_t a);
+int isnumtok_base(char *tok, value_t *pval, int base);
/* safe casts */
cons_t *tocons(value_t v, char *fname);
--- a/femtolisp/read.c
+++ b/femtolisp/read.c
@@ -17,7 +17,7 @@
return (!isspace(c) && !strchr(special, c));
}
-static int isnumtok_base(char *tok, value_t *pval, int base)
+int isnumtok_base(char *tok, value_t *pval, int base)
{
char *end;
int64_t i64;
--- a/femtolisp/string.c
+++ b/femtolisp/string.c
@@ -290,6 +290,14 @@
return size_wrap(i);
}
+static ulong get_radix_arg(value_t arg, char *fname)
+{
+ ulong radix = toulong(arg, fname);
+ if (radix < 2 || radix > 36)
+ lerror(ArgError, "%s: invalid radix", fname);
+ return radix;
+}
+
value_t fl_numbertostring(value_t *args, u_int32_t nargs)
{
if (nargs < 1 || nargs > 2)
@@ -306,11 +314,8 @@
neg = 1;
}
ulong radix = 10;
- if (nargs == 2) {
- radix = toulong(args[1], "number->string");
- if (radix < 2 || radix > 36)
- lerror(ArgError, "number->string: invalid radix");
- }
+ if (nargs == 2)
+ radix = get_radix_arg(args[1], "number->string");
char buf[128];
char *str = uint2str(buf, sizeof(buf), num, radix);
if (neg && str > &buf[0])
@@ -318,6 +323,20 @@
return string_from_cstr(str);
}
+value_t fl_stringtonumber(value_t *args, uint32_t nargs)
+{
+ if (nargs < 1 || nargs > 2)
+ argcount("string->number", nargs, 2);
+ char *str = tostring(args[0], "string->number");
+ value_t n;
+ ulong radix = 0;
+ if (nargs == 2)
+ radix = get_radix_arg(args[1], "string->number");
+ if (!isnumtok_base(str, &n, (int)radix))
+ return FL_F;
+ return n;
+}
+
static builtinspec_t stringfunc_info[] = {
{ "string", fl_string },
{ "string?", fl_stringp },
@@ -333,6 +352,7 @@
{ "string.decode", fl_string_decode },
{ "number->string", fl_numbertostring },
+ { "string->number", fl_stringtonumber },
{ NULL, NULL }
};