klisp

commit 68df344a438f6bda12dc03e190708ad757b5ec8a
parent 8c21f6f4a5f6f0864713439f87393739f968a216
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Thu, 24 Nov 2011 21:45:51 -0300

Added raise (from r7rs) to the ground environment.

Diffstat:
M
src/kgerrors.c
 | 
18
++++++++++++++++--
M
src/krepl.c
 | 
2
+-

2 files changed, 17 insertions(+), 3 deletions(-)
diff --git a/src/kgerrors.c b/src/kgerrors.c
@@ -16,7 +16,7 @@
 #include "kghelpers.h"
 #include "kgerrors.h"
 
-void r7rs_error(klisp_State *K)
+void kgerror(klisp_State *K)
 {
     TValue *xparams = K->next_xparams;
     TValue ptree = K->next_value;
@@ -34,6 +34,19 @@ void r7rs_error(klisp_State *K)
     klispE_throw_with_irritants(K, kstring_buf(str), irritants);
 }
 
+void kgraise(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_1p(K, ptree, obj);
+    kcall_cont(K, K->error_cont, obj);
+}
+
 void error_object_message(klisp_State *K)
 {
     TValue *xparams = K->next_xparams;
@@ -90,7 +103,8 @@ void kinit_error_ground_env(klisp_State *K)
     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", kgerror, 0);
+    add_applicative(K, ground_env, "raise", kgraise, 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);
 
diff --git a/src/krepl.c b/src/krepl.c
@@ -237,7 +237,7 @@ void do_int_repl_error(klisp_State *K)
 	krooted_tvs_pop(K);
     } else {
 	fprintf(stderr, "\n*ERROR*: not an error object passed to " 
-		"error continuation");
+		"error continuation\n\n");
     }
 
     UNUSED(divert);