commit 5f6d26e873e70f178694158a4e7d89846e005be7
parent 108007f8ea3acd454ff8676b7967e622701ca748
Author: Andres Navarro <canavarro82@gmail.com>
Date: Thu, 24 Nov 2011 21:29:31 -0300
Added irritant list copying to error, refactored a little. Refactor: renamed kgerror.[ch] to kgerrors.[ch]
Diffstat:
11 files changed, 144 insertions(+), 137 deletions(-)
diff --git a/src/Makefile b/src/Makefile
@@ -40,7 +40,7 @@ CORE_O= kobject.o ktoken.o kpair.o kstring.o ksymbol.o kread.o \
kgsymbols.o kgcontrol.o kgpairs_lists.o kgpair_mut.o kgenvironments.o \
kgenv_mut.o kgcombiners.o kgcontinuations.o kgencapsulations.o \
kgpromises.o kgkd_vars.o kgks_vars.o kgports.o kgchars.o kgnumbers.o \
- kgstrings.o kgbytevectors.o kgvectors.o kgsystem.o kgerror.o \
+ kgstrings.o kgbytevectors.o kgvectors.o kgsystem.o kgerrors.o \
$(if $(USE_LIBFFI),kgffi.o)
# TEMP: in klisp there is no distinction between core & lib
@@ -174,10 +174,10 @@ kgequalp.o: kgequalp.c kstate.h klimits.h klisp.h kobject.h klispconf.h \
kcontinuation.h kerror.h kghelpers.h kapplicative.h koperative.h \
kenvironment.h ksymbol.h kgeqp.h kinteger.h imath.h krational.h imrat.h \
kgequalp.h
-kgerror.o: kgerror.c kstate.h klimits.h klisp.h kobject.h klispconf.h \
+kgerrors.o: kgerrors.c kstate.h klimits.h klisp.h kobject.h klispconf.h \
ktoken.h kmem.h kstring.h kpair.h kgc.h kerror.h kghelpers.h \
kapplicative.h koperative.h kcontinuation.h kenvironment.h ksymbol.h \
- kgerror.h
+ kgerrors.h
kgffi.o: kgffi.c imath.h kobject.h klimits.h klisp.h klispconf.h kstate.h \
ktoken.h kmem.h kinteger.h kpair.h kgc.h kerror.h kbytevector.h \
kencapsulation.h ktable.h kghelpers.h kapplicative.h koperative.h \
@@ -227,7 +227,7 @@ kground.o: kground.c kstate.h klimits.h klisp.h kobject.h klispconf.h \
kgenvironments.h kgenv_mut.h kgcombiners.h kgcontinuations.h \
kgencapsulations.h kgpromises.h kgkd_vars.h kgks_vars.h kgnumbers.h \
kgstrings.h kgchars.h kgports.h kgbytevectors.h kgvectors.h kgsystem.h \
- kgerror.h kgffi.h ktable.h keval.h krepl.h kscript.h
+ kgerrors.h kgffi.h ktable.h keval.h krepl.h kscript.h
kgstrings.o: kgstrings.c kstate.h klimits.h klisp.h kobject.h klispconf.h \
ktoken.h kmem.h kapplicative.h koperative.h kcontinuation.h kerror.h \
kpair.h kgc.h ksymbol.h kstring.h kghelpers.h kenvironment.h kgchars.h \
@@ -271,17 +271,17 @@ kreal.o: kreal.c kreal.h kobject.h klimits.h klisp.h klispconf.h kstate.h \
kerror.h
krepl.o: krepl.c klisp.h kobject.h klimits.h klispconf.h kstate.h \
ktoken.h kmem.h kcontinuation.h kenvironment.h kerror.h kpair.h kgc.h \
- kread.h kwrite.h kstring.h krepl.h ksymbol.h kport.h kgerror.h \
+ kread.h kwrite.h kstring.h krepl.h ksymbol.h kport.h kgerrors.h \
kghelpers.h kapplicative.h koperative.h ktable.h kgcontinuations.h
kscript.o: kscript.c klisp.h kobject.h klimits.h klispconf.h kstate.h \
ktoken.h kmem.h kcontinuation.h kenvironment.h kerror.h kpair.h kgc.h \
kread.h kwrite.h kstring.h krepl.h kscript.h ksymbol.h kport.h \
- kgcontrol.h kghelpers.h kapplicative.h koperative.h kgerror.h ktable.h
+ kgcontrol.h kghelpers.h kapplicative.h koperative.h kgerrors.h ktable.h
kstate.o: kstate.c klisp.h kobject.h klimits.h klispconf.h kstate.h \
ktoken.h kmem.h kstring.h kpair.h kgc.h keval.h koperative.h \
kapplicative.h kcontinuation.h kenvironment.h kground.h krepl.h \
kscript.h ksymbol.h kport.h ktable.h kbytevector.h kvector.h \
- kgpairs_lists.h kghelpers.h kerror.h kgerror.h
+ kgpairs_lists.h kghelpers.h kerror.h kgerrors.h
kstring.o: kstring.c kstring.h kobject.h klimits.h klisp.h klispconf.h \
kstate.h ktoken.h kmem.h kgc.h
ksymbol.o: ksymbol.c ksymbol.h kobject.h klimits.h klisp.h klispconf.h \
diff --git a/src/kerror.h b/src/kerror.h
@@ -55,7 +55,7 @@ void klispE_throw_system_error_with_irritants(
TValue ls__ = klist(K__, __VA_ARGS__); \
krooted_tvs_push(K__, ls__); \
klispE_throw_system_error_with_irritants(K__, service__, errnum__, ls__); \
- }
+ }
#define klispE_throw_errno_simple(K__, service__) \
klispE_throw_system_error_with_irritants(K__, service__, errno, KNIL);
diff --git a/src/kgerror.c b/src/kgerror.c
@@ -1,95 +0,0 @@
-/*
-** kgerror.c
-** Error handling features for the ground environment
-** See Copyright Notice in klisp.h
-*/
-
-#include <stdbool.h>
-#include <stdint.h>
-
-#include "kstate.h"
-#include "kobject.h"
-#include "kstring.h"
-#include "kpair.h"
-#include "kerror.h"
-
-#include "kghelpers.h"
-#include "kgerror.h"
-
-void r7rs_error(klisp_State *K)
-{
- TValue *xparams = K->next_xparams;
- TValue ptree = K->next_value;
- TValue denv = K->next_env;
- klisp_assert(ttisenvironment(K->next_env));
- UNUSED(xparams);
- UNUSED(denv);
- if (ttispair(ptree) && ttisstring(kcar(ptree))) {
- klispE_throw_with_irritants(K, kstring_buf(kcar(ptree)), kcdr(ptree));
- } else {
- klispE_throw_with_irritants(K, "Unknown error in user code", ptree);
- }
-}
-
-void error_object_message(klisp_State *K)
-{
- TValue *xparams = K->next_xparams;
- TValue ptree = K->next_value;
- TValue denv = K->next_env;
- klisp_assert(ttisenvironment(K->next_env));
- UNUSED(xparams);
- UNUSED(denv);
- bind_1tp(K, ptree, "error object", ttiserror, error_tv);
- Error *err_obj = tv2error(error_tv);
- klisp_assert(ttisstring(err_obj->msg));
- kapply_cc(K, err_obj->msg);
-}
-
-void error_object_irritants(klisp_State *K)
-{
- TValue *xparams = K->next_xparams;
- TValue ptree = K->next_value;
- TValue denv = K->next_env;
- klisp_assert(ttisenvironment(K->next_env));
- UNUSED(xparams);
- UNUSED(denv);
- bind_1tp(K, ptree, "error object", ttiserror, error_tv);
- Error *err_obj = tv2error(error_tv);
- kapply_cc(K, err_obj->irritants);
-}
-/* REFACTOR this is the same as do_pass_value */
-void do_exception_cont(klisp_State *K)
-{
- TValue *xparams = K->next_xparams;
- TValue obj = K->next_value;
- klisp_assert(ttisnil(K->next_env));
- UNUSED(xparams);
- /* Just pass error object to general error continuation. */
- kapply_cc(K, obj);
-}
-
-/* REFACTOR maybe this should be in kerror.c */
-/* Create system-error-continuation. */
-void kinit_error_hierarchy(klisp_State *K)
-{
- klisp_assert(ttiscontinuation(K->error_cont));
- klisp_assert(ttisinert(K->system_error_cont));
-
- K->system_error_cont = kmake_continuation(K, K->error_cont,
- do_exception_cont, 0);
-}
-
-/* init ground */
-void kinit_error_ground_env(klisp_State *K)
-{
- TValue ground_env = K->ground_env;
- TValue symbol, value;
-
- add_applicative(K, ground_env, "error-object?", typep, 2, symbol, i2tv(K_TERROR));
- add_applicative(K, ground_env, "error", r7rs_error, 0);
- add_applicative(K, ground_env, "error-object-message", error_object_message, 0);
- add_applicative(K, ground_env, "error-object-irritants", error_object_irritants, 0);
-
- klisp_assert(ttiscontinuation(K->system_error_cont));
- add_value(K, ground_env, "system-error-continuation", K->system_error_cont);
-}
diff --git a/src/kgerror.h b/src/kgerror.h
@@ -1,29 +0,0 @@
-/*
-** kgerror.h
-** Error handling features for the ground environment
-** See Copyright Notice in klisp.h
-*/
-
-#ifndef kgerror_h
-#define kgerror_h
-
-#include <assert.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <stdbool.h>
-#include <stdint.h>
-
-#include "kobject.h"
-#include "klisp.h"
-#include "kstate.h"
-#include "kghelpers.h"
-
-/* init ground */
-void kinit_error_ground_env(klisp_State *K);
-
-/* Second stage of itialization of ground environment. Must be
- * called after initializing general error continuation
- * K->error_cont. */
-void kinit_error_hierarchy(klisp_State *K);
-
-#endif
diff --git a/src/kgerrors.c b/src/kgerrors.c
@@ -0,0 +1,99 @@
+/*
+** kgerrors.c
+** Error handling features for the ground environment
+** See Copyright Notice in klisp.h
+*/
+
+#include <stdbool.h>
+#include <stdint.h>
+
+#include "kstate.h"
+#include "kobject.h"
+#include "kstring.h"
+#include "kpair.h"
+#include "kerror.h"
+
+#include "kghelpers.h"
+#include "kgerrors.h"
+
+void r7rs_error(klisp_State *K)
+{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
+ UNUSED(xparams);
+ UNUSED(denv);
+
+ bind_al1tp(K, ptree, "string", ttisstring, str, rest);
+ /* copy the list of irritants, to avoid modification later */
+ /* also check that is a list! */
+ TValue irritants = check_copy_list(K, "error", rest, false);
+ krooted_tvs_push(K, irritants);
+ /* the msg is implicitly copied here */
+ klispE_throw_with_irritants(K, kstring_buf(str), irritants);
+}
+
+void error_object_message(klisp_State *K)
+{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
+ UNUSED(xparams);
+ UNUSED(denv);
+ bind_1tp(K, ptree, "error object", ttiserror, error_tv);
+ Error *err_obj = tv2error(error_tv);
+ klisp_assert(ttisstring(err_obj->msg));
+ kapply_cc(K, err_obj->msg);
+}
+
+void error_object_irritants(klisp_State *K)
+{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
+ UNUSED(xparams);
+ UNUSED(denv);
+ bind_1tp(K, ptree, "error object", ttiserror, error_tv);
+ Error *err_obj = tv2error(error_tv);
+ kapply_cc(K, err_obj->irritants);
+}
+
+/* REFACTOR this is the same as do_pass_value */
+void do_exception_cont(klisp_State *K)
+{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
+ UNUSED(xparams);
+ /* Just pass error object to general error continuation. */
+ kapply_cc(K, obj);
+}
+
+/* REFACTOR maybe this should be in kerror.c */
+/* Create system-error-continuation. */
+void kinit_error_hierarchy(klisp_State *K)
+{
+ klisp_assert(ttiscontinuation(K->error_cont));
+ klisp_assert(ttisinert(K->system_error_cont));
+
+ K->system_error_cont = kmake_continuation(K, K->error_cont,
+ do_exception_cont, 0);
+}
+
+/* init ground */
+void kinit_error_ground_env(klisp_State *K)
+{
+ TValue ground_env = K->ground_env;
+ TValue symbol, value;
+
+ add_applicative(K, ground_env, "error-object?", typep, 2, symbol, i2tv(K_TERROR));
+ add_applicative(K, ground_env, "error", r7rs_error, 0);
+ add_applicative(K, ground_env, "error-object-message", error_object_message, 0);
+ add_applicative(K, ground_env, "error-object-irritants", error_object_irritants, 0);
+
+ klisp_assert(ttiscontinuation(K->system_error_cont));
+ add_value(K, ground_env, "system-error-continuation", K->system_error_cont);
+}
diff --git a/src/kgerrors.h b/src/kgerrors.h
@@ -0,0 +1,29 @@
+/*
+** kgerror.h
+** Error handling features for the ground environment
+** See Copyright Notice in klisp.h
+*/
+
+#ifndef kgerrors_h
+#define kgerrors_h
+
+#include <assert.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <stdbool.h>
+#include <stdint.h>
+
+#include "kobject.h"
+#include "klisp.h"
+#include "kstate.h"
+#include "kghelpers.h"
+
+/* init ground */
+void kinit_error_ground_env(klisp_State *K);
+
+/* Second stage of itialization of ground environment. Must be
+ * called after initializing general error continuation
+ * K->error_cont. */
+void kinit_error_hierarchy(klisp_State *K);
+
+#endif
diff --git a/src/kghelpers.h b/src/kghelpers.h
@@ -265,12 +265,14 @@ inline void unmark_tree(klisp_State *K, TValue obj)
/* TODO: move all bools to a flag parameter (with constants like
KCHK_LS_FORCE_COPY, KCHK_ALLOW_CYCLE, KCHK_AVOID_ENCYCLE, etc) */
+/* REFACTOR: remove the name argument */
/* typed finite list. Structure error should be throw before type errors */
int32_t check_typed_list(klisp_State *K, char *name, char *typename,
bool (*typep)(TValue), bool allow_infp, TValue obj,
int32_t *cpairs);
+/* REFACTOR: remove the name argument */
/* check that obj is a list, returns the number of pairs */
/* TODO change the return to void and add int32_t pairs obj */
int32_t check_list(klisp_State *K, const char *name, bool allow_infp,
@@ -280,7 +282,7 @@ int32_t check_list(klisp_State *K, const char *name, bool allow_infp,
** MAYBE: These shouldn't be inline really.
*/
-
+/* REFACTOR: remove the name argument */
/* REFACTOR: return the number of pairs and cycle pairs in two extra params */
/* TODO: add check_copy_typed_list */
/* TODO: remove inline */
@@ -328,6 +330,7 @@ inline TValue check_copy_list(klisp_State *K, char *name, TValue obj,
}
}
+/* REFACTOR: remove the name argument */
/* check that obj is a list of environments and make a copy but don't keep
the cycles */
/* GC: assume obj is rooted, uses dummy3 */
diff --git a/src/kground.c b/src/kground.c
@@ -38,7 +38,7 @@
#include "kgbytevectors.h"
#include "kgvectors.h"
#include "kgsystem.h"
-#include "kgerror.h"
+#include "kgerrors.h"
#if KUSE_LIBFFI
# include "kgffi.h"
diff --git a/src/krepl.c b/src/krepl.c
@@ -19,7 +19,7 @@
#include "ksymbol.h"
#include "kport.h"
#include "kpair.h"
-#include "kgerror.h"
+#include "kgerrors.h"
/* for names */
#include "ktable.h"
/* for do_pass_value */
diff --git a/src/kscript.c b/src/kscript.c
@@ -21,7 +21,7 @@
#include "kport.h"
#include "kpair.h"
#include "kgcontrol.h"
-#include "kgerror.h"
+#include "kgerrors.h"
/* for names */
#include "ktable.h"
diff --git a/src/kstate.c b/src/kstate.c
@@ -39,7 +39,7 @@
#include "kvector.h"
#include "kgpairs_lists.h" /* for creating list_app */
-#include "kgerror.h" /* for creating error hierarchy */
+#include "kgerrors.h" /* for creating error hierarchy */
#include "kgc.h" /* for memory freeing & gc init */
