From c0b9a213c9daa74047ecdffdf01f4e1a7069dbd0 Mon Sep 17 00:00:00 2001
From: Alex Shinn <ashinn@users.noreply.github.com>
Date: Tue, 11 Nov 2014 22:28:12 +0900
Subject: [PATCH] Adding sexp_apply_no_err_handler utility and using in
 simplifier.

---
 include/chibi/sexp.h |  1 +
 simplify.c           |  2 +-
 vm.c                 | 21 +++++++++++++++++++++
 3 files changed, 23 insertions(+), 1 deletion(-)

diff --git a/include/chibi/sexp.h b/include/chibi/sexp.h
index c18e9de5..b5713356 100755
--- a/include/chibi/sexp.h
+++ b/include/chibi/sexp.h
@@ -1420,6 +1420,7 @@ SEXP_API sexp sexp_stack_trace_op (sexp ctx, sexp self, sexp_sint_t n, sexp out)
 SEXP_API sexp sexp_apply (sexp context, sexp proc, sexp args);
 SEXP_API sexp sexp_apply1 (sexp ctx, sexp f, sexp x);
 SEXP_API sexp sexp_apply2 (sexp ctx, sexp f, sexp x, sexp y);
+SEXP_API sexp sexp_apply_no_err_handler (sexp ctx, sexp proc, sexp args);
 SEXP_API sexp sexp_make_trampoline (sexp ctx, sexp proc, sexp args);
 SEXP_API sexp sexp_make_foreign (sexp ctx, const char *name, int num_args, int flags, sexp_proc1 f, sexp data);
 SEXP_API void sexp_init(void);
diff --git a/simplify.c b/simplify.c
index 4a11e8e8..c30d3a4b 100644
--- a/simplify.c
+++ b/simplify.c
@@ -51,7 +51,7 @@ static sexp simplify (sexp ctx, sexp ast, sexp init_substs, sexp lambda) {
             tmp = sexp_make_vector(ctx2, 0, SEXP_VOID);
             tmp = sexp_make_procedure(ctx2, SEXP_ZERO, SEXP_ZERO, res, tmp);
             if (! sexp_exceptionp(tmp)) {
-              tmp = sexp_apply(ctx2, tmp, SEXP_NULL);
+              tmp = sexp_apply_no_err_handler(ctx2, tmp, SEXP_NULL);
               if (! sexp_exceptionp(tmp))
                 app = sexp_make_lit(ctx2, tmp);
             }
diff --git a/vm.c b/vm.c
index f3e3d103..61b1ea04 100644
--- a/vm.c
+++ b/vm.c
@@ -2136,4 +2136,25 @@ sexp sexp_apply2 (sexp ctx, sexp f, sexp x, sexp y) {
   return res;
 }
 
+sexp sexp_apply_no_err_handler (sexp ctx, sexp proc, sexp args) {
+  sexp res, err_cell;
+  sexp_gc_var2(handler, params);
+  sexp_gc_preserve2(ctx, handler, params);
+#if SEXP_USE_GREEN_THREADS
+  params = sexp_context_params(ctx);
+  sexp_context_params(ctx) = SEXP_NULL;
+#endif
+  err_cell = sexp_global(ctx, SEXP_G_ERR_HANDLER);
+  err_cell = sexp_opcodep(err_cell) ? sexp_opcode_data(err_cell) : SEXP_FALSE;
+  handler = sexp_pairp(err_cell) ? sexp_cdr(err_cell) : SEXP_FALSE;
+  if (sexp_pairp(err_cell)) sexp_cdr(err_cell) = SEXP_FALSE;
+  res = sexp_apply(ctx, proc, args);
+  if (sexp_pairp(err_cell)) sexp_cdr(err_cell) = handler;
+#if SEXP_USE_GREEN_THREADS
+  sexp_context_params(ctx) = params;
+#endif
+  sexp_gc_release2(ctx);
+  return res;
+}
+
 #endif