ref: a9a81aed1f002597ceaa01fa7e2d7ae127e2b9b7
parent: d9d5b07e060c0c53f17a1428566049f6b1123f3c
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Wed Mar 29 08:00:15 EDT 2023
keep current function/builtin name around to remove fname passing around everywhere
--- a/builtins.c
+++ b/builtins.c
@@ -34,7 +34,7 @@
pcdr = &c->cdr;
}
else if (lst != FL_NIL) {- type_error("nconc", "cons", lst);+ type_error("cons", lst);}
}
*pcdr = lst;
@@ -43,7 +43,7 @@
BUILTIN("assq", assq) {- argcount("assq", nargs, 2);+ argcount(nargs, 2);
value_t item = args[0];
value_t v = args[1];
value_t bind;
@@ -61,7 +61,7 @@
{value_t v;
cons_t *c;
- argcount("memq", nargs, 2);+ argcount(nargs, 2);
for (v = args[1]; iscons(v); v = c->cdr) {if ((c = ptr(v))->car == args[0])
return v;
@@ -71,7 +71,7 @@
BUILTIN("length", length) {- argcount("length", nargs, 1);+ argcount(nargs, 1);
value_t a = args[0];
cvalue_t *cv;
if (isvector(a)) {@@ -95,12 +95,12 @@
else if (iscons(a)) {return fixnum(llength(a));
}
- type_error("length", "sequence", a);+ type_error("sequence", a);}
BUILTIN("raise", raise) {- argcount("raise", nargs, 1);+ argcount(nargs, 1);
fl_raise(args[0]);
}
@@ -107,7 +107,7 @@
BUILTIN("exit", exit) {if (nargs > 0)
- exit(tofixnum(args[0], "exit"));
+ exit(tofixnum(args[0]));
exit(0);
return FL_NIL;
}
@@ -114,15 +114,15 @@
BUILTIN("symbol", symbol) {- argcount("symbol", nargs, 1);+ argcount(nargs, 1);
if (!fl_isstring(args[0]))
- type_error("symbol", "string", args[0]);+ type_error("string", args[0]);return symbol(cvalue_data(args[0]));
}
BUILTIN("keyword?", keywordp) {- argcount("keyword?", nargs, 1);+ argcount(nargs, 1);
return (issymbol(args[0]) &&
iskeyword((symbol_t*)ptr(args[0]))) ? FL_T : FL_F;
}
@@ -129,8 +129,8 @@
BUILTIN("top-level-value", top_level_value) {- argcount("top-level-value", nargs, 1);- symbol_t *sym = tosymbol(args[0], "top-level-value");
+ argcount(nargs, 1);
+ symbol_t *sym = tosymbol(args[0]);
if (sym->binding == UNBOUND)
fl_raise(fl_list2(UnboundError, args[0]));
return sym->binding;
@@ -138,8 +138,8 @@
BUILTIN("set-top-level-value!", set_top_level_value) {- argcount("set-top-level-value!", nargs, 2);- symbol_t *sym = tosymbol(args[0], "set-top-level-value!");
+ argcount(nargs, 2);
+ symbol_t *sym = tosymbol(args[0]);
if (!isconstant(sym))
sym->binding = args[1];
return args[1];
@@ -161,7 +161,7 @@
BUILTIN("environment", environment) {USED(args);
- argcount("environment", nargs, 0);+ argcount(nargs, 0);
value_t lst = FL_NIL;
fl_gc_handle(&lst);
global_env_list(symtab, &lst);
@@ -173,7 +173,7 @@
BUILTIN("constant?", constantp) {- argcount("constant?", nargs, 1);+ argcount(nargs, 1);
if (issymbol(args[0]))
return (isconstant((symbol_t*)ptr(args[0])) ? FL_T : FL_F);
if (iscons(args[0])) {@@ -186,7 +186,7 @@
BUILTIN("integer-valued?", integer_valuedp) {- argcount("integer-valued?", nargs, 1);+ argcount(nargs, 1);
value_t v = args[0];
if (isfixnum(v)) {return FL_T;
@@ -215,7 +215,7 @@
BUILTIN("integer?", integerp) {- argcount("integer?", nargs, 1);+ argcount(nargs, 1);
value_t v = args[0];
return (isfixnum(v) ||
(iscprim(v) && cp_numtype((cprim_t*)ptr(v)) < T_FLOAT)) ?
@@ -224,7 +224,7 @@
BUILTIN("fixnum", fixnum) {- argcount("fixnum", nargs, 1);+ argcount(nargs, 1);
if (isfixnum(args[0])) {return args[0];
}
@@ -232,7 +232,7 @@
cprim_t *cp = (cprim_t*)ptr(args[0]);
return fixnum(conv_to_long(cp_data(cp), cp_numtype(cp)));
}
- type_error("fixnum", "number", args[0]);+ type_error("number", args[0]);}
double trunc(double x);
@@ -239,7 +239,7 @@
BUILTIN("truncate", truncate) {- argcount("truncate", nargs, 1);+ argcount(nargs, 1);
if (isfixnum(args[0]))
return args[0];
if (iscprim(args[0])) {@@ -263,7 +263,7 @@
return args[0];
return return_from_int64((int64_t)d);
}
- type_error("truncate", "number", args[0]);+ type_error("number", args[0]);}
BUILTIN("vector.alloc", vector_alloc)@@ -271,10 +271,10 @@
fixnum_t i;
value_t f, v;
if (nargs == 0)
- lerrorf(ArgError, "vector.alloc: too few arguments");
- i = (fixnum_t)toulong(args[0], "vector.alloc");
+ lerrorf(ArgError, "too few arguments");
+ i = (fixnum_t)toulong(args[0]);
if (i < 0)
- lerrorf(ArgError, "vector.alloc: invalid size");
+ lerrorf(ArgError, "invalid size");
v = alloc_vector((unsigned)i, 0);
if (nargs == 2)
f = args[1];
@@ -288,12 +288,12 @@
BUILTIN("time.now", time_now) {- argcount("time.now", nargs, 0);+ argcount(nargs, 0);
USED(args);
return mk_double(clock_now());
}
-static double todouble(value_t a, char *fname)
+static double todouble(value_t a)
{if (isfixnum(a))
return (double)numval(a);
@@ -302,13 +302,13 @@
numerictype_t nt = cp_numtype(cp);
return conv_to_double(cp_data(cp), nt);
}
- type_error(fname, "number", a);
+ type_error("number", a);}
BUILTIN("time.string", time_string) {- argcount("time.string", nargs, 1);- double t = todouble(args[0], "time.string");
+ argcount(nargs, 1);
+ double t = todouble(args[0]);
char buf[64];
timestring(t, buf, sizeof(buf));
return string_from_cstr(buf);
@@ -316,8 +316,8 @@
BUILTIN("time.fromstring", time_fromstring) {- argcount("time.fromstring", nargs, 1);- char *ptr = tostring(args[0], "time.fromstring");
+ argcount(nargs, 1);
+ char *ptr = tostring(args[0]);
double t = parsetime(ptr);
int64_t it = (int64_t)t;
if ((double)it == t && fits_fixnum(it))
@@ -328,29 +328,29 @@
BUILTIN("path.cwd", path_cwd) {if (nargs > 1)
- argcount("path.cwd", nargs, 1);+ argcount(nargs, 1);
if (nargs == 0) {char buf[1024];
getcwd(buf, sizeof(buf));
return string_from_cstr(buf);
}
- char *ptr = tostring(args[0], "path.cwd");
+ char *ptr = tostring(args[0]);
if (chdir(ptr))
- lerrorf(IOError, "path.cwd: could not cd to %s", ptr);
+ lerrorf(IOError, "could not cd to %s", ptr);
return FL_T;
}
BUILTIN("path.exists?", path_existsp) {- argcount("path.exists?", nargs, 1);- char *path = tostring(args[0], "path.exists?");
+ argcount(nargs, 1);
+ char *path = tostring(args[0]);
return access(path, F_OK) == 0 ? FL_T : FL_F;
}
BUILTIN("os.getenv", os_getenv) {- argcount("os.getenv", nargs, 1);- char *name = tostring(args[0], "os.getenv");
+ argcount(nargs, 1);
+ char *name = tostring(args[0]);
char *val = getenv(name);
if (val == nil) return FL_F;
if (*val == 0)
@@ -360,18 +360,18 @@
BUILTIN("os.setenv", os_setenv) {- argcount("os.setenv", nargs, 2);- char *name = tostring(args[0], "os.setenv");
+ argcount(nargs, 2);
+ char *name = tostring(args[0]);
int result;
if (args[1] == FL_F) {result = unsetenv(name);
}
else {- char *val = tostring(args[1], "os.setenv");
+ char *val = tostring(args[1]);
result = setenv(name, val, 1);
}
if (result != 0)
- lerrorf(ArgError, "os.setenv: invalid environment variable");
+ lerrorf(ArgError, "invalid environment variable");
return FL_T;
}
@@ -413,17 +413,17 @@
return mk_float(rand_float());
}
-#define BUILTIN_(lname, cname) \
-BUILTIN(lname, cname) \
+#define BUILTIN_(lname, cname) \
+BUILTIN(lname, cname) \
{ \- argcount(lname, nargs, 1); \
+ argcount(nargs, 1); \
if (iscprim(args[0])) { \cprim_t *cp = (cprim_t*)ptr(args[0]); \
numerictype_t nt = cp_numtype(cp); \
if (nt == T_FLOAT) \
- return mk_float(cname##f(*(float*)cp_data(cp))); \
+ return mk_float(cname##f(*(float*)cp_data(cp))); \
} \
- return mk_double(cname(todouble(args[0], lname))); \
+ return mk_double(cname(todouble(args[0]))); \
}
BUILTIN_("sqrt", sqrt)--- a/cvalues.c
+++ b/cvalues.c
@@ -272,7 +272,7 @@
value_t cp = cprim(typenam##type, sizeof(ctype)); \
if (cvalue_##ctype##_init(typenam##type, \
args[0], cp_data((cprim_t*)ptr(cp)))) \
- type_error(#typenam, "number", args[0]); \
+ type_error("number", args[0]); \return cp; \
}
@@ -316,7 +316,7 @@
return mk_ulong(sz);
}
-size_t toulong(value_t n, char *fname)
+size_t toulong(value_t n)
{if (isfixnum(n))
return numval(n);
@@ -324,10 +324,10 @@
cprim_t *cp = (cprim_t*)ptr(n);
return conv_to_ulong(cp_data(cp), cp_numtype(cp));
}
- type_error(fname, "number", n);
+ type_error("number", n);}
-off_t tooffset(value_t n, char *fname)
+off_t tooffset(value_t n)
{if (isfixnum(n))
return numval(n);
@@ -335,7 +335,7 @@
cprim_t *cp = (cprim_t*)ptr(n);
return conv_to_int64(cp_data(cp), cp_numtype(cp));
}
- type_error(fname, "number", n);
+ type_error("number", n);}
static int cvalue_enum_init(fltype_t *ft, value_t arg, void *dest)
@@ -346,7 +346,7 @@
syms = car(cdr(type));
if (!isvector(syms))
- type_error("enum", "vector", syms);+ type_error("vector", syms); if (issymbol(arg)) { for(n=0; n < (int)vector_size(syms); n++) { if (vector_elt(syms, n) == arg) {@@ -364,7 +364,7 @@
n = conv_to_int32(cp_data(cp), cp_numtype(cp));
}
else {- type_error("enum", "number", arg);+ type_error("number", arg);}
if ((unsigned)n >= vector_size(syms))
lerrorf(ArgError, "enum: value out of range");
@@ -374,7 +374,7 @@
BUILTIN("enum", enum) {- argcount("enum", nargs, 2);+ argcount(nargs, 2);
value_t type = fl_list2(enumsym, args[0]);
fltype_t *ft = get_type(type);
value_t cv = cvalue(ft, sizeof(int32_t));
@@ -410,9 +410,9 @@
cnt = predict_arraylen(arg);
if (iscons(cdr_(cdr_(type)))) {- size_t tc = toulong(car_(cdr_(cdr_(type))), "array");
+ size_t tc = toulong(car_(cdr_(cdr_(type))));
if (tc != cnt)
- lerrorf(ArgError, "array: size mismatch");
+ lerrorf(ArgError, "size mismatch");
}
sz = elsize * cnt;
@@ -458,7 +458,7 @@
if (cnt == 1)
cvalue_init(eltype, arg, dest);
else
- type_error("array", "sequence", arg);+ type_error("sequence", arg);return 0;
}
@@ -469,7 +469,7 @@
int i;
if (nargs < 1)
- argcount("array", nargs, 1);+ argcount(nargs, 1);
cnt = nargs - 1;
fltype_t *type = get_array_type(args[0]);
@@ -555,7 +555,7 @@
if (!iscons(cdr_(cdr_(type))))
lerrorf(ArgError, "sizeof: incomplete type");
value_t n = car_(cdr_(cdr_(type)));
- size_t sz = toulong(n, "sizeof");
+ size_t sz = toulong(n);
return sz * ctype_sizeof(t, palign);
}
else if (hed == structsym) {@@ -576,7 +576,7 @@
extern fltype_t *iostreamtype;
// get pointer and size for any plain-old-data value
-void to_sized_ptr(value_t v, char *fname, char **pdata, size_t *psz)
+void to_sized_ptr(value_t v, char **pdata, size_t *psz)
{ if (iscvalue(v)) {cvalue_t *pcv = (cvalue_t*)ptr(v);
@@ -598,24 +598,24 @@
*psz = cp_class(pcp)->size;
return;
}
- type_error(fname, "plain-old-data", v);
+ type_error("plain-old-data", v);}
BUILTIN("sizeof", sizeof) {- argcount("sizeof", nargs, 1);+ argcount(nargs, 1);
if (issymbol(args[0]) || iscons(args[0])) {int a;
return size_wrap(ctype_sizeof(args[0], &a));
}
size_t n; char *data;
- to_sized_ptr(args[0], "sizeof", &data, &n);
+ to_sized_ptr(args[0], &data, &n);
return size_wrap(n);
}
BUILTIN("typeof", typeof) {- argcount("typeof", nargs, 1);+ argcount(nargs, 1);
switch(tag(args[0])) {case TAG_CONS: return pairsym;
case TAG_NUM1:
@@ -685,7 +685,7 @@
BUILTIN("copy", copy) {- argcount("copy", nargs, 1);+ argcount(nargs, 1);
if (iscons(args[0]) || isvector(args[0]))
lerrorf(ArgError, "copy: argument must be a leaf atom");
if (!iscvalue(args[0]))
@@ -697,7 +697,7 @@
BUILTIN("plain-old-data?", plain_old_datap) {- argcount("plain-old-data?", nargs, 1);+ argcount(nargs, 1);
return (iscprim(args[0]) ||
(iscvalue(args[0]) && cv_isPOD((cvalue_t*)ptr(args[0])))) ?
FL_T : FL_F;
@@ -720,7 +720,7 @@
BUILTIN("c-value", c_value) {if (nargs < 1 || nargs > 2)
- argcount("c-value", nargs, 2);+ argcount(nargs, 2);
value_t type = args[0];
fltype_t *ft = get_type(type);
value_t cv;
@@ -730,7 +730,7 @@
size_t cnt;
if (iscons(cdr_(cdr_(type))))
- cnt = toulong(car_(cdr_(cdr_(type))), "array");
+ cnt = toulong(car_(cdr_(cdr_(type))));
else if (nargs == 2)
cnt = predict_arraylen(args[1]);
else
@@ -767,7 +767,7 @@
return fixnum(diff);
}
-static void check_addr_args(char *fname, value_t arr, value_t ind,
+static void check_addr_args(value_t arr, value_t ind,
char **data, int *index)
{int numel;
@@ -774,9 +774,9 @@
cvalue_t *cv = (cvalue_t*)ptr(arr);
*data = cv_data(cv);
numel = cv_len(cv)/(cv_class(cv)->elsz);
- *index = toulong(ind, fname);
+ *index = toulong(ind);
if (*index >= numel)
- bounds_error(fname, arr, ind);
+ bounds_error(arr, ind);
}
static value_t cvalue_array_aref(value_t *args)
@@ -787,7 +787,7 @@
numerictype_t nt = eltype->numtype;
if (nt >= T_INT32)
el = cvalue(eltype, eltype->size);
- check_addr_args("aref", args[0], args[1], &data, &index);+ check_addr_args(args[0], args[1], &data, &index);
if (nt < T_INT32) {if (nt == T_INT8)
return fixnum((int8_t)data[index]);
@@ -816,7 +816,7 @@
{char *data; int index;
fltype_t *eltype = cv_class((cvalue_t*)ptr(args[0]))->eltype;
- check_addr_args("aset!", args[0], args[1], &data, &index);+ check_addr_args(args[0], args[1], &data, &index);
char *dest = data + index*eltype->size;
cvalue_init(eltype, args[2], dest);
return args[2];
@@ -824,11 +824,11 @@
BUILTIN("builtin", builtin) {- argcount("builtin", nargs, 1);- symbol_t *name = tosymbol(args[0], "builtin");
+ argcount(nargs, 1);
+ symbol_t *name = tosymbol(args[0]);
cvalue_t *cv;
if (ismanaged(args[0]) || (cv=name->dlcache) == nil)
- lerrorf(ArgError, "builtin: function %s not found", name->name);
+ lerrorf(ArgError, "function %s not found", name->name);
return tagptr(cv, TAG_CVALUE);
}
@@ -835,7 +835,7 @@
value_t cbuiltin(char *name, builtin_t f)
{cvalue_t *cv;
- cv = malloc(CVALUE_NWORDS * sizeof(*cv));
+ cv = calloc(CVALUE_NWORDS, sizeof(*cv));
cv->type = builtintype;
cv->data = &cv->_space[0];
cv->len = sizeof(value_t);
@@ -946,7 +946,7 @@
continue;
}
add_type_error:
- type_error("+", "number", arg);+ type_error("number", arg);}
if (inexact) {Faccum += Uaccum;
@@ -1015,7 +1015,7 @@
break;
}
}
- type_error("-", "number", n);+ type_error("number", n);}
static value_t fl_mul_any(value_t *args, uint32_t nargs, int64_t Saccum)
@@ -1058,7 +1058,7 @@
continue;
}
mul_type_error:
- type_error("*", "number", arg);+ type_error("number", arg);}
if (inexact) {Faccum *= Uaccum;
@@ -1106,9 +1106,9 @@
eqnans: NaNs considered equal to each other
-0.0 not considered equal to 0.0
inexact not considered equal to exact
- fname: if not nil, throws type errors, else returns 2 for type errors
+ typeerr: if not 0, throws type errors, else returns 2 for type errors
*/
-int numeric_compare(value_t a, value_t b, int eq, int eqnans, char *fname)
+int numeric_compare(value_t a, value_t b, int eq, int eqnans, int typeerr)
{lltint_t ai, bi;
numerictype_t ta, tb;
@@ -1120,10 +1120,16 @@
return 1;
}
if (!num_to_ptr(a, &ai, &ta, &aptr)) {- if (fname) type_error(fname, "number", a); else return 2;
+ if (typeerr)
+ type_error("number", a);+ else
+ return 2;
}
if (!num_to_ptr(b, &bi, &tb, &bptr)) {- if (fname) type_error(fname, "number", b); else return 2;
+ if (typeerr)
+ type_error("number", b);+ else
+ return 2;
}
if (eq && eqnans && ((ta >= T_FLOAT) != (tb >= T_FLOAT)))
return 1;
@@ -1148,9 +1154,9 @@
void *aptr, *bptr;
if (!num_to_ptr(a, &ai, &ta, &aptr))
- type_error("/", "number", a);+ type_error("number", a);if (!num_to_ptr(b, &bi, &tb, &bptr))
- type_error("/", "number", b);+ type_error("number", b);da = conv_to_double(aptr, ta);
db = conv_to_double(bptr, tb);
@@ -1173,9 +1179,9 @@
int64_t a64, b64;
if (!num_to_ptr(a, &ai, &ta, &aptr))
- type_error("div0", "number", a);+ type_error("number", a);if (!num_to_ptr(b, &bi, &tb, &bptr))
- type_error("div0", "number", b);+ type_error("number", b); if (ta == T_UINT64) { if (tb == T_UINT64) {@@ -1209,7 +1215,7 @@
DivideByZeroError();
}
-static value_t fl_bitwise_op(value_t a, value_t b, int opcode, char *fname)
+static value_t fl_bitwise_op(value_t a, value_t b, int opcode)
{lltint_t ai, bi;
numerictype_t ta, tb, itmp;
@@ -1217,9 +1223,9 @@
int64_t b64;
if (!num_to_ptr(a, &ai, &ta, &aptr) || ta >= T_FLOAT)
- type_error(fname, "integer", a);
+ type_error("integer", a);if (!num_to_ptr(b, &bi, &tb, &bptr) || tb >= T_FLOAT)
- type_error(fname, "integer", b);
+ type_error("integer", b); if (ta < tb) {itmp = ta; ta = tb; tb = itmp;
@@ -1285,7 +1291,7 @@
if (bothfixnums(v, e))
v = v & e;
else
- v = fl_bitwise_op(v, e, 0, "logand");
+ v = fl_bitwise_op(v, e, 0);
}
return v;
}
@@ -1301,7 +1307,7 @@
if (bothfixnums(v, e))
v = v | e;
else
- v = fl_bitwise_op(v, e, 1, "logior");
+ v = fl_bitwise_op(v, e, 1);
}
return v;
}
@@ -1317,7 +1323,7 @@
if (bothfixnums(v, e))
v = fixnum(numval(v) ^ numval(e));
else
- v = fl_bitwise_op(v, e, 2, "logxor");
+ v = fl_bitwise_op(v, e, 2);
}
return v;
}
@@ -1324,7 +1330,7 @@
BUILTIN("lognot", lognot) {- argcount("lognot", nargs, 1);+ argcount(nargs, 1);
value_t a = args[0];
if (isfixnum(a))
return fixnum(~numval(a));
@@ -1347,7 +1353,7 @@
case T_UINT64: return mk_uint64(~*(uint64_t*)aptr);
}
}
- type_error("lognot", "integer", a);+ type_error("integer", a);}
BUILTIN("ash", ash)@@ -1354,9 +1360,9 @@
{fixnum_t n;
int64_t accum;
- argcount("ash", nargs, 2);+ argcount(nargs, 2);
value_t a = args[0];
- n = tofixnum(args[1], "ash");
+ n = tofixnum(args[1]);
if (isfixnum(a)) {if (n <= 0)
return fixnum(numval(a)>>(-n));
@@ -1396,7 +1402,7 @@
}
}
}
- type_error("ash", "integer", a);+ type_error("integer", a);}
static void cvalues_init(void)
--- a/equal.c
+++ b/equal.c
@@ -72,7 +72,7 @@
if (iscprim(b)) {if (cp_class((cprim_t*)ptr(b)) == wchartype)
return fixnum(1);
- return fixnum(numeric_compare(a, b, eq, 1, nil));
+ return fixnum(numeric_compare(a, b, eq, 1, 0));
}
return fixnum(-1);
case TAG_SYM:
@@ -92,7 +92,7 @@
else if (iscprim(b) && cp_class((cprim_t*)ptr(b)) == wchartype) {return fixnum(1);
}
- c = numeric_compare(a, b, eq, 1, nil);
+ c = numeric_compare(a, b, eq, 1, 0);
if (c != 2)
return fixnum(c);
break;
@@ -386,6 +386,6 @@
BUILTIN("hash", hash) {- argcount("hash", nargs, 1);+ argcount(nargs, 1);
return fixnum(hash_lispvalue(args[0]));
}
--- a/flisp.c
+++ b/flisp.c
@@ -29,6 +29,7 @@
static value_t *Stack;
static uint32_t SP = 0;
static uint32_t curr_frame = 0;
+static char *curr_fname = nil;
#define PUSH(v) (Stack[SP++] = (v))
#define POP() (Stack[--SP])
#define POPN(n) (SP-=(n))
@@ -133,8 +134,17 @@
static value_t make_error_msg(char *format, va_list args)
{- char msgbuf[512];
- vsnprintf(msgbuf, sizeof(msgbuf), format, args);
+ char msgbuf[512], *s;
+ int n;
+ if (curr_fname != nil) {+ n = snprintf(msgbuf, sizeof(msgbuf), "%s: ", curr_fname);
+ curr_fname = nil;
+ } else {+ n = 0;
+ }
+ s = msgbuf + n;
+ n = sizeof(msgbuf) - n;
+ vsnprintf(s, n, format, args);
return string_from_cstr(msgbuf);
}
@@ -150,25 +160,25 @@
fl_raise(fl_list2(e, msg));
}
-_Noreturn void type_error(char *fname, char *expected, value_t got)
+_Noreturn void type_error(char *expected, value_t got)
{- fl_raise(fl_listn(4, TypeError, symbol(fname), symbol(expected), got));
+ fl_raise(fl_listn(4, TypeError, symbol(curr_fname), symbol(expected), got));
}
-_Noreturn void bounds_error(char *fname, value_t arr, value_t ind)
+_Noreturn void bounds_error(value_t arr, value_t ind)
{- fl_raise(fl_listn(4, BoundsError, symbol(fname), arr, ind));
+ fl_raise(fl_listn(4, BoundsError, symbol(curr_fname), arr, ind));
}
// safe cast operators --------------------------------------------------------
#define isstring fl_isstring
-#define SAFECAST_OP(type,ctype,cnvt) \
-ctype to##type(value_t v, char *fname) \
-{ \- if (is##type(v)) \
- return (ctype)cnvt(v); \
- type_error(fname, #type, v); \
+#define SAFECAST_OP(type,ctype,cnvt) \
+ctype to##type(value_t v) \
+{ \+ if (is##type(v)) \
+ return (ctype)cnvt(v); \
+ type_error(#type, v); \
}
SAFECAST_OP(cons, cons_t*, ptr)
SAFECAST_OP(symbol,symbol_t*,ptr)
@@ -240,7 +250,7 @@
static int gsnameno=0;
BUILTIN("gensym", gensym) {- argcount("gensym", nargs, 0);+ argcount(nargs, 0);
USED(args);
gensym_t *gs = (gensym_t*)alloc_words(sizeof(gensym_t)/sizeof(void*));
gs->id = _gensym_ctr++;
@@ -257,7 +267,7 @@
BUILTIN("gensym?", gensymp) {- argcount("gensym?", nargs, 1);+ argcount(nargs, 1);
return isgensym(args[0]) ? FL_T : FL_F;
}
@@ -560,6 +570,23 @@
// utils ----------------------------------------------------------------------
+static char *cvalue_name(value_t v)
+{+ cvalue_t *cv = (cvalue_t*)ptr(v);
+ static char name[64];
+ value_t label;
+
+ void *data = cptr(v);
+ void *fptr = *(void**)data;
+ label = (value_t)ptrhash_get(&reverse_dlsym_lookup_table, cv);
+ if (label == (value_t)HT_NOTFOUND)
+ snprintf(name, sizeof(name), "#<builtin @%p>", fptr);
+ else
+ snprintf(name, sizeof(name), "#fn(%s)", symbol_name(label));
+ return name;
+}
+
+
// apply function with n args on the stack
static value_t _applyn(uint32_t n)
{@@ -567,6 +594,7 @@
uint32_t saveSP = SP;
value_t v;
if (iscbuiltin(f)) {+ curr_fname = cvalue_name(f);
v = ((builtin_t*)ptr(f))[3](&Stack[SP-n], n);
}
else if (isfunction(f)) {@@ -577,10 +605,11 @@
if (ptr(tab) == nil)
lerrorf(UnboundError, "builtins table");
Stack[SP-n-1] = vector_elt(tab, uintval(f));
+ curr_fname = builtins[uintval(f)].name;
v = apply_cl(n);
}
else {- type_error("apply", "function", f);+ type_error("function", f);}
SP = saveSP;
return v;
@@ -912,6 +941,8 @@
op = *ip++;
while(1){+ if(op < nelem(builtins) && builtins[op].name != nil)
+ curr_fname = builtins[op].name;
switch (op) {OP(OP_LOADA0)
v = captured ? vector_elt(Stack[bp], 0) : Stack[bp];
@@ -970,6 +1001,8 @@
Stack[curr_frame-2] = (uintptr_t)ip;
}
nargs = n;
+ function_t *fn = (function_t*)ptr(func);
+ curr_fname = fn->name == LAMBDA ? "lambda" : symbol_name(fn->name);
goto apply_cl_top;
}
else {@@ -977,13 +1010,14 @@
if (isbuiltin(func)) {s = builtins[i].nargs;
if (s >= 0)
- argcount(builtins[i].name, n, s);
+ argcount(n, s);
else if (s != ANYARGS && (signed)n < -s)
- argcount(builtins[i].name, n, -s);
+ argcount(n, -s);
// remove function arg
for(s=SP-n-1; s < (int)SP-1; s++)
Stack[s] = Stack[s+1];
SP--;
+ curr_fname = builtins[i].name;
switch (i) {case OP_LIST: goto apply_list;
case OP_VECTOR: goto apply_vector;
@@ -1001,12 +1035,13 @@
}
else if (iscbuiltin(func)) {s = SP;
+ curr_fname = cvalue_name(func);
v = ((builtin_t)(((void**)ptr(func))[3]))(&Stack[SP-n], n);
SP = s-n;
Stack[SP-1] = v;
NEXT_OP;
}
- type_error("apply", "function", func);+ type_error("function", func);OP(OP_LOADGL)
v = fn_vals(Stack[bp-1]);
@@ -1073,7 +1108,7 @@
OP(OP_CAR)
v = Stack[SP-1];
if (!iscons(v))
- type_error("car", "cons", v);+ type_error("cons", v);Stack[SP-1] = car_(v);
NEXT_OP;
@@ -1080,7 +1115,7 @@
OP(OP_CDR)
v = Stack[SP-1];
if (!iscons(v))
- type_error("cdr", "cons", v);+ type_error("cons", v);Stack[SP-1] = cdr_(v);
NEXT_OP;
@@ -1167,9 +1202,9 @@
v = Stack[SP-2];
if (isvector(v)) {e = Stack[SP-1];
- i = isfixnum(e) ? numval(e) : (uint32_t)toulong(e, "aref");
+ i = isfixnum(e) ? numval(e) : (uint32_t)toulong(e);
if ((unsigned)i >= vector_size(v))
- bounds_error("aref", v, e);+ bounds_error(v, e);
v = vector_elt(v, i);
}
else if (isarray(v)) {@@ -1176,7 +1211,7 @@
v = cvalue_array_aref(&Stack[SP-2]);
}
else {- type_error("aref", "sequence", v);+ type_error("sequence", v);}
POPN(1);
Stack[SP-1] = v;
@@ -1256,10 +1291,10 @@
OP(OP_CADR)
v = Stack[SP-1];
if (!iscons(v))
- type_error("cdr", "cons", v);+ type_error("cons", v);v = cdr_(v);
if (!iscons(v))
- type_error("car", "cons", v);+ type_error("cons", v);Stack[SP-1] = car_(v);
NEXT_OP;
@@ -1287,7 +1322,7 @@
NEXT_OP;
OP(OP_BOUNDP)
- sym = tosymbol(Stack[SP-1], "bound?");
+ sym = tosymbol(Stack[SP-1]);
Stack[SP-1] = sym->binding == UNBOUND ? FL_F : FL_T;
NEXT_OP;
@@ -1508,7 +1543,7 @@
if (bothfixnums(v, e))
v = v == e ? FL_T : FL_F;
else
- v = !numeric_compare(v,e,1,0,"=") ? FL_T : FL_F;
+ v = !numeric_compare(v,e,1,0,1) ? FL_T : FL_F;
POPN(1);
Stack[SP-1] = v;
NEXT_OP;
@@ -1526,7 +1561,7 @@
ip += 4;
}
if (nargs != n)
- lerrorf(ArgError, "apply: too %s arguments", nargs > n ? "many" : "few");
+ lerrorf(ArgError, "too %s arguments", nargs > n ? "many" : "few");
NEXT_OP;
OP(OP_VECTOR)
@@ -1543,9 +1578,9 @@
OP(OP_ASET)
e = Stack[SP-3];
if (isvector(e)) {- i = tofixnum(Stack[SP-2], "aset!");
+ i = tofixnum(Stack[SP-2]);
if ((unsigned)i >= vector_size(e))
- bounds_error("aset!", v, Stack[SP-1]);+ bounds_error(v, Stack[SP-1]);
vector_elt(e, i) = (v=Stack[SP-1]);
}
else if (isarray(e)) {@@ -1552,7 +1587,7 @@
v = cvalue_array_aset(&Stack[SP-3]);
}
else {- type_error("aset!", "sequence", e);+ type_error("sequence", e);}
POPN(2);
Stack[SP-1] = v;
@@ -1559,8 +1594,8 @@
NEXT_OP;
OP(OP_FOR)
- s = tofixnum(Stack[SP-3], "for");
- hi = tofixnum(Stack[SP-2], "for");
+ s = tofixnum(Stack[SP-3]);
+ hi = tofixnum(Stack[SP-2]);
//f = Stack[SP-1];
v = FL_UNSPECIFIED;
SP += 2;
@@ -1798,11 +1833,11 @@
if (nargs == 1 && issymbol(args[0]))
return fn_builtin_builtin(args, nargs);
if (nargs < 2 || nargs > 4)
- argcount("function", nargs, 2);+ argcount(nargs, 2);
if (!fl_isstring(args[0]))
- type_error("function", "string", args[0]);+ type_error("string", args[0]);if (!isvector(args[1]))
- type_error("function", "vector", args[1]);+ type_error("vector", args[1]);cvalue_t *arr = (cvalue_t*)ptr(args[0]);
cv_pin(arr);
char *data = cv_data(arr);
@@ -1838,7 +1873,7 @@
fn->env = args[2];
if (nargs > 3) {if (!issymbol(args[3]))
- type_error("function", "symbol", args[3]);+ type_error("symbol", args[3]);fn->name = args[3];
}
}
@@ -1850,36 +1885,36 @@
BUILTIN("function:code", function_code) {- argcount("function:code", nargs, 1);+ argcount(nargs, 1);
value_t v = args[0];
- if (!isclosure(v)) type_error("function:code", "function", v);+ if (!isclosure(v)) type_error("function", v);return fn_bcode(v);
}
BUILTIN("function:vals", function_vals) {- argcount("function:vals", nargs, 1);+ argcount(nargs, 1);
value_t v = args[0];
- if (!isclosure(v)) type_error("function:vals", "function", v);+ if (!isclosure(v)) type_error("function", v);return fn_vals(v);
}
BUILTIN("function:env", function_env) {- argcount("function:env", nargs, 1);+ argcount(nargs, 1);
value_t v = args[0];
- if (!isclosure(v)) type_error("function:env", "function", v);+ if (!isclosure(v)) type_error("function", v);return fn_env(v);
}
BUILTIN("function:name", function_name) {- argcount("function:name", nargs, 1);+ argcount(nargs, 1);
value_t v = args[0];
- if (!isclosure(v)) type_error("function:name", "function", v);+ if (!isclosure(v)) type_error("function", v);return fn_name(v);
}
BUILTIN("copy-list", copy_list) {- argcount("copy-list", nargs, 1);+ argcount(nargs, 1);
return copy_list(args[0]);
}
@@ -1903,7 +1938,7 @@
lastcons = tagptr((((cons_t*)curheap)-1), TAG_CONS);
}
else if (lst != NIL) {- type_error("append", "cons", lst);+ type_error("cons", lst);}
}
if (first == NIL)
@@ -1917,7 +1952,7 @@
BUILTIN("list*", liststar) {if (nargs == 1) return args[0];
- else if (nargs == 0) argcount("list*", nargs, 1);+ else if (nargs == 0) argcount(nargs, 1);
return list(args, nargs, 1);
}
@@ -1924,7 +1959,7 @@
BUILTIN("stacktrace", stacktrace) {USED(args);
- argcount("stacktrace", nargs, 0);+ argcount(nargs, 0);
return _stacktrace(fl_throwing_frame ? fl_throwing_frame : curr_frame);
}
@@ -2129,6 +2164,7 @@
PUSH(sys_image_iostream);
saveSP = SP;
FL_TRY {+ curr_fname = "bootstrap";
while (1) {e = fl_read_sexpr(Stack[SP-1]);
if (ios_eof(value2c(ios_t*,Stack[SP-1]))) break;
@@ -2141,9 +2177,9 @@
else {// stage 1 format: list alternating symbol/value
while (iscons(e)) {- sym = tosymbol(car_(e), "bootstrap");
+ sym = tosymbol(car_(e));
e = cdr_(e);
- (void)tocons(e, "bootstrap");
+ (void)tocons(e);
sym->binding = car_(e);
e = cdr_(e);
}
--- a/flisp.h
+++ b/flisp.h
@@ -110,8 +110,8 @@
// functions ending in _ are unsafe, faster versions
#define car_(v) (((cons_t*)ptr(v))->car)
#define cdr_(v) (((cons_t*)ptr(v))->cdr)
-#define car(v) (tocons((v),"car")->car)
-#define cdr(v) (tocons((v),"cdr")->cdr)
+#define car(v) (tocons((v))->car)
+#define cdr(v) (tocons((v))->cdr)
#define fn_bcode(f) (((value_t*)ptr(f))[0])
#define fn_vals(f) (((value_t*)ptr(f))[1])
#define fn_env(f) (((value_t*)ptr(f))[2])
@@ -173,10 +173,10 @@
int isnumtok_base(char *tok, value_t *pval, int base);
/* safe casts */
-cons_t *tocons(value_t v, char *fname);
-symbol_t *tosymbol(value_t v, char *fname);
-fixnum_t tofixnum(value_t v, char *fname);
-char *tostring(value_t v, char *fname);
+cons_t *tocons(value_t v);
+symbol_t *tosymbol(value_t v);
+fixnum_t tofixnum(value_t v);
+char *tostring(value_t v);
/* error handling */
typedef struct _fl_readstate_t {@@ -217,16 +217,15 @@
void fl_savestate(fl_exception_context_t *_ctx);
void fl_restorestate(fl_exception_context_t *_ctx);
_Noreturn void fl_raise(value_t e);
-_Noreturn void type_error(char *fname, char *expected, value_t got);
-_Noreturn void bounds_error(char *fname, value_t arr, value_t ind);
+_Noreturn void type_error(char *expected, value_t got);
+_Noreturn void bounds_error(value_t arr, value_t ind);
extern value_t ArgError, IOError, KeyError, MemoryError, EnumerationError;
extern value_t UnboundError;
-#define argcount(fname, nargs, c) \
+#define argcount(nargs, c) \
do { \ if (__unlikely(nargs != c)) { \lerrorf(ArgError, \
- "%s: too %s arguments (want %d, got %d)", \
- fname, \
+ "too %s arguments (want %d, got %d)", \
nargs < c ? "few" : "many", c, nargs); \
} \
} while(0)
@@ -337,8 +336,8 @@
value_t cbuiltin(char *name, builtin_t f);
size_t cvalue_arraylen(value_t v);
value_t size_wrap(size_t sz);
-size_t toulong(value_t n, char *fname);
-off_t tooffset(value_t n, char *fname);
+size_t toulong(value_t n);
+off_t tooffset(value_t n);
value_t cvalue_string(size_t sz);
value_t cvalue_static_cstring(const char *str);
value_t string_from_cstr(char *str);
@@ -346,11 +345,11 @@
int fl_isstring(value_t v);
int fl_isnumber(value_t v);
int fl_isiostream(value_t v);
-ios_t *fl_toiostream(value_t v, char *fname);
+ios_t *fl_toiostream(value_t v);
value_t cvalue_compare(value_t a, value_t b);
-int numeric_compare(value_t a, value_t b, int eq, int eqnans, char *fname);
+int numeric_compare(value_t a, value_t b, int eq, int eqnans, int typeerr);
-void to_sized_ptr(value_t v, char *fname, char **pdata, size_t *psz);
+void to_sized_ptr(value_t v, char **pdata, size_t *psz);
fltype_t *get_type(value_t t);
fltype_t *get_array_type(value_t eltype);
--- a/iostream.c
+++ b/iostream.c
@@ -36,7 +36,7 @@
BUILTIN("iostream?", iostreamp) {- argcount("iostream?", nargs, 1);+ argcount(nargs, 1);
return fl_isiostream(args[0]) ? FL_T : FL_F;
}
@@ -43,32 +43,32 @@
BUILTIN("eof-object", eof_object) {USED(args);
- argcount("eof-object", nargs, 0);+ argcount(nargs, 0);
return FL_EOF;
}
BUILTIN("eof-object?", eof_objectp) {- argcount("eof-object?", nargs, 1);+ argcount(nargs, 1);
return (FL_EOF == args[0]) ? FL_T : FL_F;
}
-static ios_t *toiostream(value_t v, char *fname)
+static ios_t *toiostream(value_t v)
{if (!fl_isiostream(v))
- type_error(fname, "iostream", v);
+ type_error("iostream", v);return value2c(ios_t*, v);
}
-ios_t *fl_toiostream(value_t v, char *fname)
+ios_t *fl_toiostream(value_t v)
{- return toiostream(v, fname);
+ return toiostream(v);
}
BUILTIN("file", file) {if (nargs < 1)
- argcount("file", nargs, 1);+ argcount(nargs, 1);
int i, r=0, w=0, c=0, t=0, a=0;
for(i=1; i < (int)nargs; i++) {if (args[i] == wrsym) w = 1;
@@ -79,10 +79,10 @@
}
if ((r|w|c|t|a) == 0) r = 1; // default to reading
value_t f = cvalue(iostreamtype, sizeof(ios_t));
- char *fname = tostring(args[0], "file");
+ char *fname = tostring(args[0]);
ios_t *s = value2c(ios_t*, f);
if (ios_file(s, fname, r, w, c, t) == nil)
- lerrorf(IOError, "file: could not open \"%s\"", fname);
+ lerrorf(IOError, "could not open \"%s\"", fname);
if (a) ios_seek_end(s);
return f;
}
@@ -89,12 +89,12 @@
BUILTIN("buffer", buffer) {- argcount("buffer", nargs, 0);+ argcount(nargs, 0);
USED(args);
value_t f = cvalue(iostreamtype, sizeof(ios_t));
ios_t *s = value2c(ios_t*, f);
if (ios_mem(s, 0) == nil)
- lerrorf(MemoryError, "buffer: could not allocate stream");
+ lerrorf(MemoryError, "could not allocate stream");
return f;
}
@@ -102,7 +102,7 @@
{value_t arg = 0;
if (nargs > 1) {- argcount("read", nargs, 1);+ argcount(nargs, 1);
}
else if (nargs == 0) {arg = symbol_value(instrsym);
@@ -110,7 +110,7 @@
else {arg = args[0];
}
- (void)toiostream(arg, "read");
+ (void)toiostream(arg);
fl_gc_handle(&arg);
value_t v = fl_read_sexpr(arg);
fl_free_gc_handles(1);
@@ -121,37 +121,37 @@
BUILTIN("io.getc", io_getc) {- argcount("io.getc", nargs, 1);- ios_t *s = toiostream(args[0], "io.getc");
+ argcount(nargs, 1);
+ ios_t *s = toiostream(args[0]);
uint32_t wc;
int res;
if ((res = ios_getutf8(s, &wc)) == IOS_EOF)
- //lerrorf(IOError, "io.getc: end of file reached");
+ //lerrorf(IOError, "end of file reached");
return FL_EOF;
if (res == 0)
- lerrorf(IOError, "io.getc: invalid UTF-8 sequence");
+ lerrorf(IOError, "invalid UTF-8 sequence");
return mk_wchar(wc);
}
BUILTIN("io.peekc", io_peekc) {- argcount("io.peekc", nargs, 1);- ios_t *s = toiostream(args[0], "io.peekc");
+ argcount(nargs, 1);
+ ios_t *s = toiostream(args[0]);
uint32_t wc;
int res;
if ((res = ios_peekutf8(s, &wc)) == IOS_EOF)
return FL_EOF;
if (res == 0)
- lerrorf(IOError, "io.peekc: invalid UTF-8 sequence");
+ lerrorf(IOError, "invalid UTF-8 sequence");
return mk_wchar(wc);
}
BUILTIN("io.putc", io_putc) {- argcount("io.putc", nargs, 2);- ios_t *s = toiostream(args[0], "io.putc");
+ argcount(nargs, 2);
+ ios_t *s = toiostream(args[0]);
if (!iscprim(args[1]) || ((cprim_t*)ptr(args[1]))->type != wchartype)
- type_error("io.putc", "wchar", args[1]);+ type_error("wchar", args[1]);uint32_t wc = *(uint32_t*)cp_data((cprim_t*)ptr(args[1]));
return fixnum(ios_pututf8(s, wc));
}
@@ -158,9 +158,9 @@
BUILTIN("io.skip", io_skip) {- argcount("io.skip", nargs, 2);- ios_t *s = toiostream(args[0], "io.skip");
- off_t off = tooffset(args[1], "io.skip");
+ argcount(nargs, 2);
+ ios_t *s = toiostream(args[0]);
+ off_t off = tooffset(args[1]);
off_t res = ios_skip(s, off);
if (res < 0)
return FL_F;
@@ -169,8 +169,8 @@
BUILTIN("io.flush", io_flush) {- argcount("io.flush", nargs, 1);- ios_t *s = toiostream(args[0], "io.flush");
+ argcount(nargs, 1);
+ ios_t *s = toiostream(args[0]);
if (ios_flush(s) != 0)
return FL_F;
return FL_T;
@@ -178,8 +178,8 @@
BUILTIN("io.close", io_close) {- argcount("io.close", nargs, 1);- ios_t *s = toiostream(args[0], "io.close");
+ argcount(nargs, 1);
+ ios_t *s = toiostream(args[0]);
ios_close(s);
return FL_T;
}
@@ -186,8 +186,8 @@
BUILTIN("io.discardbuffer", io_discardbuffer) {- argcount("io.discardbuffer", nargs, 1);- ios_t *s = toiostream(args[0], "io.discardbuffer");
+ argcount(nargs, 1);
+ ios_t *s = toiostream(args[0]);
ios_purge(s);
return FL_T;
}
@@ -194,16 +194,16 @@
BUILTIN("io.eof?", io_eofp) {- argcount("io.eof?", nargs, 1);- ios_t *s = toiostream(args[0], "io.eof?");
+ argcount(nargs, 1);
+ ios_t *s = toiostream(args[0]);
return (ios_eof(s) ? FL_T : FL_F);
}
BUILTIN("io.seek", io_seek) {- argcount("io.seek", nargs, 2);- ios_t *s = toiostream(args[0], "io.seek");
- size_t pos = toulong(args[1], "io.seek");
+ argcount(nargs, 2);
+ ios_t *s = toiostream(args[0]);
+ size_t pos = toulong(args[1]);
off_t res = ios_seek(s, (off_t)pos);
if (res == -1)
return FL_F;
@@ -212,8 +212,8 @@
BUILTIN("io.pos", io_pos) {- argcount("io.pos", nargs, 1);- ios_t *s = toiostream(args[0], "io.pos");
+ argcount(nargs, 1);
+ ios_t *s = toiostream(args[0]);
off_t res = ios_pos(s);
if (res == -1)
return FL_F;
@@ -223,12 +223,12 @@
BUILTIN("write", write) {if (nargs < 1 || nargs > 2)
- argcount("write", nargs, 1);+ argcount(nargs, 1);
ios_t *s;
if (nargs == 2)
- s = toiostream(args[1], "write");
+ s = toiostream(args[1]);
else
- s = toiostream(symbol_value(outstrsym), "write");
+ s = toiostream(symbol_value(outstrsym));
fl_print(s, args[0]);
return args[0];
}
@@ -236,19 +236,19 @@
BUILTIN("io.read", io_read) {if (nargs != 3)
- argcount("io.read", nargs, 2);- (void)toiostream(args[0], "io.read");
+ argcount(nargs, 2);
+ (void)toiostream(args[0]);
size_t n;
fltype_t *ft;
if (nargs == 3) {// form (io.read s type count)
ft = get_array_type(args[1]);
- n = toulong(args[2], "io.read") * ft->elsz;
+ n = toulong(args[2]) * ft->elsz;
}
else {ft = get_type(args[1]);
if (ft->eltype != nil && !iscons(cdr_(cdr_(args[1]))))
- lerrorf(ArgError, "io.read: incomplete type");
+ lerrorf(ArgError, "incomplete type");
n = ft->size;
}
value_t cv = cvalue(ft, n);
@@ -257,7 +257,7 @@
else data = cp_data((cprim_t*)ptr(cv));
size_t got = ios_read(value2c(ios_t*,args[0]), data, n);
if (got < n)
- //lerrorf(IOError, "io.read: end of input reached");
+ //lerrorf(IOError, "end of input reached");
return FL_EOF;
return cv;
}
@@ -264,16 +264,16 @@
// args must contain data[, offset[, count]]
static void get_start_count_args(value_t *args, uint32_t nargs, size_t sz,
- size_t *offs, size_t *nb, char *fname)
+ size_t *offs, size_t *nb)
{ if (nargs > 1) {- *offs = toulong(args[1], fname);
+ *offs = toulong(args[1]);
if (nargs > 2)
- *nb = toulong(args[2], fname);
+ *nb = toulong(args[2]);
else
*nb = sz - *offs;
if (*offs >= sz || *offs + *nb > sz)
- bounds_error(fname, args[0], args[1]);
+ bounds_error(args[0], args[1]);
}
}
@@ -280,8 +280,8 @@
BUILTIN("io.write", io_write) {if (nargs < 2 || nargs > 4)
- argcount("io.write", nargs, 2);- ios_t *s = toiostream(args[0], "io.write");
+ argcount(nargs, 2);
+ ios_t *s = toiostream(args[0]);
if (iscprim(args[1]) && ((cprim_t*)ptr(args[1]))->type == wchartype) {if (nargs > 2)
lerrorf(ArgError,
@@ -291,10 +291,10 @@
}
char *data;
size_t sz, offs=0;
- to_sized_ptr(args[1], "io.write", &data, &sz);
+ to_sized_ptr(args[1], &data, &sz);
size_t nb = sz;
if (nargs > 2) {- get_start_count_args(&args[1], nargs-1, sz, &offs, &nb, "io.write");
+ get_start_count_args(&args[1], nargs-1, sz, &offs, &nb);
data += offs;
}
return size_wrap(ios_write(s, data, nb));
@@ -303,14 +303,14 @@
BUILTIN("dump", dump) {if (nargs < 1 || nargs > 3)
- argcount("dump", nargs, 1);- ios_t *s = toiostream(symbol_value(outstrsym), "dump");
+ argcount(nargs, 1);
+ ios_t *s = toiostream(symbol_value(outstrsym));
char *data;
size_t sz, offs=0;
- to_sized_ptr(args[0], "dump", &data, &sz);
+ to_sized_ptr(args[0], &data, &sz);
size_t nb = sz;
if (nargs > 1) {- get_start_count_args(args, nargs, sz, &offs, &nb, "dump");
+ get_start_count_args(args, nargs, sz, &offs, &nb);
data += offs;
}
hexdump(s, data, nb, offs);
@@ -317,14 +317,14 @@
return FL_T;
}
-static char get_delim_arg(value_t arg, char *fname)
+static char get_delim_arg(value_t arg)
{- size_t uldelim = toulong(arg, fname);
+ size_t uldelim = toulong(arg);
if (uldelim > 0x7f) {// wchars > 0x7f, or anything else > 0xff, are out of range
if ((iscprim(arg) && cp_class((cprim_t*)ptr(arg))==wchartype) ||
uldelim > 0xff)
- lerrorf(ArgError, "%s: delimiter out of range", fname);
+ lerrorf(ArgError, "delimiter out of range");
}
return (char)uldelim;
}
@@ -331,7 +331,7 @@
BUILTIN("io.readuntil", io_readuntil) {- argcount("io.readuntil", nargs, 2);+ argcount(nargs, 2);
value_t str = cvalue_string(80);
cvalue_t *cv = (cvalue_t*)ptr(str);
char *data = cv_data(cv);
@@ -338,8 +338,8 @@
ios_t dest;
ios_mem(&dest, 0);
ios_setbuf(&dest, data, 80, 0);
- char delim = get_delim_arg(args[1], "io.readuntil");
- ios_t *src = toiostream(args[0], "io.readuntil");
+ char delim = get_delim_arg(args[1]);
+ ios_t *src = toiostream(args[0]);
size_t n = ios_copyuntil(&dest, src, delim);
cv->len = n;
if (dest.buf != data) {@@ -359,10 +359,10 @@
BUILTIN("io.copyuntil", io_copyuntil) {- argcount("io.copyuntil", nargs, 3);- ios_t *dest = toiostream(args[0], "io.copyuntil");
- ios_t *src = toiostream(args[1], "io.copyuntil");
- char delim = get_delim_arg(args[2], "io.copyuntil");
+ argcount(nargs, 3);
+ ios_t *dest = toiostream(args[0]);
+ ios_t *src = toiostream(args[1]);
+ char delim = get_delim_arg(args[2]);
return size_wrap(ios_copyuntil(dest, src, delim));
}
@@ -369,11 +369,11 @@
BUILTIN("io.copy", io_copy) {if (nargs < 2 || nargs > 3)
- argcount("io.copy", nargs, 2);- ios_t *dest = toiostream(args[0], "io.copy");
- ios_t *src = toiostream(args[1], "io.copy");
+ argcount(nargs, 2);
+ ios_t *dest = toiostream(args[0]);
+ ios_t *src = toiostream(args[1]);
if (nargs == 3) {- size_t n = toulong(args[2], "io.copy");
+ size_t n = toulong(args[2]);
return size_wrap(ios_copy(dest, src, n));
}
return size_wrap(ios_copyall(dest, src));
@@ -403,10 +403,10 @@
BUILTIN("io.tostring!", io_tostring) {- argcount("io.tostring!", nargs, 1);- ios_t *src = toiostream(args[0], "io.tostring!");
+ argcount(nargs, 1);
+ ios_t *src = toiostream(args[0]);
if (src->bm != bm_mem)
- lerrorf(ArgError, "io.tostring!: requires memory stream");
+ lerrorf(ArgError, "requires memory stream");
return stream_to_string(&args[0]);
}
--- a/print.c
+++ b/print.c
@@ -720,7 +720,7 @@
value_t eltype = car(cdr_(type));
size_t cnt, elsize;
if (iscons(cdr_(cdr_(type)))) {- cnt = toulong(car_(cdr_(cdr_(type))), "length");
+ cnt = toulong(car_(cdr_(cdr_(type))));
elsize = cnt ? len/cnt : 0;
}
else {--- a/string.c
+++ b/string.c
@@ -6,7 +6,7 @@
BUILTIN("string?", stringp) {- argcount("string?", nargs, 1);+ argcount(nargs, 1);
return fl_isstring(args[0]) ? FL_T : FL_F;
}
@@ -14,19 +14,19 @@
{size_t start = 0;
if (nargs < 1 || nargs > 3)
- argcount("string.count", nargs, 1);+ argcount(nargs, 1);
if (!fl_isstring(args[0]))
- type_error("string.count", "string", args[0]);+ type_error("string", args[0]);size_t len = cv_len((cvalue_t*)ptr(args[0]));
size_t stop = len;
if (nargs > 1) {- start = toulong(args[1], "string.count");
+ start = toulong(args[1]);
if (start > len)
- bounds_error("string.count", args[0], args[1]);+ bounds_error(args[0], args[1]);
if (nargs > 2) {- stop = toulong(args[2], "string.count");
+ stop = toulong(args[2]);
if (stop > len)
- bounds_error("string.count", args[0], args[2]);+ bounds_error(args[0], args[2]);
if (stop <= start)
return fixnum(0);
}
@@ -37,7 +37,7 @@
BUILTIN("string.width", string_width) {- argcount("string.width", nargs, 1);+ argcount(nargs, 1);
if (iscprim(args[0])) {cprim_t *cp = (cprim_t*)ptr(args[0]);
if (cp_class(cp) == wchartype) {@@ -47,15 +47,15 @@
return fixnum(w);
}
}
- char *s = tostring(args[0], "string.width");
+ char *s = tostring(args[0]);
return size_wrap(u8_strwidth(s));
}
BUILTIN("string.reverse", string_reverse) {- argcount("string.reverse", nargs, 1);+ argcount(nargs, 1);
if (!fl_isstring(args[0]))
- type_error("string.reverse", "string", args[0]);+ type_error("string", args[0]);size_t len = cv_len((cvalue_t*)ptr(args[0]));
value_t ns = cvalue_string(len);
u8_reverse(cvalue_data(ns), cvalue_data(args[0]), len);
@@ -64,7 +64,7 @@
BUILTIN("string.encode", string_encode) {- argcount("string.encode", nargs, 1);+ argcount(nargs, 1);
if (iscvalue(args[0])) {cvalue_t *cv = (cvalue_t*)ptr(args[0]);
fltype_t *t = cv_class(cv);
@@ -78,7 +78,7 @@
return str;
}
}
- type_error("string.encode", "wchar array", args[0]);+ type_error("wchar array", args[0]);}
BUILTIN("string.decode", string_decode)@@ -88,10 +88,10 @@
term = (args[1] != FL_F);
}
else {- argcount("string.decode", nargs, 1);+ argcount(nargs, 1);
}
if (!fl_isstring(args[0]))
- type_error("string.decode", "string", args[0]);+ type_error("string", args[0]);cvalue_t *cv = (cvalue_t*)ptr(args[0]);
char *ptr = (char*)cv_data(cv);
size_t nb = cv_len(cv);
@@ -134,9 +134,9 @@
BUILTIN("string.split", string_split) {- argcount("string.split", nargs, 2);- char *s = tostring(args[0], "string.split");
- char *delim = tostring(args[1], "string.split");
+ argcount(nargs, 2);
+ char *s = tostring(args[0]);
+ char *delim = tostring(args[1]);
size_t len = cv_len((cvalue_t*)ptr(args[0]));
size_t dlen = cv_len((cvalue_t*)ptr(args[1]));
size_t ssz, tokend, tokstart, i=0;
@@ -178,17 +178,17 @@
BUILTIN("string.sub", string_sub) {if (nargs != 2)
- argcount("string.sub", nargs, 3);- char *s = tostring(args[0], "string.sub");
+ argcount(nargs, 3);
+ char *s = tostring(args[0]);
size_t len = cv_len((cvalue_t*)ptr(args[0]));
size_t i1, i2;
- i1 = toulong(args[1], "string.sub");
+ i1 = toulong(args[1]);
if (i1 > len)
- bounds_error("string.sub", args[0], args[1]);+ bounds_error(args[0], args[1]);
if (nargs == 3) {- i2 = toulong(args[2], "string.sub");
+ i2 = toulong(args[2]);
if (i2 > len)
- bounds_error("string.sub", args[0], args[2]);+ bounds_error(args[0], args[2]);
}
else {i2 = len;
@@ -202,41 +202,41 @@
BUILTIN("string.char", string_char) {- argcount("string.char", nargs, 2);- char *s = tostring(args[0], "string.char");
+ argcount(nargs, 2);
+ char *s = tostring(args[0]);
size_t len = cv_len((cvalue_t*)ptr(args[0]));
- size_t i = toulong(args[1], "string.char");
+ size_t i = toulong(args[1]);
if (i >= len)
- bounds_error("string.char", args[0], args[1]);+ bounds_error(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]);+ bounds_error(args[0], args[1]);
return mk_wchar(u8_nextchar(s, &i));
}
BUILTIN("char.upcase", char_upcase) {- argcount("char.upcase", nargs, 1);+ argcount(nargs, 1);
cprim_t *cp = (cprim_t*)ptr(args[0]);
if (!iscprim(args[0]) || cp_class(cp) != wchartype)
- type_error("char.upcase", "wchar", args[0]);+ type_error("wchar", args[0]);return mk_wchar(towupper(*(int32_t*)cp_data(cp)));
}
BUILTIN("char.downcase", char_downcase) {- argcount("char.downcase", nargs, 1);+ argcount(nargs, 1);
cprim_t *cp = (cprim_t*)ptr(args[0]);
if (!iscprim(args[0]) || cp_class(cp) != wchartype)
- type_error("char.downcase", "wchar", args[0]);+ type_error("wchar", args[0]);return mk_wchar(towlower(*(int32_t*)cp_data(cp)));
}
BUILTIN("char-alphabetic?", char_alphabeticp) {- argcount("char-alphabetic?", nargs, 1);+ argcount(nargs, 1);
cprim_t *cp = (cprim_t*)ptr(args[0]);
if (!iscprim(args[0]) || cp_class(cp) != wchartype)
- type_error("char-alphabetic?", "wchar", args[0]);+ type_error("wchar", args[0]);return iswalpha(*(int32_t*)cp_data(cp)) ? FL_T : FL_F;
}
@@ -253,13 +253,13 @@
char cbuf[8];
size_t start = 0;
if (nargs == 3)
- start = toulong(args[2], "string.find");
+ start = toulong(args[2]);
else
- argcount("string.find", nargs, 2);- char *s = tostring(args[0], "string.find");
+ argcount(nargs, 2);
+ char *s = tostring(args[0]);
size_t len = cv_len((cvalue_t*)ptr(args[0]));
if (start > len)
- bounds_error("string.find", args[0], args[2]);+ bounds_error(args[0], args[2]);
char *needle; size_t needlesz;
value_t v = args[1];
@@ -280,7 +280,7 @@
needle = (char*)cv_data(cv);
}
else {- type_error("string.find", "string", args[1]);+ type_error("string", args[1]);}
if (needlesz > len-start)
return FL_F;
@@ -301,16 +301,16 @@
BUILTIN("string.inc", string_inc) {if (nargs < 2 || nargs > 3)
- argcount("string.inc", nargs, 2);- char *s = tostring(args[0], "string.inc");
+ argcount(nargs, 2);
+ char *s = tostring(args[0]);
size_t len = cv_len((cvalue_t*)ptr(args[0]));
- size_t i = toulong(args[1], "string.inc");
+ size_t i = toulong(args[1]);
size_t cnt = 1;
if (nargs == 3)
- cnt = toulong(args[2], "string.inc");
+ cnt = toulong(args[2]);
while (cnt--) {if (i >= len)
- bounds_error("string.inc", args[0], args[1]);+ bounds_error(args[0], args[1]);
(void)(isutf(s[++i]) || isutf(s[++i]) || isutf(s[++i]) || ++i);
}
return size_wrap(i);
@@ -319,29 +319,29 @@
BUILTIN("string.dec", string_dec) {if (nargs < 2 || nargs > 3)
- argcount("string.dec", nargs, 2);- char *s = tostring(args[0], "string.dec");
+ argcount(nargs, 2);
+ char *s = tostring(args[0]);
size_t len = cv_len((cvalue_t*)ptr(args[0]));
- size_t i = toulong(args[1], "string.dec");
+ size_t i = toulong(args[1]);
size_t cnt = 1;
if (nargs == 3)
- cnt = toulong(args[2], "string.dec");
+ cnt = toulong(args[2]);
// note: i is allowed to start at index len
if (i > len)
- bounds_error("string.dec", args[0], args[1]);+ bounds_error(args[0], args[1]);
while (cnt--) {if (i == 0)
- bounds_error("string.dec", args[0], args[1]);+ bounds_error(args[0], args[1]);
(void)(isutf(s[--i]) || isutf(s[--i]) || isutf(s[--i]) || --i);
}
return size_wrap(i);
}
-static unsigned long get_radix_arg(value_t arg, char *fname)
+static unsigned long get_radix_arg(value_t arg)
{- unsigned long radix = toulong(arg, fname);
+ unsigned long radix = toulong(arg);
if (radix < 2 || radix > 36)
- lerrorf(ArgError, "%s: invalid radix", fname);
+ lerrorf(ArgError, "invalid radix");
return radix;
}
@@ -348,12 +348,12 @@
BUILTIN("number->string", number_2_string) {if (nargs < 1 || nargs > 2)
- argcount("number->string", nargs, 2);+ argcount(nargs, 2);
value_t n = args[0];
int neg = 0;
uint64_t num;
if (isfixnum(n)) num = numval(n);
- else if (!iscprim(n)) type_error("number->string", "integer", n);+ else if (!iscprim(n)) type_error("integer", n);else num = conv_to_uint64(cp_data((cprim_t*)ptr(n)),
cp_numtype((cprim_t*)ptr(n)));
if (numval(fl_compare(args[0],fixnum(0))) < 0) {@@ -362,7 +362,7 @@
}
unsigned long radix = 10;
if (nargs == 2)
- radix = get_radix_arg(args[1], "number->string");
+ radix = get_radix_arg(args[1]);
char buf[128];
char *str = uint2str(buf, sizeof(buf), num, radix);
if (neg && str > &buf[0])
@@ -373,12 +373,12 @@
BUILTIN("string->number", string_2_number) {if (nargs < 1 || nargs > 2)
- argcount("string->number", nargs, 2);- char *str = tostring(args[0], "string->number");
+ argcount(nargs, 2);
+ char *str = tostring(args[0]);
value_t n;
unsigned long radix = 0;
if (nargs == 2)
- radix = get_radix_arg(args[1], "string->number");
+ radix = get_radix_arg(args[1]);
if (!isnumtok_base(str, &n, (int)radix))
return FL_F;
return n;
@@ -386,8 +386,8 @@
BUILTIN("string.isutf8", string_isutf8) {- argcount("string.isutf8", nargs, 1);- char *s = tostring(args[0], "string.isutf8");
+ argcount(nargs, 1);
+ char *s = tostring(args[0]);
size_t len = cv_len((cvalue_t*)ptr(args[0]));
return u8_isvalid(s, len) ? FL_T : FL_F;
}
--- a/table.c
+++ b/table.c
@@ -64,14 +64,14 @@
BUILTIN("table?", tablep) {- argcount("table?", nargs, 1);+ argcount(nargs, 1);
return ishashtable(args[0]) ? FL_T : FL_F;
}
-static htable_t *totable(value_t v, char *fname)
+static htable_t *totable(value_t v)
{if (!ishashtable(v))
- type_error(fname, "table", v);
+ type_error("table", v);return (htable_t*)cv_data((cvalue_t*)ptr(v));
}
@@ -79,7 +79,7 @@
{size_t cnt = (size_t)nargs;
if (cnt & 1)
- lerrorf(ArgError, "table: arguments must come in pairs");
+ lerrorf(ArgError, "arguments must come in pairs");
value_t nt;
// prevent small tables from being added to finalizer list
if (cnt <= HT_N_INLINE) {@@ -106,8 +106,8 @@
// (put! table key value)
BUILTIN("put!", put) {- argcount("put!", nargs, 3);- htable_t *h = totable(args[0], "put!");
+ argcount(nargs, 3);
+ htable_t *h = totable(args[0]);
void **table0 = h->table;
equalhash_put(h, (void*)args[1], (void*)args[2]);
// register finalizer if we outgrew inline space
@@ -119,9 +119,9 @@
return args[0];
}
-static void key_error(char *fname, value_t key)
+static void key_error(value_t key)
{- lerrorf(fl_list2(KeyError, key), "%s: key not found", fname);
+ lerrorf(fl_list2(KeyError, key), "key not found");
}
// (get table key [default])
@@ -128,13 +128,13 @@
BUILTIN("get", get) {if (nargs != 3)
- argcount("get", nargs, 2);- htable_t *h = totable(args[0], "get");
+ argcount(nargs, 2);
+ htable_t *h = totable(args[0]);
value_t v = (value_t)equalhash_get(h, (void*)args[1]);
if (v == (value_t)HT_NOTFOUND) {if (nargs == 3)
return args[2];
- key_error("get", args[1]);+ key_error(args[1]);
}
return v;
}
@@ -142,8 +142,8 @@
// (has? table key)
BUILTIN("has?", has) {- argcount("has?", nargs, 2);- htable_t *h = totable(args[0], "has?");
+ argcount(nargs, 2);
+ htable_t *h = totable(args[0]);
return equalhash_has(h, (void*)args[1]) ? FL_T : FL_F;
}
@@ -150,18 +150,18 @@
// (del! table key)
BUILTIN("del!", del) {- argcount("del!", nargs, 2);- htable_t *h = totable(args[0], "del!");
+ argcount(nargs, 2);
+ htable_t *h = totable(args[0]);
if (!equalhash_remove(h, (void*)args[1]))
- key_error("del!", args[1]);+ key_error(args[1]);
return args[0];
}
BUILTIN("table.foldl", table_foldl) {- argcount("table.foldl", nargs, 3);+ argcount(nargs, 3);
value_t f=args[0], zero=args[1], t=args[2];
- htable_t *h = totable(t, "table.foldl");
+ htable_t *h = totable(t);
size_t i, n = h->size;
void **table = h->table;
fl_gc_handle(&f);
@@ -176,7 +176,7 @@
// reload pointer
h = (htable_t*)cv_data((cvalue_t*)ptr(t));
if (h->size != n)
- lerrorf(EnumerationError, "table.foldl: table modified");
+ lerrorf(EnumerationError, "table modified");
table = h->table;
}
}