commit fd2a121ea53e2a52900be3798b848761f03810cd
parent ba957d7aafdabae3fdb87a63d7c59847272b9faa
Author: Andres Navarro <canavarro82@gmail.com>
Date: Thu, 28 Apr 2011 18:33:10 -0300
Changed interface to error throwing from ground combiners. Now all errors are error objs. TODO show them properly in REPL. ALSO eliminated all need to explicitly pass names for error signaling, the name is now picked up from the current combiner/continuation.
Diffstat:
31 files changed, 369 insertions(+), 362 deletions(-)
diff --git a/src/Makefile b/src/Makefile
@@ -82,7 +82,7 @@ kpromise.o: kpromise.c kpromise.h kmem.h kstate.h kobject.h \
kport.o: kport.c kport.h kmem.h kstate.h kobject.h klisp.h kerror.h kstring.h \
kgc.h
ktable.o: ktable.c ktable.h kobject.h kstate.h kmem.h klisp.h kgc.h \
- kapplicative.h kgeqp.h kstring.h
+ kapplicative.h kgeqp.h kstring.h kerror.h
keval.o: keval.c keval.h kcontinuation.h kenvironment.h kstate.h kobject.h \
kpair.h kerror.h klisp.h klispconf.h
krepl.o: krepl.c krepl.h kcontinuation.h kstate.h kobject.h keval.h klisp.h \
diff --git a/src/kenvironment.c b/src/kenvironment.c
@@ -209,7 +209,7 @@ TValue kget_binding(klisp_State *K, TValue env, TValue sym)
if (try_get_binding(K, env, sym, &value)) {
return value;
} else {
- klispE_throw_extra(K, "Unbound symbol: ", ksymbol_buf(sym));
+ klispE_throw_simple_with_irritants(K, "Unbound symbol", 1, sym);
/* avoid warning */
return KINERT;
}
@@ -280,7 +280,7 @@ TValue kget_keyed_static_var(klisp_State *K, TValue env, TValue key)
if (try_get_keyed(K, env, key, &value)) {
return value;
} else {
- klispE_throw(K, "keyed-static-get: Unbound keyed static variable");
+ klispE_throw_simple(K, "Unbound keyed static variable");
/* avoid warning */
return KINERT;
}
diff --git a/src/kerror.c b/src/kerror.c
@@ -9,6 +9,8 @@
#include "kmem.h"
#include "kstring.h"
+/* TODO: check that all objects passed to throw are rooted */
+
/* GC: assumes all objs passed are rooted */
TValue klispE_new(klisp_State *K, TValue who, TValue cont, TValue msg,
TValue irritants)
@@ -27,57 +29,67 @@ TValue klispE_new(klisp_State *K, TValue who, TValue cont, TValue msg,
return gc2error(new_error);
}
-
-/* XXX: the msg buffers should be statically allocated and msgs
- should be copied there, otherwise problems may occur if
- the objects whose buffers were passed as parameters get GCted */
-
+/*
+** Clear all stacks & buffers
+*/
void clear_buffers(klisp_State *K)
{
- /* XXX: clear stack and char buffer, clear shared dict */
- /* TODO: put these in handlers for read-token, read and write */
+ /* These shouldn't cause GC, but just in case do them first,
+ an object may be protected in tvs or vars */
ks_sclear(K);
ks_tbclear(K);
K->shared_dict = KNIL;
- /* is it okay to do this in all cases? */
- krooted_tvs_clear(K);
- krooted_vars_clear(K);
-
- /* should also clear dummys right? */
UNUSED(kcutoff_dummy1(K));
UNUSED(kcutoff_dummy2(K));
UNUSED(kcutoff_dummy3(K));
+
+ krooted_tvs_clear(K);
+ krooted_vars_clear(K);
}
-void klispE_throw(klisp_State *K, char *msg)
+/*
+** Throw a simple error obj with:
+** {
+** who: current operative/continuation,
+** cont: current continuation,
+** message: msg,
+** irritants: ()
+** }
+*/
+/* GC: assumes all objs passed are rooted */
+void klispE_throw_simple(klisp_State *K, char *msg)
{
TValue error_msg = kstring_new_b_imm(K, msg);
- /* TEMP */
- clear_buffers(K);
- /* call_cont protect msg from gc */
- kcall_cont(K, K->error_cont, error_msg);
+ krooted_tvs_push(K, error_msg);
+ TValue error_obj =
+ klispE_new(K, K->next_obj, K->curr_cont, error_msg, KNIL);
+ /* clear buffer shouldn't cause GC, but just in case... */
+ krooted_tvs_push(K, error_obj);
+ clear_buffers(K); /* this pops both error_msg & error_obj */
+ /* call_cont protects error from gc */
+ kcall_cont(K, K->error_cont, error_obj);
}
-/* TEMP: for throwing with extra msg info */
-void klispE_throw_extra(klisp_State *K, char *msg, char *extra_msg) {
- /* TODO */
- int32_t l1 = strlen(msg);
- int32_t l2 = strlen(extra_msg);
-
- int32_t tl = l1+l2;
-
- char *msg_buf = klispM_malloc(K, tl+1);
- strcpy(msg_buf, msg);
- strcpy(msg_buf+l1, extra_msg);
- msg_buf[tl] = '\0';
- /* if the mem allocator could throw errors, this
- could potentially leak msg_buf */
- TValue error_msg = kstring_new_bs_imm(K, msg_buf, tl);
- klispM_freemem(K, msg_buf, tl+1);
-
- clear_buffers(K);
-
- /* call_cont protect msg from gc */
- kcall_cont(K, K->error_cont, error_msg);
+/*
+** Throw an error obj with:
+** {
+** who: current operative/continuation,
+** cont: current continuation,
+** message: msg,
+** irritants: irritants
+** }
+*/
+/* GC: assumes all objs passed are rooted */
+void klispE_throw_with_irritants(klisp_State *K, char *msg, TValue irritants)
+{
+ TValue error_msg = kstring_new_b_imm(K, msg);
+ krooted_tvs_push(K, error_msg);
+ TValue error_obj =
+ klispE_new(K, K->next_obj, K->curr_cont, error_msg, irritants);
+ /* clear buffer shouldn't cause GC, but just in case... */
+ krooted_tvs_push(K, error_obj);
+ clear_buffers(K); /* this pops both error_msg & error_obj */
+ /* call_cont protects error from gc */
+ kcall_cont(K, K->error_cont, error_obj);
}
diff --git a/src/kerror.h b/src/kerror.h
@@ -15,8 +15,16 @@
TValue klispE_new(klisp_State *K, TValue who, TValue cont, TValue msg,
TValue irritants);
-void klispE_throw(klisp_State *K, char *msg);
-/* TEMP: for throwing with extra msg info */
-void klispE_throw_extra(klisp_State *K, char *msg, char *extra_msg);
+void klispE_throw_simple(klisp_State *K, char *msg);
+void klispE_throw_with_irritants(klisp_State *K, char *msg, TValue irritants);
+
+/* evaluates K__ more than once */
+#define klispE_throw_simple_with_irritants(K__, msg__, ...) \
+ { TValue ls__ = klist(K__, __VA_ARGS__); \
+ krooted_tvs_push(K__, ls__); \
+ /* the pop is implicit in throw_with_irritants */ \
+ klispE_throw_with_irritants(K__, msg__, ls__); }
+
+
#endif
diff --git a/src/keval.c b/src/keval.c
@@ -82,7 +82,7 @@ inline TValue make_arg_ls(klisp_State *K, TValue operands, TValue *tail)
*tail = KNIL;
} else {
clear_ls_marks(operands);
- klispE_throw(K, "Not a list in applicative combination");
+ klispE_throw_simple(K, "Not a list in applicative combination");
return KINERT;
}
clear_ls_marks(operands);
@@ -125,14 +125,14 @@ void combine_cfn(klisp_State *K, TValue *xparams, TValue obj)
krooted_tvs_pop(K);
ktail_eval(K, kcar(arg_ls), env);
} else {
- klispE_throw(K, "Not a list in applicative combination");
+ klispE_throw_simple(K, "Not a list in applicative combination");
return;
}
}
case K_TOPERATIVE:
ktail_call_si(K, obj, operands, env, si);
default:
- klispE_throw(K, "Not a combiner in combiner position");
+ klispE_throw_simple(K, "Not a combiner in combiner position");
return;
}
}
diff --git a/src/kgbooleans.c b/src/kgbooleans.c
@@ -28,7 +28,7 @@ void notp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
UNUSED(xparams);
UNUSED(denv);
- bind_1tp(K, "not?", ptree, "boolean", ttisboolean, tv_b);
+ bind_1tp(K, ptree, "boolean", ttisboolean, tv_b);
TValue res = kis_true(tv_b)? KFALSE : KTRUE;
kapply_cc(K, res);
@@ -104,7 +104,7 @@ void do_Sandp_Sorp(klisp_State *K, TValue *xparams, TValue obj)
TValue denv = xparams[3];
if (!ttisboolean(obj)) {
- klispE_throw_extra(K, ksymbol_buf(sname), ": expected boolean");
+ klispE_throw_simple(K, "expected boolean");
return;
} else if (ttisnil(ls) || tv_equal(obj, term_bool)) {
/* in both cases the value to be returned is obj:
diff --git a/src/kgchars.c b/src/kgchars.c
@@ -44,7 +44,7 @@ void kchar_to_integer(klisp_State *K, TValue *xparams, TValue ptree,
{
UNUSED(xparams);
UNUSED(denv);
- bind_1tp(K, "char->integer", ptree, "character", ttischar, ch);
+ bind_1tp(K, ptree, "character", ttischar, ch);
kapply_cc(K, i2tv((int32_t) chvalue(ch)));
}
@@ -54,17 +54,17 @@ void kinteger_to_char(klisp_State *K, TValue *xparams, TValue ptree,
{
UNUSED(xparams);
UNUSED(denv);
- bind_1tp(K, "integer->char", ptree, "integer", ttisinteger, itv);
+ bind_1tp(K, ptree, "integer", ttisinteger, itv);
if (ttisbigint(itv)) {
- klispE_throw(K, "integer->char: integer out of ASCII range [0 - 127]");
+ klispE_throw_simple(K, "integer out of ASCII range [0 - 127]");
return;
}
int32_t i = ivalue(itv);
/* for now only allow ASCII */
if (i < 0 || i > 127) {
- klispE_throw(K, "integer->char: integer out of ASCII range [0 - 127]");
+ klispE_throw_simple(K, "integer out of ASCII range [0 - 127]");
return;
}
kapply_cc(K, ch2tv((char) i));
@@ -76,7 +76,7 @@ void kchar_upcase(klisp_State *K, TValue *xparams, TValue ptree,
{
UNUSED(xparams);
UNUSED(denv);
- bind_1tp(K, "char-upcase", ptree, "character", ttischar, chtv);
+ bind_1tp(K, ptree, "character", ttischar, chtv);
char ch = chvalue(chtv);
ch = toupper(ch);
kapply_cc(K, ch2tv(ch));
@@ -87,7 +87,7 @@ void kchar_downcase(klisp_State *K, TValue *xparams, TValue ptree,
{
UNUSED(xparams);
UNUSED(denv);
- bind_1tp(K, "char-downcase", ptree, "character", ttischar, chtv);
+ bind_1tp(K, ptree, "character", ttischar, chtv);
char ch = chvalue(chtv);
ch = tolower(ch);
kapply_cc(K, ch2tv(ch));
diff --git a/src/kgcombiners.c b/src/kgcombiners.c
@@ -40,7 +40,7 @@ void do_vau(klisp_State *K, TValue *xparams, TValue obj, TValue denv);
void Svau(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
{
(void) xparams;
- bind_al2p(K, "$vau", ptree, vptree, vpenv, vbody);
+ bind_al2p(K, ptree, vptree, vpenv, vbody);
/* The ptree & body are copied to avoid mutation */
vptree = check_copy_ptree(K, "$vau", vptree, vpenv);
@@ -121,7 +121,7 @@ void wrap(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
UNUSED(denv);
UNUSED(xparams);
- bind_1tp(K, "wrap", ptree, "combiner", ttiscombiner, comb);
+ bind_1tp(K, ptree, "combiner", ttiscombiner, comb);
TValue new_app = kwrap(K, comb);
#if KTRACK_SI
/* save as source code info the info from the expression whose evaluation
@@ -142,7 +142,7 @@ void unwrap(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
{
(void) denv;
(void) xparams;
- bind_1tp(K, "unwrap", ptree, "applicative", ttisapplicative, app);
+ bind_1tp(K, ptree, "applicative", ttisapplicative, app);
TValue underlying = kunwrap(app);
kapply_cc(K, underlying);
}
@@ -154,7 +154,7 @@ void unwrap(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
void Slambda(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
{
(void) xparams;
- bind_al1p(K, "$lambda", ptree, vptree, vbody);
+ bind_al1p(K, ptree, vptree, vbody);
/* The ptree & body are copied to avoid mutation */
vptree = check_copy_ptree(K, "$lambda", vptree, KIGNORE);
@@ -191,7 +191,7 @@ void apply(klisp_State *K, TValue *xparams, TValue ptree,
UNUSED(denv);
UNUSED(xparams);
- bind_al2tp(K, "apply", ptree,
+ bind_al2tp(K, ptree,
"applicative", ttisapplicative, app,
"any", anytype, obj,
maybe_env);
@@ -240,11 +240,10 @@ void map_for_each_get_metrics(klisp_State *K, char *name, TValue lss,
tail = kcdr(tail);
if (first_cpairs != 0) {
- klispE_throw_extra(K, name,
- ": mixed finite and infinite lists");
+ klispE_throw_simple(K, "mixed finite and infinite lists");
return;
} else if (first_pairs != res_pairs) {
- klispE_throw_extra(K, name, ": lists of different length");
+ klispE_throw_simple(K, "lists of different length");
return;
}
}
@@ -264,8 +263,7 @@ void map_for_each_get_metrics(klisp_State *K, char *name, TValue lss,
tail = kcdr(tail);
if (first_cpairs == 0) {
- klispE_throw_extra(K, name,
- ": mixed finite and infinite lists");
+ klispE_throw_simple(K, "mixed finite and infinite lists");
return;
}
res_apairs = kmax32(res_apairs, first_apairs);
@@ -539,10 +537,10 @@ void map(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
{
UNUSED(xparams);
- bind_al1tp(K, "map", ptree, "applicative", ttisapplicative, app, lss);
+ bind_al1tp(K, ptree, "applicative", ttisapplicative, app, lss);
if (ttisnil(lss)) {
- klispE_throw(K, "map: no lists");
+ klispE_throw_simple(K, "no lists");
return;
}
diff --git a/src/kgcontinuations.c b/src/kgcontinuations.c
@@ -32,7 +32,7 @@
void call_cc(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
{
UNUSED(xparams);
- bind_1tp(K, "call/cc", ptree, "combiner", ttiscombiner, comb);
+ bind_1tp(K, ptree, "combiner", ttiscombiner, comb);
TValue expr = klist(K, 2, comb, kget_cc(K));
ktail_eval(K, expr, denv);
@@ -60,7 +60,7 @@ void extend_continuation(klisp_State *K, TValue *xparams, TValue ptree,
UNUSED(denv);
UNUSED(xparams);
- bind_al2tp(K, "extend-continuation", ptree,
+ bind_al2tp(K, ptree,
"continuation", ttiscontinuation, cont,
"applicative", ttisapplicative, app,
maybe_env);
@@ -100,8 +100,7 @@ inline TValue check_copy_single_entry(klisp_State *K, char *name,
if (!ttispair(obj) || !ttispair(kcdr(obj)) ||
!ttisnil(kcddr(obj))) {
unmark_list(K, root);
- klispE_throw_extra(K, name , ": Bad entry (expected "
- "list of length 2)");
+ klispE_throw_simple(K, "Bad entry (expected list of length 2)");
return KINERT;
}
TValue cont = kcar(obj);
@@ -109,12 +108,12 @@ inline TValue check_copy_single_entry(klisp_State *K, char *name,
if (!ttiscontinuation(cont)) {
unmark_list(K, root);
- klispE_throw_extra(K, name, ": Bad type on first element (expected "
+ klispE_throw_simple(K, "Bad type on first element (expected "
"continuation)");
return KINERT;
} else if (!singly_wrapped(app)) {
unmark_list(K, root);
- klispE_throw_extra(K, name, ": Bad type on second element (expected "
+ klispE_throw_simple(K, "Bad type on second element (expected "
"singly wrapped applicative)");
return KINERT;
}
@@ -152,7 +151,7 @@ TValue check_copy_guards(klisp_State *K, char *name, TValue obj)
unmark_list(K, obj);
TValue ret = kcutoff_dummy1(K);
if (!ttispair(tail) && !ttisnil(tail)) {
- klispE_throw_extra(K, name , ": expected list");
+ klispE_throw_simple(K, "expected list");
return KINERT;
}
return ret;
@@ -165,7 +164,7 @@ void guard_continuation(klisp_State *K, TValue *xparams, TValue ptree,
{
UNUSED(xparams);
- bind_3tp(K, "guard-continuation", ptree, "any", anytype, entry_guards,
+ bind_3tp(K, ptree, "any", anytype, entry_guards,
"continuation", ttiscontinuation, cont,
"any", anytype, exit_guards);
@@ -200,7 +199,7 @@ void continuation_applicative(klisp_State *K, TValue *xparams, TValue ptree,
TValue denv)
{
UNUSED(xparams);
- bind_1tp(K, "continuation->applicative", ptree, "continuation",
+ bind_1tp(K, ptree, "continuation",
ttiscontinuation, cont);
/* cont_app is from kstate, it handles dynamic vars &
interceptions */
@@ -225,7 +224,7 @@ void apply_continuation(klisp_State *K, TValue *xparams, TValue ptree,
UNUSED(xparams);
UNUSED(denv);
- bind_2tp(K, "apply-continuation", ptree, "continuation", ttiscontinuation,
+ bind_2tp(K, ptree, "continuation", ttiscontinuation,
cont, "any", anytype, obj);
/* kcall_cont is from kstate, it handles dynamic vars &
@@ -239,7 +238,7 @@ void Slet_cc(klisp_State *K, TValue *xparams, TValue ptree,
{
UNUSED(xparams);
/* from the report: #ignore is not ok, only symbol */
- bind_al1tp(K, "$let/cc", ptree, "symbol", ttissymbol, sym, objs);
+ bind_al1tp(K, ptree, "symbol", ttissymbol, sym, objs);
if (ttisnil(objs)) {
/* we don't even bother creating the environment */
@@ -277,7 +276,7 @@ void guard_dynamic_extent(klisp_State *K, TValue *xparams, TValue ptree,
{
UNUSED(xparams);
- bind_3tp(K, "guard-dynamic-extent", ptree, "any", anytype, entry_guards,
+ bind_3tp(K, ptree, "any", anytype, entry_guards,
"combiner", ttiscombiner, comb,
"any", anytype, exit_guards);
@@ -316,7 +315,7 @@ void kgexit(klisp_State *K, TValue *xparams, TValue ptree,
UNUSED(denv);
UNUSED(xparams);
- check_0p(K, "exit", ptree);
+ check_0p(K, ptree);
/* TODO: look out for guards and dynamic variables */
/* should be probably handled in kcall_cont() */
diff --git a/src/kgcontrol.c b/src/kgcontrol.c
@@ -34,7 +34,7 @@ void Sif(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
(void) denv;
(void) xparams;
- bind_3p(K, "$if", ptree, test, cons_c, alt_c);
+ bind_3p(K, ptree, test, cons_c, alt_c);
TValue new_cont =
kmake_continuation(K, kget_cc(K), select_clause,
@@ -60,7 +60,7 @@ void select_clause(klisp_State *K, TValue *xparams, TValue obj)
TValue clause = bvalue(obj)? xparams[1] : xparams[2];
ktail_eval(K, clause, denv);
} else {
- klispE_throw(K, "$if: test is not a boolean");
+ klispE_throw_simple(K, "test is not a boolean");
return;
}
}
@@ -138,7 +138,7 @@ TValue split_check_cond_clauses(klisp_State *K, TValue clauses,
TValue first = kcar(tail);
if (!ttispair(first)) {
unmark_list(K, clauses);
- klispE_throw(K, "$cond: bad structure in clauses");
+ klispE_throw_simple(K, "bad structure in clauses");
return KNIL;
}
@@ -164,7 +164,7 @@ TValue split_check_cond_clauses(klisp_State *K, TValue clauses,
unmark_list(K, clauses);
if (!ttispair(tail) && !ttisnil(tail)) {
- klispE_throw(K, "$cond: expected list (clauses)");
+ klispE_throw_simple(K, "expected list (clauses)");
return KNIL;
} else {
/*
@@ -202,7 +202,7 @@ void do_cond(klisp_State *K, TValue *xparams, TValue obj)
TValue denv = xparams[3];
if (!ttisboolean(obj)) {
- klispE_throw(K, "$cond: test evaluated to a non boolean value");
+ klispE_throw_simple(K, "test evaluated to a non boolean value");
return;
} else if (bvalue(obj)) {
if (ttisnil(this_body)) {
@@ -313,10 +313,10 @@ void for_each(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
{
(void) xparams;
- bind_al1tp(K, "for-each", ptree, "applicative", ttisapplicative, app, lss);
+ bind_al1tp(K, ptree, "applicative", ttisapplicative, app, lss);
if (ttisnil(lss)) {
- klispE_throw(K, "for-each: no lists");
+ klispE_throw_simple(K, "no lists");
return;
}
diff --git a/src/kgencapsulations.c b/src/kgencapsulations.c
@@ -48,7 +48,7 @@ void enc_typep(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
kapply_cc(K, b2tv(res));
} else {
/* try to get name from encapsulation */
- klispE_throw(K, "encapsulation?: expected list");
+ klispE_throw_simple(K, "expected list");
return;
}
}
@@ -56,7 +56,7 @@ void enc_typep(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
/* Constructor for encapsulations */
void enc_wrap(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
{
- bind_1p(K, "encapsulate", ptree, obj);
+ bind_1p(K, ptree, obj);
UNUSED(denv);
/*
** xparams[0]: encapsulation key
@@ -69,7 +69,7 @@ void enc_wrap(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
/* Accessor for encapsulations */
void enc_unwrap(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
{
- bind_1p(K, "decapsulate", ptree, enc);
+ bind_1p(K, ptree, enc);
UNUSED(denv);
/*
** xparams[0]: encapsulation key
@@ -77,7 +77,7 @@ void enc_unwrap(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
TValue key = xparams[0];
if (!kis_encapsulation_type(enc, key)) {
- klispE_throw(K, "decapsulate: object doesn't belong to this "
+ klispE_throw_simple(K, "object doesn't belong to this "
"encapsulation type");
return;
}
@@ -89,7 +89,7 @@ void enc_unwrap(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
void make_encapsulation_type(klisp_State *K, TValue *xparams, TValue ptree,
TValue denv)
{
- check_0p(K, "make-encapsulation-type", ptree);
+ check_0p(K, ptree);
UNUSED(denv);
UNUSED(xparams);
diff --git a/src/kgenv_mut.c b/src/kgenv_mut.c
@@ -28,7 +28,7 @@ void SdefineB(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
/*
** xparams[0] = define symbol
*/
- bind_2p(K, "$define!", ptree, dptree, expr);
+ bind_2p(K, ptree, dptree, expr);
TValue def_sym = xparams[0];
@@ -67,7 +67,7 @@ void SsetB(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
TValue sname = xparams[0];
- bind_3p(K, "$set!", ptree, env_exp, raw_formals, eval_exp);
+ bind_3p(K, ptree, env_exp, raw_formals, eval_exp);
TValue formals = check_copy_ptree(K, "$set!", raw_formals, KIGNORE);
krooted_tvs_push(K, formals);
@@ -96,7 +96,7 @@ void do_set_eval_obj(klisp_State *K, TValue *xparams, TValue obj)
TValue denv = xparams[3];
if (!ttisenvironment(obj)) {
- klispE_throw_extra(K, ksymbol_buf(sname), ": bad type from first "
+ klispE_throw_simple(K, "bad type from first "
"operand evaluation (expected environment)");
return;
} else {
@@ -156,15 +156,15 @@ TValue check_copy_symbol_list(klisp_State *K, char *name, TValue obj)
unmark_maybe_symbol_list(K, obj);
if (!ttisnil(tail)) {
- klispE_throw_extra(K, name, ": expected finite list");
+ klispE_throw_simple(K, "expected finite list");
return KNIL;
} else if (type_errorp) {
/* TODO put type name too */
- klispE_throw_extra(K, name , ": bad operand type (expected list of "
+ klispE_throw_simple(K, "bad operand type (expected list of "
"symbols)");
return KNIL;
} else if (repeated_errorp) {
- klispE_throw_extra(K, name , ": repeated symbols");
+ klispE_throw_simple(K, "repeated symbols");
}
return kcutoff_dummy1(K);
}
@@ -181,8 +181,8 @@ void do_import(klisp_State *K, TValue *xparams, TValue obj)
TValue denv = xparams[2];
if (!ttisenvironment(obj)) {
- klispE_throw_extra(K, ksymbol_buf(sname), ": bad type from first "
- "operand evaluation (expected environment)");
+ klispE_throw_simple(K, "bad type from first "
+ "operand evaluation (expected environment)");
return;
} else {
TValue env = obj;
@@ -203,7 +203,7 @@ void SprovideB(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
TValue sname = xparams[0];
char *name = ksymbol_buf(sname);
- bind_al1p(K, name, ptree, symbols, body);
+ bind_al1p(K, ptree, symbols, body);
symbols = check_copy_symbol_list(K, name, symbols);
krooted_tvs_push(K, symbols);
@@ -265,7 +265,7 @@ void SimportB(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
TValue sname = xparams[0];
char *name = ksymbol_buf(sname);
- bind_al1p(K, name, ptree, env_expr, symbols);
+ bind_al1p(K, ptree, env_expr, symbols);
symbols = check_copy_symbol_list(K, name, symbols);
diff --git a/src/kgenv_mut.h b/src/kgenv_mut.h
@@ -67,7 +67,7 @@ inline void match(klisp_State *K, char *name, TValue env, TValue ptree,
if (!ttisnil(obj)) {
/* TODO show ptree and arguments */
ks_sclear(K);
- klispE_throw_extra(K, name, ": ptree doesn't match arguments");
+ klispE_throw_simple(K, "ptree doesn't match arguments");
return;
}
break;
@@ -86,7 +86,7 @@ inline void match(klisp_State *K, char *name, TValue env, TValue ptree,
} else {
/* TODO show ptree and arguments */
ks_sclear(K);
- klispE_throw_extra(K, name, ": ptree doesn't match arguments");
+ klispE_throw_simple(K, "ptree doesn't match arguments");
return;
}
break;
@@ -132,7 +132,7 @@ inline TValue check_copy_ptree(klisp_State *K, char *name, TValue ptree,
if (kis_marked(top)) {
/* TODO add symbol name */
ptree_clear_all(K, sym_ls);
- klispE_throw_extra(K, name, ": repeated symbol in ptree");
+ klispE_throw_simple(K, "repeated symbol in ptree");
/* avoid warning */
return KNIL;
} else {
@@ -168,7 +168,7 @@ inline TValue check_copy_ptree(klisp_State *K, char *name, TValue ptree,
/* NOTE: the pair should be in the stack already so
it isn't necessary to push it again to clear the mark */
ptree_clear_all(K, sym_ls);
- klispE_throw_extra(K, name, ": cycle detected in ptree");
+ klispE_throw_simple(K, "cycle detected in ptree");
/* avoid warning */
return KNIL;
}
@@ -176,7 +176,7 @@ inline TValue check_copy_ptree(klisp_State *K, char *name, TValue ptree,
}
default:
ptree_clear_all(K, sym_ls);
- klispE_throw_extra(K, name, ": bad object type in ptree");
+ klispE_throw_simple(K, "bad object type in ptree");
/* avoid warning */
return KNIL;
}
@@ -218,13 +218,13 @@ inline TValue check_copy_ptree(klisp_State *K, char *name, TValue ptree,
if (kis_marked(penv)) {
/* TODO add symbol name */
ptree_clear_all(K, sym_ls);
- klispE_throw_extra(K, name, ": same symbol in both ptree and "
+ klispE_throw_simple(K, "same symbol in both ptree and "
"environment parameter");
}
} else if (!ttisignore(penv)) {
/* TODO add symbol name */
ptree_clear_all(K, sym_ls);
- klispE_throw_extra(K, name, ": symbol or #ignore expected as "
+ klispE_throw_simple(K, "symbol or #ignore expected as "
"environment parmameter");
}
ptree_clear_all(K, sym_ls);
diff --git a/src/kgenvironments.c b/src/kgenvironments.c
@@ -38,7 +38,7 @@ void eval(klisp_State *K, TValue *xparams, TValue ptree,
UNUSED(denv);
UNUSED(xparams);
- bind_2tp(K, "eval", ptree, "any", anytype, expr,
+ bind_2tp(K, ptree, "any", anytype, expr,
"environment", ttisenvironment, env);
/* TODO: track source code info */
ktail_eval(K, expr, env);
@@ -62,7 +62,7 @@ void make_environment(klisp_State *K, TValue *xparams, TValue ptree,
new_env = kmake_environment(K, parent);
kapply_cc(K, new_env);
} else {
- klispE_throw(K, "make-environment: not an environment in "
+ klispE_throw_simple(K, "not an environment in "
"parent list");
return;
}
@@ -106,7 +106,7 @@ TValue split_check_let_bindings(klisp_State *K, char *name, TValue bindings,
if (!ttispair(first) || !ttispair(kcdr(first)) ||
!ttisnil(kcddr(first))) {
unmark_list(K, bindings);
- klispE_throw_extra(K, name, ": bad structure in bindings");
+ klispE_throw_simple(K, "bad structure in bindings");
return KNIL;
}
@@ -123,10 +123,10 @@ TValue split_check_let_bindings(klisp_State *K, char *name, TValue bindings,
unmark_list(K, bindings);
if (!ttispair(tail) && !ttisnil(tail)) {
- klispE_throw_extra(K, name, ": expected list");
+ klispE_throw_simple(K, "expected list");
return KNIL;
} else if(ttispair(tail)) {
- klispE_throw_extra(K, name , ": expected finite list");
+ klispE_throw_simple(K, "expected finite list");
return KNIL;
} else {
TValue res;
@@ -214,7 +214,7 @@ void Slet(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
*/
TValue sname = xparams[0];
char *name = ksymbol_buf(sname);
- bind_al1p(K, name, ptree, bindings, body);
+ bind_al1p(K, ptree, bindings, body);
TValue exprs;
TValue bptree = split_check_let_bindings(K, name, bindings, &exprs, false);
@@ -253,7 +253,7 @@ void do_bindsp(klisp_State *K, TValue *xparams, TValue obj)
int32_t count = ivalue(xparams[1]);
if (!ttisenvironment(obj)) {
- klispE_throw(K, "$binds?: expected environment as first argument");
+ klispE_throw_simple(K, "expected environment as first argument");
return;
}
TValue env = obj;
@@ -276,7 +276,7 @@ void do_bindsp(klisp_State *K, TValue *xparams, TValue obj)
void Sbindsp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
{
UNUSED(xparams);
- bind_al1p(K, "binds?", ptree, env_expr, symbols);
+ bind_al1p(K, ptree, env_expr, symbols);
/* REFACTOR replace with single function check_copy_typed_list */
int32_t count = check_typed_list(K, "$binds?", "symbol", ksymbolp,
@@ -296,7 +296,7 @@ void get_current_environment(klisp_State *K, TValue *xparams, TValue ptree,
TValue denv)
{
UNUSED(xparams);
- check_0p(K, "get-current-environment", ptree);
+ check_0p(K, ptree);
kapply_cc(K, denv);
}
@@ -306,7 +306,7 @@ void make_kernel_standard_environment(klisp_State *K, TValue *xparams,
{
UNUSED(xparams);
UNUSED(denv);
- check_0p(K, "make-kernel-standard-environment", ptree);
+ check_0p(K, ptree);
TValue new_env = kmake_environment(K, K->ground_env);
kapply_cc(K, new_env);
@@ -320,7 +320,7 @@ void SletS(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
*/
TValue sname = xparams[0];
char *name = ksymbol_buf(sname);
- bind_al1p(K, name, ptree, bindings, body);
+ bind_al1p(K, ptree, bindings, body);
TValue exprs;
TValue bptree = split_check_let_bindings(K, name, bindings, &exprs, true);
@@ -369,7 +369,7 @@ void Sletrec(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
*/
TValue sname = xparams[0];
char *name = ksymbol_buf(sname);
- bind_al1p(K, name, ptree, bindings, body);
+ bind_al1p(K, ptree, bindings, body);
TValue exprs;
TValue bptree = split_check_let_bindings(K, name, bindings, &exprs, false);
@@ -406,7 +406,7 @@ void SletrecS(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
*/
TValue sname = xparams[0];
char *name = ksymbol_buf(sname);
- bind_al1p(K, name, ptree, bindings, body);
+ bind_al1p(K, ptree, bindings, body);
TValue exprs;
TValue bptree = split_check_let_bindings(K, name, bindings, &exprs, true);
@@ -459,14 +459,13 @@ void do_let_redirect(klisp_State *K, TValue *xparams, TValue obj)
** xparams[4]: body
*/
TValue sname = xparams[0];
- char *name = ksymbol_buf(sname);
TValue bptree = xparams[1];
TValue lexpr = xparams[2];
TValue denv = xparams[3];
TValue body = xparams[4];
if (!ttisenvironment(obj)) {
- klispE_throw_extra(K, name , ": expected environment");
+ klispE_throw_simple(K, "expected environment");
return;
}
TValue new_env = kmake_environment(K, obj);
@@ -488,7 +487,7 @@ void Slet_redirect(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
*/
TValue sname = xparams[0];
char *name = ksymbol_buf(sname);
- bind_al2p(K, name, ptree, env_exp, bindings, body);
+ bind_al2p(K, ptree, env_exp, bindings, body);
TValue exprs;
TValue bptree = split_check_let_bindings(K, name, bindings, &exprs, false);
@@ -523,7 +522,7 @@ void Slet_safe(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
*/
TValue sname = xparams[0];
char *name = ksymbol_buf(sname);
- bind_al1p(K, name, ptree, bindings, body);
+ bind_al1p(K, ptree, bindings, body);
TValue exprs;
TValue bptree = split_check_let_bindings(K, name, bindings, &exprs, false);
@@ -560,7 +559,7 @@ void Sremote_eval(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
UNUSED(xparams);
UNUSED(denv);
- bind_2p(K, "$remote-eval", ptree, obj, env_exp);
+ bind_2p(K, ptree, obj, env_exp);
TValue new_cont = kmake_continuation(K, kget_cc(K),
do_remote_eval, 1, obj);
@@ -573,7 +572,7 @@ void Sremote_eval(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
void do_remote_eval(klisp_State *K, TValue *xparams, TValue obj)
{
if (!ttisenvironment(obj)) {
- klispE_throw(K, "$remote-eval: bad type from second operand "
+ klispE_throw_simple(K, "bad type from second operand "
"evaluation (expected environment)");
return;
} else {
diff --git a/src/kghelpers.c b/src/kghelpers.c
@@ -42,8 +42,7 @@ void typep(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
if (ttispair(tail) || ttisnil(tail)) {
kapply_cc(K, b2tv(res));
} else {
- char *name = ksymbol_buf(xparams[0]);
- klispE_throw_extra(K, name, ": expected list");
+ klispE_throw_simple(K, "expected list");
return;
}
}
@@ -73,8 +72,7 @@ void ftypep(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
if (ttispair(tail) || ttisnil(tail)) {
kapply_cc(K, b2tv(res));
} else {
- char *name = ksymbol_buf(xparams[0]);
- klispE_throw_extra(K, name, ": expected list");
+ klispE_throw_simple(K, "expected list");
return;
}
}
@@ -110,7 +108,7 @@ void ftyped_predp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
if (!(*typep)(first)) {
/* TODO show expected type */
- klispE_throw_extra(K, name, ": bad argument type");
+ klispE_throw_simple(K, "bad argument type");
return;
}
res &= (*predp)(first);
@@ -156,7 +154,7 @@ void ftyped_bpredp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
TValue first = kcar(tail);
if (!(*typep)(first)) {
/* TODO show expected type */
- klispE_throw_extra(K, name, ": bad argument type");
+ klispE_throw_simple(K, "bad argument type");
return;
}
}
@@ -168,7 +166,7 @@ void ftyped_bpredp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
if (!(*typep)(first) || !(*typep)(second)) {
/* TODO show expected type */
- klispE_throw_extra(K, name, ": bad argument type");
+ klispE_throw_simple(K, "bad argument type");
return;
}
res &= (*predp)(first, second);
@@ -213,7 +211,7 @@ void ftyped_kbpredp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
TValue first = kcar(tail);
if (!(*typep)(first)) {
/* TODO show expected type */
- klispE_throw_extra(K, name, ": bad argument type");
+ klispE_throw_simple(K, "bad argument type");
return;
}
}
@@ -225,7 +223,7 @@ void ftyped_kbpredp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
if (!(*typep)(first) || !(*typep)(second)) {
/* TODO show expected type */
- klispE_throw_extra(K, name, ": bad argument type");
+ klispE_throw_simple(K, "bad argument type");
return;
}
res &= (*predp)(K, first, second);
@@ -256,15 +254,15 @@ int32_t check_typed_list(klisp_State *K, char *name, char *typename,
unmark_list(K, obj);
if (!ttispair(tail) && !ttisnil(tail)) {
- klispE_throw_extra(K, name , allow_infp? ": expected list":
- ": expected finite list");
+ klispE_throw_simple(K, allow_infp? "expected list" :
+ "expected finite list");
return 0;
} else if(ttispair(tail) && !allow_infp) {
- klispE_throw_extra(K, name , ": expected finite list");
+ klispE_throw_simple(K, "expected finite list");
return 0;
} else if (type_errorp) {
/* TODO put type name too */
- klispE_throw_extra(K, name , ": bad operand type");
+ klispE_throw_simple(K, "bad operand type");
return 0;
}
return pairs;
@@ -287,11 +285,11 @@ int32_t check_list(klisp_State *K, char *name, bool allow_infp,
unmark_list(K, obj);
if (!ttispair(tail) && !ttisnil(tail)) {
- klispE_throw_extra(K, name, allow_infp? ": expected list":
- ": expected finite list");
+ klispE_throw_simple(K, allow_infp? "expected list" :
+ "expected finite list");
return 0;
} else if(ttispair(tail) && !allow_infp) {
- klispE_throw_extra(K, name , ": expected finite list");
+ klispE_throw_simple(K, "expected finite list");
return 0;
} else {
return pairs;
diff --git a/src/kghelpers.h b/src/kghelpers.h
@@ -32,115 +32,115 @@
*/
/* XXX: add parens around macro vars!! */
-#define check_0p(K_, n_, ptree_) \
+#define check_0p(K_, ptree_) \
if (!ttisnil(ptree_)) { \
- klispE_throw_extra((K_), (n_) , \
- ": Bad ptree (expected no arguments)"); \
+ klispE_throw_simple((K_), \
+ "Bad ptree (expected no arguments)"); \
return; \
}
-#define bind_1p(K_, n_, ptree_, v_) \
- bind_1tp((K_), (n_), (ptree_), "any", anytype, (v_))
+#define bind_1p(K_, ptree_, v_) \
+ bind_1tp((K_), (ptree_), "any", anytype, (v_))
-#define bind_1tp(K_, n_, ptree_, tstr_, t_, v_) \
+#define bind_1tp(K_, ptree_, tstr_, t_, v_) \
TValue v_; \
if (!ttispair(ptree_) || !ttisnil(kcdr(ptree_))) { \
- klispE_throw_extra((K_), (n_) , \
- ": Bad ptree (expected one argument)"); \
+ klispE_throw_simple((K_), \
+ "Bad ptree (expected one argument)"); \
return; \
} \
v_ = kcar(ptree_); \
if (!t_(v_)) { \
- klispE_throw_extra(K_, n_ , ": Bad type on first argument " \
+ klispE_throw_simple(K_, "Bad type on first argument " \
"(expected " tstr_ ")"); \
return; \
}
-#define bind_2p(K_, n_, ptree_, v1_, v2_) \
- bind_2tp((K_), (n_), (ptree_), "any", anytype, (v1_), \
+#define bind_2p(K_, ptree_, v1_, v2_) \
+ bind_2tp((K_), (ptree_), "any", anytype, (v1_), \
"any", anytype, (v2_))
-#define bind_2tp(K_, n_, ptree_, tstr1_, t1_, v1_, \
+#define bind_2tp(K_, ptree_, tstr1_, t1_, v1_, \
tstr2_, t2_, v2_) \
TValue v1_, v2_; \
if (!ttispair(ptree_) || !ttispair(kcdr(ptree_)) || \
!ttisnil(kcddr(ptree_))) { \
- klispE_throw_extra(K_, n_ , ": Bad ptree (expected two arguments)"); \
+ klispE_throw_simple(K_, "Bad ptree (expected two arguments)"); \
return; \
} \
v1_ = kcar(ptree_); \
v2_ = kcadr(ptree_); \
if (!t1_(v1_)) { \
- klispE_throw_extra(K_, n_, ": Bad type on first argument (expected " \
+ klispE_throw_simple(K_, "Bad type on first argument (expected " \
tstr1_ ")"); \
return; \
} else if (!t2_(v2_)) { \
- klispE_throw_extra(K_, n_, ": Bad type on second argument (expected " \
+ klispE_throw_simple(K_, "Bad type on second argument (expected " \
tstr2_ ")"); \
return; \
}
-#define bind_3p(K_, n_, ptree_, v1_, v2_, v3_) \
- bind_3tp(K_, n_, ptree_, "any", anytype, v1_, \
+#define bind_3p(K_, ptree_, v1_, v2_, v3_) \
+ bind_3tp(K_, ptree_, "any", anytype, v1_, \
"any", anytype, v2_, "any", anytype, v3_)
-#define bind_3tp(K_, n_, ptree_, tstr1_, t1_, v1_, \
+#define bind_3tp(K_, ptree_, tstr1_, t1_, v1_, \
tstr2_, t2_, v2_, tstr3_, t3_, v3_) \
TValue v1_, v2_, v3_; \
if (!ttispair(ptree_) || !ttispair(kcdr(ptree_)) || \
!ttispair(kcddr (ptree_)) || !ttisnil(kcdddr(ptree_))) { \
- klispE_throw_extra(K_, n_, ": Bad ptree (expected three arguments)"); \
+ klispE_throw_simple(K_, "Bad ptree (expected three arguments)"); \
return; \
} \
v1_ = kcar(ptree_); \
v2_ = kcadr(ptree_); \
v3_ = kcaddr(ptree_); \
if (!t1_(v1_)) { \
- klispE_throw_extra(K_, n_, ": Bad type on first argument (expected " \
+ klispE_throw_simple(K_, "Bad type on first argument (expected " \
tstr1_ ")"); \
return; \
} else if (!t2_(v2_)) { \
- klispE_throw_extra(K_, n_, ": Bad type on second argument (expected " \
+ klispE_throw_simple(K_, "Bad type on second argument (expected " \
tstr2_ ")"); \
return; \
} else if (!t3_(v3_)) { \
- klispE_throw_extra(K_, n_, ": Bad type on third argument (expected " \
+ klispE_throw_simple(K_, "Bad type on third argument (expected " \
tstr3_ ")"); \
return; \
}
/* bind at least 1 parameter, like (v1_ . v2_) */
-#define bind_al1p(K_, n_, ptree_, v1_, v2_) \
- bind_al1tp((K_), (n_), (ptree_), "any", anytype, (v1_), (v2_))
+#define bind_al1p(K_, ptree_, v1_, v2_) \
+ bind_al1tp((K_), (ptree_), "any", anytype, (v1_), (v2_))
/* bind at least 1 parameters (with type), like (v1_ . v2_) */
-#define bind_al1tp(K_, n_, ptree_, tstr1_, t1_, v1_, v2_) \
+#define bind_al1tp(K_, ptree_, tstr1_, t1_, v1_, v2_) \
TValue v1_, v2_; \
if (!ttispair(ptree_)) { \
- klispE_throw_extra(K_, n_ , ": Bad ptree (expected at least " \
+ klispE_throw_simple(K_, "Bad ptree (expected at least " \
"one argument)"); \
return; \
} \
v1_ = kcar(ptree_); \
v2_ = kcdr(ptree_); \
if (!t1_(v1_)) { \
- klispE_throw_extra(K_, n_, ": Bad type on first argument (expected " \
+ klispE_throw_simple(K_, "Bad type on first argument (expected " \
tstr1_ ")"); \
return; \
}
/* bind at least 2 parameters, like (v1_ v2_ . v3_) */
-#define bind_al2p(K_, n_, ptree_, v1_, v2_, v3_) \
- bind_al2tp((K_), (n_), (ptree_), "any", anytype, (v1_), \
+#define bind_al2p(K_, ptree_, v1_, v2_, v3_) \
+ bind_al2tp((K_), (ptree_), "any", anytype, (v1_), \
"any", anytype, (v2_), (v3_))
/* bind at least 2 parameters (with type), like (v1_ v2_ . v3_) */
-#define bind_al2tp(K_, n_, ptree_, tstr1_, t1_, v1_, \
+#define bind_al2tp(K_, ptree_, tstr1_, t1_, v1_, \
tstr2_, t2_, v2_, v3_) \
TValue v1_, v2_, v3_; \
if (!ttispair(ptree_) || !ttispair(kcdr(ptree_))) { \
- klispE_throw_extra(K_, n_ , ": Bad ptree (expected at least " \
+ klispE_throw_simple(K_, "Bad ptree (expected at least " \
"two arguments)"); \
return; \
} \
@@ -148,27 +148,27 @@
v2_ = kcadr(ptree_); \
v3_ = kcddr(ptree_); \
if (!t1_(v1_)) { \
- klispE_throw_extra(K_, n_, ": Bad type on first argument (expected " \
+ klispE_throw_simple(K_, "Bad type on first argument (expected " \
tstr1_ ")"); \
return; \
} else if (!t2_(v2_)) { \
- klispE_throw_extra(K_, n_, ": Bad type on second argument (expected " \
+ klispE_throw_simple(K_, "Bad type on second argument (expected " \
tstr2_ ")"); \
return; \
}
/* bind at least 3 parameters, like (v1_ v2_ v3_ . v4_) */
-#define bind_al3p(K_, n_, ptree_, v1_, v2_, v3_, v4_) \
- bind_al3tp((K_), (n_), (ptree_), "any", anytype, (v1_), \
+#define bind_al3p(K_, ptree_, v1_, v2_, v3_, v4_) \
+ bind_al3tp((K_), (ptree_), "any", anytype, (v1_), \
"any", anytype, (v2_), "any", anytype, (v3_), (v4_)) \
/* bind at least 3 parameters (with type), like (v1_ v2_ v3_ . v4_) */
-#define bind_al3tp(K_, n_, ptree_, tstr1_, t1_, v1_, \
+#define bind_al3tp(K_, ptree_, tstr1_, t1_, v1_, \
tstr2_, t2_, v2_, tstr3_, t3_, v3_, v4_) \
TValue v1_, v2_, v3_, v4_; \
if (!ttispair(ptree_) || !ttispair(kcdr(ptree_)) || \
!ttispair(kcddr(ptree_))) { \
- klispE_throw_extra(K_, n_ , ": Bad ptree (expected at least " \
+ klispE_throw_simple(K_, "Bad ptree (expected at least " \
"three arguments)"); \
return; \
} \
@@ -177,15 +177,15 @@
v3_ = kcaddr(ptree_); \
v4_ = kcdddr(ptree_); \
if (!t1_(v1_)) { \
- klispE_throw_extra(K_, n_, ": Bad type on first argument (expected " \
+ klispE_throw_simple(K_, "Bad type on first argument (expected " \
tstr1_ ")"); \
return; \
} else if (!t2_(v2_)) { \
- klispE_throw_extra(K_, n_, ": Bad type on second argument (expected " \
+ klispE_throw_simple(K_, "Bad type on second argument (expected " \
tstr2_ ")"); \
return; \
} else if (!t3_(v3_)) { \
- klispE_throw_extra(K_, n_, ": Bad type on third argument (expected " \
+ klispE_throw_simple(K_, "Bad type on third argument (expected " \
tstr3_ ")"); \
return; \
}
@@ -203,7 +203,7 @@ inline bool get_opt_tpar(klisp_State *K, char *name, int32_t type, TValue *par)
*par = kcar(*par);
if (ttype(*par) != type) {
/* TODO show expected type */
- klispE_throw_extra(K, name, ": Bad type on optional argument "
+ klispE_throw_simple(K, "Bad type on optional argument "
"(expected ?)");
/* avoid warning */
return false;
@@ -211,7 +211,7 @@ inline bool get_opt_tpar(klisp_State *K, char *name, int32_t type, TValue *par)
return true;
}
} else {
- klispE_throw_extra(K, name, ": Bad ptree structure (in optional "
+ klispE_throw_simple(K, "Bad ptree structure (in optional "
"argument)");
/* avoid warning */
return false;
@@ -316,7 +316,7 @@ inline TValue check_copy_list(klisp_State *K, char *name, TValue obj,
unmark_list(K, obj);
if (!ttispair(tail) && !ttisnil(tail)) {
- klispE_throw_extra(K, name , ": expected list");
+ klispE_throw_simple(K, "expected list");
return KINERT;
}
return kcutoff_dummy3(K);
@@ -334,7 +334,7 @@ inline TValue check_copy_env_list(klisp_State *K, char *name, TValue obj)
while(ttispair(tail) && !kis_marked(tail)) {
TValue first = kcar(tail);
if (!ttisenvironment(first)) {
- klispE_throw_extra(K, name, ": not an environment in parent list");
+ klispE_throw_simple(K, "not an environment in parent list");
return KINERT;
}
TValue new_pair = kcons(K, first, KNIL);
@@ -348,7 +348,7 @@ inline TValue check_copy_env_list(klisp_State *K, char *name, TValue obj)
unmark_list(K, obj);
if (!ttispair(tail) && !ttisnil(tail)) {
- klispE_throw_extra(K, name , ": expected list");
+ klispE_throw_simple(K, "expected list");
return KINERT;
}
return kcutoff_dummy3(K);
@@ -411,7 +411,7 @@ inline int32_t kmax32(int32_t a, int32_t b) { return a > b? a : b; }
inline int32_t kcheck32(klisp_State *K, char *msg, int64_t i)
{
if (i > (int64_t) INT32_MAX || i < (int64_t) INT32_MIN) {
- klispE_throw(K, msg);
+ klispE_throw_simple(K, msg);
return 0;
} else {
return (int32_t) i;
diff --git a/src/kgkd_vars.c b/src/kgkd_vars.c
@@ -38,14 +38,14 @@ void do_access(klisp_State *K, TValue *xparams, TValue ptree,
/*
** xparams[0]: dynamic key
*/
- check_0p(K, "keyed-dynamic-get", ptree);
+ check_0p(K, ptree);
UNUSED(denv);
TValue key = xparams[0];
if (kis_true(kcar(key))) {
kapply_cc(K, kcdr(key));
} else {
- klispE_throw(K, "keyed-dynamic-get: variable is unbound");
+ klispE_throw_simple(K, "variable is unbound");
return;
}
}
@@ -155,7 +155,7 @@ void do_bind(klisp_State *K, TValue *xparams, TValue ptree,
/*
** xparams[0]: dynamic key
*/
- bind_2tp(K, "keyed-dynamic-bind", ptree, "any", anytype, obj,
+ bind_2tp(K, ptree, "any", anytype, obj,
"combiner", ttiscombiner, comb);
UNUSED(denv); /* the combiner is called in an empty environment */
TValue key = xparams[0];
@@ -186,7 +186,7 @@ void make_keyed_dynamic_variable(klisp_State *K, TValue *xparams,
UNUSED(denv);
UNUSED(xparams);
- check_0p(K, "make-keyed-dynamic-variable", ptree);
+ check_0p(K, ptree);
TValue key = kcons(K, KFALSE, KINERT);
krooted_tvs_push(K, key);
TValue a = kmake_applicative(K, do_access, 1, key);
diff --git a/src/kgks_vars.c b/src/kgks_vars.c
@@ -31,7 +31,7 @@ void do_sv_access(klisp_State *K, TValue *xparams, TValue ptree,
/*
** xparams[0]: static key
*/
- check_0p(K, "keyed-static-get", ptree);
+ check_0p(K, ptree);
TValue key = xparams[0];
/* this may throw an exception if not bound */
@@ -46,7 +46,7 @@ void do_sv_bind(klisp_State *K, TValue *xparams, TValue ptree,
/*
** xparams[0]: static key
*/
- bind_2tp(K, "keyed-static-bind", ptree, "any", anytype, obj,
+ bind_2tp(K, ptree, "any", anytype, obj,
"environment", ttisenvironment, env);
UNUSED(denv);
TValue key = xparams[0];
@@ -62,7 +62,7 @@ void make_keyed_static_variable(klisp_State *K, TValue *xparams,
UNUSED(denv);
UNUSED(xparams);
- check_0p(K, "make-keyed-static-variable", ptree);
+ check_0p(K, ptree);
/* the key is just a dummy pair */
TValue key = kcons(K, KINERT, KINERT);
krooted_tvs_push(K, key);
diff --git a/src/kgnumbers.c b/src/kgnumbers.c
@@ -175,11 +175,11 @@ bool krealp(TValue obj)
if (tv_equal(n1, n2))
return n1;
else {
- klispE_throw(K, "+: no primary value");
+ klispE_throw_simple(K, "no primary value");
return KINERT;
}
default:
- klispE_throw(K, "+: unsopported type");
+ klispE_throw_simple(K, "unsopported type");
return KINERT;
}
}
@@ -210,14 +210,14 @@ bool krealp(TValue obj)
if (!ttiseinf(n1) || !ttiseinf(n2)) {
if (kfast_zerop(n1) || kfast_zerop(n2)) {
/* report: #e+infinity * 0 has no primary value */
- klispE_throw(K, "*: result has no primary value");
+ klispE_throw_simple(K, "result has no primary value");
return KINERT;
} else
return knum_same_signp(n1, n2)? KEPINF : KEMINF;
} else
return (tv_equal(n1, n2))? KEPINF : KEMINF;
default:
- klispE_throw(K, "*: unsopported type");
+ klispE_throw_simple(K, "unsopported type");
return KINERT;
}
}
@@ -250,12 +250,12 @@ bool krealp(TValue obj)
else if (!ttiseinf(n2))
return n1;
if (tv_equal(n1, n2)) {
- klispE_throw(K, "-: no primary value");
+ klispE_throw_simple(K, "no primary value");
return KINERT;
} else
return n1;
default:
- klispE_throw(K, "-: unsopported type");
+ klispE_throw_simple(K, "unsopported type");
return KINERT;
}
}
@@ -266,7 +266,7 @@ bool krealp(TValue obj)
{
/* first check the most common error, division by zero */
if (kfast_zerop(n2)) {
- klispE_throw(K, "/: division by zero (no primary value)");
+ klispE_throw_simple(K, "division by zero (no primary value)");
return KINERT;
}
@@ -287,7 +287,7 @@ bool krealp(TValue obj)
}
case K_TEINF: {
if (ttiseinf(n1) && ttiseinf(n2)) {
- klispE_throw(K, "/: (infinity divided by infinity) "
+ klispE_throw_simple(K, "(infinity divided by infinity) "
"no primary value");
return KINERT;
} else if (ttiseinf(n1)) {
@@ -297,7 +297,7 @@ bool krealp(TValue obj)
}
}
default:
- klispE_throw(K, "/: unsopported type");
+ klispE_throw_simple(K, "unsopported type");
return KINERT;
}
}
@@ -328,7 +328,7 @@ TValue knum_abs(klisp_State *K, TValue n)
return KEPINF;
default:
/* shouldn't happen */
- klispE_throw(K, "abs: unsopported type");
+ klispE_throw_simple(K, "unsopported type");
return KINERT;
}
}
@@ -360,7 +360,7 @@ TValue knum_gcd(klisp_State *K, TValue n1, TValue n2)
else
return KEPINF;
default:
- klispE_throw(K, "gcd: unsopported type");
+ klispE_throw_simple(K, "unsopported type");
return KINERT;
}
}
@@ -371,7 +371,7 @@ TValue knum_lcm(klisp_State *K, TValue n1, TValue n2)
{
/* get this out of the way first */
if (kfast_zerop(n1) || kfast_zerop(n2)) {
- klispE_throw(K, "lcm: no primary value");
+ klispE_throw_simple(K, "no primary value");
return KINERT;
}
@@ -392,7 +392,7 @@ TValue knum_lcm(klisp_State *K, TValue n1, TValue n2)
case K_TEINF:
return KEPINF;
default:
- klispE_throw(K, "lcm: unsopported type");
+ klispE_throw_simple(K, "unsopported type");
return KINERT;
}
}
@@ -408,7 +408,7 @@ TValue knum_numerator(klisp_State *K, TValue n)
return kbigrat_numerator(K, n);
/* case K_TEINF: infinities are not rational! */
default:
- klispE_throw(K, "numerator: unsopported type");
+ klispE_throw_simple(K, "unsopported type");
return KINERT;
}
}
@@ -424,7 +424,7 @@ TValue knum_denominator(klisp_State *K, TValue n)
return kbigrat_denominator(K, n);
/* case K_TEINF: infinities are not rational! */
default:
- klispE_throw(K, "denominator: unsopported type");
+ klispE_throw_simple(K, "unsopported type");
return KINERT;
}
}
@@ -439,10 +439,10 @@ TValue knum_real_to_integer(klisp_State *K, TValue n, kround_mode mode)
case K_TBIGRAT:
return kbigrat_to_integer(K, n, mode);
case K_TEINF:
- klispE_throw(K, "round: infinite value");
+ klispE_throw_simple(K, "infinite value");
return KINERT;
default:
- klispE_throw(K, "round: unsopported type");
+ klispE_throw_simple(K, "unsopported type");
return KINERT;
}
}
@@ -451,7 +451,7 @@ TValue knum_simplest_rational(klisp_State *K, TValue n1, TValue n2)
{
/* first check that case that n1 > n2 */
if (knum_gtp(K, n1, n2)) {
- klispE_throw(K, "simplest_rational: result with no primary value "
+ klispE_throw_simple(K, "result with no primary value "
"(n1 > n2)");
return KINERT;
}
@@ -469,7 +469,7 @@ TValue knum_simplest_rational(klisp_State *K, TValue n1, TValue n2)
case K_TEINF:
/* we know that n1 <= n2 */
if (tv_equal(n1, n2)) {
- klispE_throw(K, "simplest rational: result with no primary value");
+ klispE_throw_simple(K, "result with no primary value");
return KINERT;
} else if (knegativep(n1) && kpositivep(n2)) {
return i2tv(0);
@@ -485,7 +485,7 @@ TValue knum_simplest_rational(klisp_State *K, TValue n1, TValue n2)
return knum_real_to_integer(K, n1, K_CEILING);
}
default:
- klispE_throw(K, "simplest rational: unsopported type");
+ klispE_throw_simple(K, "unsopported type");
return KINERT;
}
}
@@ -506,11 +506,11 @@ TValue knum_rationalize(klisp_State *K, TValue n1, TValue n2)
return i2tv(0);
} else { /* infinite n1, finite n2 */
/* ASK John: is this behaviour for infinities ok? */
- klispE_throw(K, "rationalize: result with no primary value");
+ klispE_throw_simple(K, "result with no primary value");
return KINERT;
}
default:
- klispE_throw(K, "rationalize: unsopported type");
+ klispE_throw_simple(K, "unsopported type");
return KINERT;
}
}
@@ -564,7 +564,7 @@ void kplus(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
if (kfast_zerop(cres)) {
if (!all_zero) {
/* report */
- klispE_throw(K, "+: result has no primary value");
+ klispE_throw_simple(K, "result has no primary value");
return;
}
} else
@@ -627,7 +627,7 @@ void ktimes(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
if (all_one)
cres = i2tv(1);
else {
- klispE_throw(K, "*: result has no primary value");
+ klispE_throw_simple(K, "result has no primary value");
return;
}
} else if (knum_gtp(K, cres, i2tv(1))) {
@@ -636,7 +636,7 @@ void ktimes(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
cres = KEPINF;
} else {
/* cycle result less than zero */
- klispE_throw(K, "*: result has no primary value");
+ klispE_throw_simple(K, "result has no primary value");
return;
}
@@ -657,10 +657,10 @@ void kminus(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
/* - in kernel (and unlike in scheme) requires at least 2 arguments */
if (!ttispair(ptree) || !ttispair(kcdr(ptree))) {
- klispE_throw(K, "-: at least two values are required");
+ klispE_throw_simple(K, "at least two values are required");
return;
} else if (!knumberp(kcar(ptree))) {
- klispE_throw(K, "-: bad type on first argument (expected number)");
+ klispE_throw_simple(K, "bad type on first argument (expected number)");
return;
}
TValue first_val = kcar(ptree);
@@ -703,7 +703,7 @@ void kminus(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
if (kfast_zerop(cres)) {
if (!all_zero) {
/* report */
- klispE_throw(K, "-: result has no primary value");
+ klispE_throw_simple(K, "result has no primary value");
return;
}
} else
@@ -798,18 +798,17 @@ void kdiv_mod(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
** xparams[0]: name symbol
** xparams[1]: div_mod_flags
*/
- char *name = ksymbol_buf(xparams[0]);
int32_t flags = ivalue(xparams[1]);
UNUSED(denv);
- bind_2tp(K, name, ptree, "real", krealp, tv_n,
+ bind_2tp(K, ptree, "real", krealp, tv_n,
"real", krealp, tv_d);
TValue tv_div, tv_mod;
if (kfast_zerop(tv_d)) {
- klispE_throw_extra(K, name, ": division by zero");
+ klispE_throw_simple(K, "division by zero");
return;
}
@@ -852,7 +851,7 @@ void kdiv_mod(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
break;
case K_TEINF:
if (ttiseinf(tv_n)) {
- klispE_throw_extra(K, name, ": non finite dividend");
+ klispE_throw_simple(K, "non finite dividend");
return;
} else { /* if (ttiseinf(tv_d)) */
/* The semantics here are unclear, following the general
@@ -872,11 +871,11 @@ void kdiv_mod(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
way out */
/* throw an exception, until this is resolved */
/* ASK John */
- klispE_throw_extra(K, name, ": non finite divisor");
+ klispE_throw_simple(K, "non finite divisor");
return;
}
default:
- klispE_throw_extra(K, name, ": unsopported type");
+ klispE_throw_simple(K, "unsopported type");
return;
}
@@ -973,7 +972,7 @@ void kabs(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
UNUSED(xparams);
UNUSED(denv);
- bind_1tp(K, "abs", ptree, "number", knumberp, n);
+ bind_1tp(K, ptree, "number", knumberp, n);
TValue res = knum_abs(K, n);
kapply_cc(K, res);
@@ -1048,7 +1047,7 @@ void kgcd(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
if (!seen_finite_non_zero) {
/* report */
- klispE_throw(K, "gcd: result has no primary value");
+ klispE_throw_simple(K, "result has no primary value");
return;
}
}
@@ -1097,10 +1096,10 @@ void kdivided(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
/* / in kernel (and unlike in scheme) requires at least 2 arguments */
if (!ttispair(ptree) || !ttispair(kcdr(ptree))) {
- klispE_throw(K, "/: at least two values are required");
+ klispE_throw_simple(K, "at least two values are required");
return;
} else if (!knumberp(kcar(ptree))) {
- klispE_throw(K, "/: bad type on first argument (expected number)");
+ klispE_throw_simple(K, "bad type on first argument (expected number)");
return;
}
TValue first_val = kcar(ptree);
@@ -1149,7 +1148,7 @@ void kdivided(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
if (all_one)
cres = i2tv(1);
else {
- klispE_throw(K, "/: result has no primary value");
+ klispE_throw_simple(K, "result has no primary value");
return;
}
} else if (knum_gtp(K, cres, i2tv(1))) {
@@ -1158,7 +1157,7 @@ void kdivided(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
cres = KEPINF;
} else {
/* cycle result less than zero */
- klispE_throw(K, "/: result has no primary value");
+ klispE_throw_simple(K, "result has no primary value");
return;
}
@@ -1180,7 +1179,7 @@ void knumerator(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
UNUSED(denv);
UNUSED(xparams);
- bind_1tp(K, "numerator", ptree, "rational", krationalp, n);
+ bind_1tp(K, ptree, "rational", krationalp, n);
TValue res = knum_numerator(K, n);
kapply_cc(K, res);
@@ -1191,7 +1190,7 @@ void kdenominator(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
UNUSED(denv);
UNUSED(xparams);
- bind_1tp(K, "denominator", ptree, "rational", krationalp, n);
+ bind_1tp(K, ptree, "rational", krationalp, n);
TValue res = knum_denominator(K, n);
kapply_cc(K, res);
@@ -1206,10 +1205,9 @@ void kreal_to_integer(klisp_State *K, TValue *xparams, TValue ptree,
** xparams[1]: bool: true min, false max
*/
UNUSED(denv);
- char *name = ksymbol_buf(xparams[0]);
kround_mode mode = (kround_mode) ivalue(xparams[1]);
- bind_1tp(K, name, ptree, "real", krealp, n);
+ bind_1tp(K, ptree, "real", krealp, n);
TValue res = knum_real_to_integer(K, n, mode);
kapply_cc(K, res);
@@ -1222,7 +1220,7 @@ void krationalize(klisp_State *K, TValue *xparams, TValue ptree,
UNUSED(denv);
UNUSED(xparams);
- bind_2tp(K, "rationalize", ptree, "real", krealp, n1,
+ bind_2tp(K, ptree, "real", krealp, n1,
"real", krealp, n2);
TValue res = knum_rationalize(K, n1, n2);
@@ -1235,7 +1233,7 @@ void ksimplest_rational(klisp_State *K, TValue *xparams, TValue ptree,
UNUSED(denv);
UNUSED(xparams);
- bind_2tp(K, "simplest-rational", ptree, "real", krealp, n1,
+ bind_2tp(K, ptree, "real", krealp, n1,
"real", krealp, n2);
TValue res = knum_simplest_rational(K, n1, n2);
diff --git a/src/kgpair_mut.c b/src/kgpair_mut.c
@@ -27,11 +27,11 @@ void set_carB(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
{
(void) denv;
(void) xparams;
- bind_2tp(K, "set-car!", ptree, "pair", ttispair, pair,
+ bind_2tp(K, ptree, "pair", ttispair, pair,
"any", anytype, new_car);
if(!kis_mutable(pair)) {
- klispE_throw(K, "set-car!: immutable pair");
+ klispE_throw_simple(K, "immutable pair");
return;
}
kset_car(pair, new_car);
@@ -42,11 +42,11 @@ void set_cdrB(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
{
(void) denv;
(void) xparams;
- bind_2tp(K, "set-cdr!", ptree, "pair", ttispair, pair,
+ bind_2tp(K, ptree, "pair", ttispair, pair,
"any", anytype, new_cdr);
if(!kis_mutable(pair)) {
- klispE_throw(K, "set-cdr!: immutable pair");
+ klispE_throw_simple(K, "immutable pair");
return;
}
kset_cdr(pair, new_cdr);
@@ -63,7 +63,7 @@ void copy_es(klisp_State *K, TValue *xparams,
*/
char *name = ksymbol_buf(xparams[0]);
bool mut_flag = bvalue(xparams[1]);
- bind_1p(K, name, ptree, obj);
+ bind_1p(K, ptree, obj);
TValue copy = copy_es_immutable_h(K, name, obj, mut_flag);
kapply_cc(K, copy);
@@ -158,18 +158,18 @@ void encycleB(klisp_State *K, TValue *xparams, TValue ptree,
UNUSED(denv);
UNUSED(xparams);
- bind_3tp(K, "encycle!", ptree, "any", anytype, obj,
+ bind_3tp(K, ptree, "any", anytype, obj,
"integer", kintegerp, tk1,
"integer", kintegerp, tk2);
if (knegativep(tk1) || knegativep(tk2)) {
- klispE_throw(K, "encycle!: negative index");
+ klispE_throw_simple(K, "negative index");
return;
}
if (!ttisfixint(tk1) || !ttisfixint(tk2)) {
/* no list can have that many pairs */
- klispE_throw(K, "encycle!: non pair found while traversing "
+ klispE_throw_simple(K, "non pair found while traversing "
"object");
return;
}
@@ -182,12 +182,12 @@ void encycleB(klisp_State *K, TValue *xparams, TValue ptree,
while(k1 != 0) {
if (!ttispair(tail)) {
unmark_list(K, obj);
- klispE_throw(K, "encycle!: non pair found while traversing "
+ klispE_throw_simple(K, "non pair found while traversing "
"object");
return;
} else if (kis_marked(tail)) {
unmark_list(K, obj);
- klispE_throw(K, "encycle!: too few pairs in cyclic list");
+ klispE_throw_simple(K, "too few pairs in cyclic list");
return;
}
kmark(tail);
@@ -206,12 +206,12 @@ void encycleB(klisp_State *K, TValue *xparams, TValue ptree,
while(k2 != 0) {
if (!ttispair(tail)) {
unmark_list(K, obj);
- klispE_throw(K, "encycle!: non pair found while traversing "
+ klispE_throw_simple(K, "non pair found while traversing "
"object");
return;
} else if (kis_marked(tail)) {
unmark_list(K, obj);
- klispE_throw(K, "encycle!: too few pairs in cyclic list");
+ klispE_throw_simple(K, "too few pairs in cyclic list");
return;
}
kmark(tail);
@@ -220,16 +220,16 @@ void encycleB(klisp_State *K, TValue *xparams, TValue ptree,
}
if (!ttispair(tail)) {
unmark_list(K, obj);
- klispE_throw(K, "encycle!: non pair found while traversing "
+ klispE_throw_simple(K, "non pair found while traversing "
"object");
return;
} else if (kis_marked(tail)) {
unmark_list(K, obj);
- klispE_throw(K, "encycle!: too few pairs in cyclic list");
+ klispE_throw_simple(K, "too few pairs in cyclic list");
return;
} else if (!kis_mutable(tail)) {
unmark_list(K, obj);
- klispE_throw(K, "encycle!: immutable pair");
+ klispE_throw_simple(K, "immutable pair");
return;
} else {
kset_cdr(tail, fcp);
@@ -315,7 +315,7 @@ TValue appendB_get_lss_endpoints(klisp_State *K, TValue lss, int32_t apairs,
that is done on the last argument */
appendB_clear_last_pairs(K, last_pairs);
unmark_list(K, first);
- klispE_throw(K, "append!: repeated last pairs");
+ klispE_throw_simple(K, "repeated last pairs");
return KINERT;
} else {
unmark_list(K, first);
@@ -331,7 +331,7 @@ TValue appendB_get_lss_endpoints(klisp_State *K, TValue lss, int32_t apairs,
unmark_list(K, first);
if (kis_immutable(flastp)) {
appendB_clear_last_pairs(K, last_pairs);
- klispE_throw(K, "append!: immutable pair found");
+ klispE_throw_simple(K, "immutable pair found");
return KINERT;
}
/* add the last pair to the list of last pairs */
@@ -353,13 +353,13 @@ TValue appendB_get_lss_endpoints(klisp_State *K, TValue lss, int32_t apairs,
if (ttispair(ftail)) {
if (ttisnil(kcdr(ftail))) {
- klispE_throw(K, "append!: repeated last pairs");
+ klispE_throw_simple(K, "repeated last pairs");
} else {
- klispE_throw(K, "append!: cyclic list as non last "
+ klispE_throw_simple(K, "cyclic list as non last "
"argument");
}
} else {
- klispE_throw(K, "append!: improper list as non last "
+ klispE_throw_simple(K, "improper list as non last "
"argument");
}
return KINERT;
@@ -398,13 +398,13 @@ void appendB(klisp_State *K, TValue *xparams, TValue ptree,
UNUSED(xparams);
UNUSED(denv);
if (ttisnil(ptree)) {
- klispE_throw(K, "append!: no lists");
+ klispE_throw_simple(K, "no lists");
return;
} else if (!ttispair(ptree)) {
- klispE_throw(K, "append!: bad ptree");
+ klispE_throw_simple(K, "bad ptree");
return;
} else if (ttisnil(kcar(ptree))) {
- klispE_throw(K, "append!: empty first list");
+ klispE_throw_simple(K, "empty first list");
return;
}
TValue lss = ptree;
@@ -441,7 +441,7 @@ void assq(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
UNUSED(xparams);
UNUSED(denv);
- bind_2p(K, "assq", ptree, obj, ls);
+ bind_2p(K, ptree, obj, ls);
/* first pass, check structure */
int32_t pairs = check_typed_list(K, "assq", "pair", kpairp,
true, ls, NULL);
@@ -466,7 +466,7 @@ void memqp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
UNUSED(xparams);
UNUSED(denv);
- bind_2p(K, "memq?", ptree, obj, ls);
+ bind_2p(K, ptree, obj, ls);
/* first pass, check structure */
int32_t pairs = check_list(K, "memq?", true, ls, NULL);
TValue tail = ls;
diff --git a/src/kgpairs_lists.c b/src/kgpairs_lists.c
@@ -36,7 +36,7 @@ void cons(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
{
UNUSED(denv);
UNUSED(xparams);
- bind_2p(K, "cons", ptree, car, cdr);
+ bind_2p(K, ptree, car, cdr);
TValue new_pair = kcons(K, car, cdr);
kapply_cc(K, new_pair);
@@ -66,7 +66,7 @@ void listS(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
UNUSED(denv);
if (ttisnil(ptree)) {
- klispE_throw(K, "list*: empty argument list");
+ klispE_throw_simple(K, "empty argument list");
return;
}
TValue last_pair = kget_dummy1(K);
@@ -92,10 +92,10 @@ void listS(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
kset_cdr(next_to_last_pair, kcar(last_pair));
kapply_cc(K, kcutoff_dummy1(K));
} else if (ttispair(tail)) { /* cyclic argument list */
- klispE_throw(K, "list*: cyclic argument list");
+ klispE_throw_simple(K, "cyclic argument list");
return;
} else {
- klispE_throw(K, "list*: argument list is improper");
+ klispE_throw_simple(K, "argument list is improper");
return;
}
}
@@ -119,16 +119,15 @@ void c_ad_r( klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
** is bit 0 so: caar=0x20, cadr=0x21, cdar:0x22, cddr 0x23
*/
- char *name = ksymbol_buf(xparams[0]);
int p = ivalue(xparams[1]);
int count = (p >> 4) & 0xf;
int branches = p & 0xf;
- bind_1p(K, name, ptree, obj);
+ bind_1p(K, ptree, obj);
while(count) {
if (!ttispair(obj)) {
- klispE_throw_extra(K, name, ": non pair found while traversing");
+ klispE_throw_simple(K, "non pair found while traversing");
return;
}
obj = ((branches & 1) == 0)? kcar(obj) : kcdr(obj);
@@ -184,7 +183,7 @@ void get_list_metrics(klisp_State *K, TValue *xparams, TValue ptree,
UNUSED(xparams);
UNUSED(denv);
- bind_1p(K, "get-list-metrics", ptree, obj);
+ bind_1p(K, ptree, obj);
int32_t pairs, nils, apairs, cpairs;
get_list_metrics_aux(K, obj, &pairs, &nils, &apairs, &cpairs);
@@ -207,7 +206,7 @@ int32_t ksmallest_index(klisp_State *K, char *name, TValue obj,
int32_t apairs, cpairs;
get_list_metrics_aux(K, obj, NULL, NULL, &apairs, &cpairs);
if (cpairs == 0) {
- klispE_throw_extra(K, name, ": non pair found while traversing "
+ klispE_throw_simple(K, "non pair found while traversing "
"object");
return 0;
}
@@ -239,11 +238,11 @@ void list_tail(klisp_State *K, TValue *xparams, TValue ptree,
(cf $encycle!) to allow cyclic lists, so that's what I do */
UNUSED(xparams);
UNUSED(denv);
- bind_2tp(K, "list-tail", ptree, "any", anytype, obj,
+ bind_2tp(K, ptree, "any", anytype, obj,
"integer", kintegerp, tk);
if (knegativep(tk)) {
- klispE_throw(K, "list-tail: negative index");
+ klispE_throw_simple(K, "negative index");
return;
}
@@ -252,7 +251,7 @@ void list_tail(klisp_State *K, TValue *xparams, TValue ptree,
while(k) {
if (!ttispair(obj)) {
- klispE_throw(K, "list-tail: non pair found while traversing "
+ klispE_throw_simple(K, "non pair found while traversing "
"object");
return;
}
@@ -268,7 +267,7 @@ void length(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
UNUSED(xparams);
UNUSED(denv);
- bind_1p(K, "length", ptree, obj);
+ bind_1p(K, ptree, obj);
TValue tail = obj;
int pairs = 0;
@@ -292,11 +291,11 @@ void list_ref(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
UNUSED(denv);
UNUSED(xparams);
- bind_2tp(K, "list-ref", ptree, "any", anytype, obj,
+ bind_2tp(K, ptree, "any", anytype, obj,
"integer", kintegerp, tk);
if (knegativep(tk)) {
- klispE_throw(K, "list-ref: negative index");
+ klispE_throw_simple(K, "negative index");
return;
}
@@ -305,7 +304,7 @@ void list_ref(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
while(k) {
if (!ttispair(obj)) {
- klispE_throw(K, "list-ref: non pair found while traversing "
+ klispE_throw_simple(K, "non pair found while traversing "
"object");
return;
}
@@ -313,7 +312,7 @@ void list_ref(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
--k;
}
if (!ttispair(obj)) {
- klispE_throw(K, "list-ref: non pair found while traversing "
+ klispE_throw_simple(K, "non pair found while traversing "
"object");
return;
}
@@ -348,10 +347,10 @@ TValue append_check_copy_list(klisp_State *K, char *name, TValue obj,
unmark_list(K, obj);
if (ttispair(tail)) {
- klispE_throw_extra(K, name , ": expected acyclic list");
+ klispE_throw_simple(K, "expected acyclic list");
return KINERT;
} else if (!ttisnil(tail)) {
- klispE_throw_extra(K, name , ": expected list");
+ klispE_throw_simple(K, "expected list");
return KINERT;
}
*last_pair_ptr = last_pair;
@@ -427,7 +426,7 @@ void list_neighbors(klisp_State *K, TValue *xparams, TValue ptree,
UNUSED(xparams);
UNUSED(denv);
- bind_1p(K, "list_neighbors", ptree, ls);
+ bind_1p(K, ptree, ls);
int32_t cpairs;
int32_t pairs = check_list(K, "list_neighbors", true, ls, &cpairs);
@@ -535,7 +534,7 @@ void do_filter(klisp_State *K, TValue *xparams, TValue obj)
int32_t n = ivalue(xparams[3]);
if (!ttisboolean(obj)) {
- klispE_throw(K, "filter: expected boolean result");
+ klispE_throw_simple(K, "expected boolean result");
return;
}
@@ -604,7 +603,7 @@ void filter(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
{
UNUSED(xparams);
UNUSED(denv);
- bind_2tp(K, "filter", ptree, "applicative", ttisapplicative, app,
+ bind_2tp(K, ptree, "applicative", ttisapplicative, app,
"any", anytype, ls);
/* copy the list to ignore changes made by the applicative */
/* REFACTOR: do this in a single pass */
@@ -646,7 +645,7 @@ void assoc(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
UNUSED(xparams);
UNUSED(denv);
- bind_2p(K, "assoc", ptree, obj, ls);
+ bind_2p(K, ptree, obj, ls);
/* first pass, check structure */
int32_t pairs = check_typed_list(K, "assoc", "pair", kpairp,
true, ls, NULL);
@@ -670,7 +669,7 @@ void memberp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
UNUSED(xparams);
UNUSED(denv);
- bind_2p(K, "member?", ptree, obj, ls);
+ bind_2p(K, ptree, obj, ls);
/* first pass, check structure */
int32_t pairs = check_list(K, "member?", true, ls, NULL);
TValue tail = ls;
@@ -925,7 +924,7 @@ void reduce(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
{
UNUSED(xparams);
- bind_al3tp(K, "reduce", ptree, "any", anytype, ls, "applicative",
+ bind_al3tp(K, ptree, "any", anytype, ls, "applicative",
ttisapplicative, bin, "any", anytype, id, rest);
TValue prec, inc, postc;
@@ -934,7 +933,7 @@ void reduce(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
if (extended_form) {
/* the variables are an artifact of the way bind_3tp macro works,
XXX: this will also send wrong error msgs (bad number of arg) */
- bind_3tp(K, "reduce (extended)", rest,
+ bind_3tp(K, rest,
"applicative", ttisapplicative, prec_h,
"applicative", ttisapplicative, inc_h,
"applicative", ttisapplicative, postc_h);
@@ -969,7 +968,7 @@ void reduce(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
if (cpairs != 0) {
if (!extended_form) {
- klispE_throw(K, "reduce: no cyclic handling applicatives");
+ klispE_throw_simple(K, "no cyclic handling applicatives");
return;
}
/* make cycle reducing cont */
diff --git a/src/kgports.c b/src/kgports.c
@@ -58,11 +58,10 @@ void do_close_file_ret(klisp_State *K, TValue *xparams, TValue obj)
void with_file(klisp_State *K, TValue *xparams, TValue ptree,
TValue denv)
{
- char *name = ksymbol_buf(xparams[0]);
bool writep = bvalue(xparams[1]);
TValue key = xparams[2];
- bind_2tp(K, name, ptree, "string", ttisstring, filename,
+ bind_2tp(K, ptree, "string", ttisstring, filename,
"combiner", ttiscombiner, comb);
TValue new_port = kmake_port(K, filename, writep);
@@ -95,10 +94,9 @@ void get_current_port(klisp_State *K, TValue *xparams, TValue ptree,
*/
UNUSED(denv);
- char *name = ksymbol_buf(xparams[0]);
TValue key = xparams[1];
- check_0p(K, name, ptree);
+ check_0p(K, ptree);
/* can access directly, no need to call do_access */
kapply_cc(K, kcdr(key));
@@ -108,11 +106,10 @@ void get_current_port(klisp_State *K, TValue *xparams, TValue ptree,
/* 15.1.5 open-input-file, open-output-file */
void open_file(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
{
- char *name = ksymbol_buf(xparams[0]);
bool writep = bvalue(xparams[1]);
UNUSED(denv);
- bind_1tp(K, name, ptree, "string", ttisstring, filename);
+ bind_1tp(K, ptree, "string", ttisstring, filename);
TValue new_port = kmake_port(K, filename, writep);
kapply_cc(K, new_port);
@@ -121,11 +118,10 @@ void open_file(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
/* 15.1.6 close-input-file, close-output-file */
void close_file(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
{
- char *name = ksymbol_buf(xparams[0]);
bool writep = bvalue(xparams[1]);
UNUSED(denv);
- bind_1tp(K, name, ptree, "port", ttisport, port);
+ bind_1tp(K, ptree, "port", ttisport, port);
bool dir_ok = writep? kport_is_output(port) : kport_is_input(port);
@@ -133,7 +129,7 @@ void close_file(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
kclose_port(K, port);
kapply_cc(K, KINERT);
} else {
- klispE_throw_extra(K, name, ": wrong input/output direction");
+ klispE_throw_simple(K, "wrong input/output direction");
return;
}
}
@@ -148,11 +144,11 @@ void read(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
if (!get_opt_tpar(K, "read", K_TPORT, &port)) {
port = kcdr(K->kd_in_port_key); /* access directly */
} else if (!kport_is_input(port)) {
- klispE_throw(K, "read: the port should be an input port");
+ klispE_throw_simple(K, "the port should be an input port");
return;
}
if (kport_is_closed(port)) {
- klispE_throw(K, "read: the port is already closed");
+ klispE_throw_simple(K, "the port is already closed");
return;
}
@@ -167,17 +163,17 @@ void write(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
UNUSED(xparams);
UNUSED(denv);
- bind_al1tp(K, "write", ptree, "any", anytype, obj,
+ bind_al1tp(K, ptree, "any", anytype, obj,
port);
if (!get_opt_tpar(K, "write", K_TPORT, &port)) {
port = kcdr(K->kd_out_port_key); /* access directly */
} else if (!kport_is_output(port)) {
- klispE_throw(K, "write: the port should be an output port");
+ klispE_throw_simple(K, "the port should be an output port");
return;
}
if (kport_is_closed(port)) {
- klispE_throw(K, "write: the port is already closed");
+ klispE_throw_simple(K, "the port is already closed");
return;
}
@@ -199,11 +195,11 @@ void newline(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
if (!get_opt_tpar(K, "newline", K_TPORT, &port)) {
port = kcdr(K->kd_out_port_key); /* access directly */
} else if (!kport_is_output(port)) {
- klispE_throw(K, "write: the port should be an output port");
+ klispE_throw_simple(K, "the port should be an output port");
return;
}
if (kport_is_closed(port)) {
- klispE_throw(K, "write: the port is already closed");
+ klispE_throw_simple(K, "the port is already closed");
return;
}
@@ -217,17 +213,17 @@ void write_char(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
UNUSED(xparams);
UNUSED(denv);
- bind_al1tp(K, "write-char", ptree, "char", ttischar, ch,
+ bind_al1tp(K, ptree, "char", ttischar, ch,
port);
if (!get_opt_tpar(K, "write-char", K_TPORT, &port)) {
port = kcdr(K->kd_out_port_key); /* access directly */
} else if (!kport_is_output(port)) {
- klispE_throw(K, "write-char: the port should be an output port");
+ klispE_throw_simple(K, "the port should be an output port");
return;
}
if (kport_is_closed(port)) {
- klispE_throw(K, "write-char: the port is already closed");
+ klispE_throw_simple(K, "the port is already closed");
return;
}
@@ -252,11 +248,11 @@ void read_peek_char(klisp_State *K, TValue *xparams, TValue ptree,
if (!get_opt_tpar(K, name, K_TPORT, &port)) {
port = kcdr(K->kd_in_port_key); /* access directly */
} else if (!kport_is_input(port)) {
- klispE_throw_extra(K, name, ": the port should be an input port");
+ klispE_throw_simple(K, "the port should be an input port");
return;
}
if (kport_is_closed(port)) {
- klispE_throw_extra(K, name, ": the port is already closed");
+ klispE_throw_simple(K, "the port is already closed");
return;
}
@@ -285,11 +281,11 @@ void char_readyp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
if (!get_opt_tpar(K, "char-ready?", K_TPORT, &port)) {
port = kcdr(K->kd_in_port_key); /* access directly */
} else if (!kport_is_input(port)) {
- klispE_throw(K, "char-ready?: the port should be an input port");
+ klispE_throw_simple(K, "the port should be an input port");
return;
}
if (kport_is_closed(port)) {
- klispE_throw(K, "char-ready?: the port is already closed");
+ klispE_throw_simple(K, "the port is already closed");
return;
}
@@ -306,11 +302,10 @@ void char_readyp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
void call_with_file(klisp_State *K, TValue *xparams, TValue ptree,
TValue denv)
{
- char *name = ksymbol_buf(xparams[0]);
bool writep = bvalue(xparams[1]);
UNUSED(denv);
- bind_2tp(K, name, ptree, "string", ttisstring, filename,
+ bind_2tp(K, ptree, "string", ttisstring, filename,
"combiner", ttiscombiner, comb);
TValue new_port = kmake_port(K, filename, writep);
@@ -418,7 +413,7 @@ TValue make_guarded_read_cont(klisp_State *K, TValue parent, TValue port)
void load(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
{
UNUSED(xparams);
- bind_1tp(K, "load", ptree, "string", ttisstring, filename);
+ bind_1tp(K, ptree, "string", ttisstring, filename);
/* the reads must be guarded to close the file if there is some error
this continuation also will return inert after the evaluation of the
@@ -464,7 +459,7 @@ void get_module(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
{
UNUSED(xparams);
UNUSED(denv);
- bind_al1tp(K, "get-module", ptree, "string", ttisstring, filename,
+ bind_al1tp(K, ptree, "string", ttisstring, filename,
maybe_env);
TValue port = kmake_port(K, filename, false);
@@ -517,17 +512,17 @@ void display(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
UNUSED(xparams);
UNUSED(denv);
- bind_al1tp(K, "display", ptree, "any", anytype, obj,
+ bind_al1tp(K, ptree, "any", anytype, obj,
port);
if (!get_opt_tpar(K, "display", K_TPORT, &port)) {
port = kcdr(K->kd_out_port_key); /* access directly */
} else if (!kport_is_output(port)) {
- klispE_throw(K, "display: the port should be an output port");
+ klispE_throw_simple(K, "the port should be an output port");
return;
}
if (kport_is_closed(port)) {
- klispE_throw(K, "display: the port is already closed");
+ klispE_throw_simple(K, "the port is already closed");
return;
}
diff --git a/src/kgpromises.c b/src/kgpromises.c
@@ -68,7 +68,7 @@ void force(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
{
UNUSED(xparams);
UNUSED(denv);
- bind_1p(K, "force", ptree, obj);
+ bind_1p(K, ptree, obj);
if (!ttispromise(obj)) {
/* non promises force to themselves */
kapply_cc(K, obj);
@@ -89,7 +89,7 @@ void Slazy(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
{
UNUSED(xparams);
- bind_1p(K, "$lazy", ptree, exp);
+ bind_1p(K, ptree, exp);
TValue new_prom = kmake_promise(K, exp, denv);
kapply_cc(K, new_prom);
}
@@ -100,7 +100,7 @@ void memoize(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
UNUSED(xparams);
UNUSED(denv);
- bind_1p(K, "memoize", ptree, exp);
+ bind_1p(K, ptree, exp);
TValue new_prom = kmake_promise(K, exp, KNIL);
kapply_cc(K, new_prom);
}
diff --git a/src/kgstrings.c b/src/kgstrings.c
@@ -34,7 +34,7 @@ void make_string(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
{
UNUSED(xparams);
UNUSED(denv);
- bind_al1tp(K, "make-string", ptree, "integer", kintegerp, tv_s,
+ bind_al1tp(K, ptree, "integer", kintegerp, tv_s,
maybe_char);
char fill = ' ';
@@ -42,10 +42,10 @@ void make_string(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
fill = chvalue(maybe_char);
if (knegativep(tv_s)) {
- klispE_throw(K, "make-string: negative size");
+ klispE_throw_simple(K, "negative size");
return;
} else if (!ttisfixint(tv_s)) {
- klispE_throw(K, "make-string: size is too big");
+ klispE_throw_simple(K, "size is too big");
return;
}
@@ -59,7 +59,7 @@ void string_length(klisp_State *K, TValue *xparams, TValue ptree,
{
UNUSED(xparams);
UNUSED(denv);
- bind_1tp(K, "string-length", ptree, "string", ttisstring, str);
+ bind_1tp(K, ptree, "string", ttisstring, str);
TValue res = i2tv(kstring_size(str));
kapply_cc(K, res);
@@ -70,19 +70,19 @@ void string_ref(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
{
UNUSED(xparams);
UNUSED(denv);
- bind_2tp(K, "string-ref", ptree, "string", ttisstring, str,
+ bind_2tp(K, ptree, "string", ttisstring, str,
"integer", kintegerp, tv_i);
if (!ttisfixint(tv_i)) {
/* TODO show index */
- klispE_throw(K, "string-ref: index out of bounds");
+ klispE_throw_simple(K, "index out of bounds");
return;
}
int32_t i = ivalue(tv_i);
if (i < 0 || i >= kstring_size(str)) {
/* TODO show index */
- klispE_throw(K, "string-ref: index out of bounds");
+ klispE_throw_simple(K, "index out of bounds");
return;
}
@@ -95,15 +95,15 @@ void string_setS(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
{
UNUSED(xparams);
UNUSED(denv);
- bind_3tp(K, "string-set!", ptree, "string", ttisstring, str,
+ bind_3tp(K, ptree, "string", ttisstring, str,
"integer", kintegerp, tv_i, "char", ttischar, tv_ch);
if (!ttisfixint(tv_i)) {
/* TODO show index */
- klispE_throw(K, "string-set!: index out of bounds");
+ klispE_throw_simple(K, "index out of bounds");
return;
} else if (kstring_immutablep(str)) {
- klispE_throw(K, "string-set!: immutable string");
+ klispE_throw_simple(K, "immutable string");
return;
}
@@ -111,7 +111,7 @@ void string_setS(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
if (i < 0 || i >= kstring_size(str)) {
/* TODO show index */
- klispE_throw(K, "string-set!: index out of bounds");
+ klispE_throw_simple(K, "index out of bounds");
return;
}
@@ -244,14 +244,14 @@ void substring(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
{
UNUSED(xparams);
UNUSED(denv);
- bind_3tp(K, "substring", ptree, "string", ttisstring, str,
+ bind_3tp(K, ptree, "string", ttisstring, str,
"integer", kintegerp, tv_start,
"integer", kintegerp, tv_end);
if (!ttisfixint(tv_start) || ivalue(tv_start) < 0 ||
ivalue(tv_start) > kstring_size(str)) {
/* TODO show index */
- klispE_throw(K, "substring: start index out of bounds");
+ klispE_throw_simple(K, "start index out of bounds");
return;
}
@@ -259,7 +259,7 @@ void substring(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
if (!ttisfixint(tv_end) || ivalue(tv_end) < 0 ||
ivalue(tv_end) > kstring_size(str)) {
- klispE_throw(K, "substring: end index out of bounds");
+ klispE_throw_simple(K, "end index out of bounds");
return;
}
@@ -267,7 +267,7 @@ void substring(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
if (start > end) {
/* TODO show indexes */
- klispE_throw(K, "substring: end index is smaller than start index");
+ klispE_throw_simple(K, "end index is smaller than start index");
return;
}
@@ -303,7 +303,7 @@ void string_append(klisp_State *K, TValue *xparams, TValue ptree,
while(pairs--) {
total_size += kstring_size(kcar(tail));
if (total_size > INT32_MAX) {
- klispE_throw(K, "string-append: resulting string is too big");
+ klispE_throw_simple(K, "resulting string is too big");
return;
}
tail = kcdr(tail);
@@ -340,7 +340,7 @@ void string_to_list(klisp_State *K, TValue *xparams, TValue ptree,
UNUSED(xparams);
UNUSED(denv);
- bind_1tp(K, "string->list", ptree, "string", ttisstring, str);
+ bind_1tp(K, ptree, "string", ttisstring, str);
int32_t pairs = kstring_size(str);
char *buf = kstring_buf(str);
@@ -362,7 +362,7 @@ void list_to_string(klisp_State *K, TValue *xparams, TValue ptree,
UNUSED(denv);
/* check later in list_to_string_h */
- bind_1p(K, "list->string", ptree, ls);
+ bind_1p(K, ptree, ls);
TValue new_str = list_to_string_h(K, "list->string", ls);
kapply_cc(K, new_str);
@@ -374,7 +374,7 @@ void string_copy(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
{
UNUSED(xparams);
UNUSED(denv);
- bind_1tp(K, "string-copy", ptree, "string", ttisstring, str);
+ bind_1tp(K, ptree, "string", ttisstring, str);
TValue new_str;
/* the if isn't strictly necessary but it's clearer this way */
@@ -392,7 +392,7 @@ void string_to_immutable_string(klisp_State *K, TValue *xparams,
{
UNUSED(xparams);
UNUSED(denv);
- bind_1tp(K, "string->immutable-string", ptree, "string", ttisstring, str);
+ bind_1tp(K, ptree, "string", ttisstring, str);
TValue res_str;
if (kstring_immutablep(str)) {/* this includes the empty list */
@@ -408,11 +408,11 @@ void string_fillS(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
{
UNUSED(xparams);
UNUSED(denv);
- bind_2tp(K, "string-fill!", ptree, "string", ttisstring, str,
+ bind_2tp(K, ptree, "string", ttisstring, str,
"char", ttischar, tv_ch);
if (kstring_immutablep(str)) {
- klispE_throw(K, "string-fill!: immutable string");
+ klispE_throw_simple(K, "immutable string");
return;
}
@@ -428,7 +428,7 @@ void symbol_to_string(klisp_State *K, TValue *xparams, TValue ptree,
{
UNUSED(xparams);
UNUSED(denv);
- bind_1tp(K, "symbol->string", ptree, "symbol", ttissymbol, sym);
+ bind_1tp(K, ptree, "symbol", ttissymbol, sym);
TValue str = ksymbol_str(sym);
kapply_cc(K, str);
}
@@ -449,7 +449,7 @@ void string_to_symbol(klisp_State *K, TValue *xparams, TValue ptree,
{
UNUSED(xparams);
UNUSED(denv);
- bind_1tp(K, "string->symbol", ptree, "string", ttisstring, str);
+ bind_1tp(K, ptree, "string", ttisstring, str);
TValue new_sym = ksymbol_new_check_i(K, str);
kapply_cc(K, new_sym);
}
diff --git a/src/kmem.c b/src/kmem.c
@@ -46,7 +46,7 @@ void *klispM_growaux_ (klisp_State *K, void *block, int *size, size_t size_elems
int32_t newsize;
if (*size >= limit/2) { /* cannot double it? */
if (*size >= limit) /* cannot grow even a little? */
- klispE_throw(K, (char *) errormsg); /* XXX */
+ klispE_throw_simple(K, (char *) errormsg); /* XXX */
newsize = limit; /* still have at least one free place */
}
else {
@@ -61,7 +61,8 @@ void *klispM_growaux_ (klisp_State *K, void *block, int *size, size_t size_elems
void *klispM_toobig (klisp_State *K) {
- klispE_throw(K, "memory allocation error: block too big");
+ /* TODO better msg */
+ klispE_throw_simple(K, "(mem) block too big");
return NULL; /* to avoid warnings */
}
diff --git a/src/kobject.h b/src/kobject.h
@@ -450,7 +450,7 @@ typedef struct __attribute__ ((__packed__)) {
/* Errors */
typedef struct __attribute__ ((__packed__)) {
CommonHeader;
- TValue who; /* either #inert or creating combiner */
+ TValue who; /* either #inert or creating combiner/continuation */
TValue cont; /* continuation context */
TValue msg; /* string msg */
TValue irritants; /* list of extra objs */
diff --git a/src/kport.c b/src/kport.c
@@ -27,7 +27,7 @@ TValue kmake_port(klisp_State *K, TValue filename, bool writep)
/* for now always use text mode */
FILE *f = fopen(kstring_buf(filename), writep? "w": "r");
if (f == NULL) {
- klispE_throw(K, "Create port: could't open file");
+ klispE_throw_simple(K, "could't open file");
return KINERT;
} else {
return kmake_std_port(K, filename, writep, f);
diff --git a/src/kread.c b/src/kread.c
@@ -72,7 +72,7 @@ void kread_error(klisp_State *K, char *str)
kport_update_source_info(K->curr_port, K->ktok_source_info.line,
K->ktok_source_info.col);
- klispE_throw(K, str);
+ klispE_throw_simple(K, str);
}
/*
diff --git a/src/ktable.c b/src/ktable.c
@@ -167,7 +167,7 @@ static int32_t findindex (klisp_State *K, Table *t, TValue key)
}
else n = gnext(n);
} while (n);
- klispE_throw(K, "invalid key to next"); /* key not found */
+ klispE_throw_simple(K, "invalid key to next"); /* key not found */
return 0; /* to avoid warnings */
}
}
@@ -299,7 +299,7 @@ static void setnodevector (klisp_State *K, Table *t, int32_t size)
int32_t i;
lsize = ceillog2(size);
if (lsize > MAXBITS)
- klispE_throw(K, "table overflow");
+ klispE_throw_simple(K, "table overflow");
size = twoto(lsize);
t->node = klispM_newvector(K, size, Node);
for (i=0; i<size; i++) {
@@ -547,7 +547,7 @@ TValue *klispH_set (klisp_State *K, Table *t, TValue key)
return cast(TValue *, p);
else {
if (ttisfree(key))
- klispE_throw(K, "table index is free");
+ klispE_throw_simple(K, "table index is free");
/*
else if (ttisnumber(key) && luai_numisnan(nvalue(key)))
luaG_runerror(L, "table index is NaN");
diff --git a/src/ktoken.c b/src/ktoken.c
@@ -148,7 +148,7 @@ void ktok_error(klisp_State *K, char *str)
kport_update_source_info(K->curr_port, K->ktok_source_info.line,
K->ktok_source_info.col);
- klispE_throw(K, str);
+ klispE_throw_simple(K, str);
}
/*
diff --git a/src/kwrite.c b/src/kwrite.c
@@ -49,7 +49,7 @@ void kwrite_error(klisp_State *K, char *msg)
ks_tbclear(K);
ks_sclear(K);
- klispE_throw(K, msg);
+ klispE_throw_simple(K, msg);
}
/* TODO: check for return codes and throw error if necessary */
