← Back to branch summary

~ubuntu-branches/ubuntu/hardy/uim/hardy

« back to all changes in this revision

Viewing changes to sigscheme/src/module-srfi34.c

  • Committer: Bazaar Package Importer
  • Author(s): Masahito Omote
  • Date: 2007-04-21 03:46:09 UTC
  • mfrom: (1.1.6 upstream)
  • Revision ID: james.westby@ubuntu.com-20070421034609-gpcurkutp8vaysqj
Tags: 1:1.4.1-3
* Switch to dh_gtkmodules for the gtk 2.10 transition (Closes:
  #419318)
  - debian/control: Add ${misc:Depends} and remove libgtk2.0-bin on
    uim-gtk2.0.
  - debian/uim-gtk2.0.post{inst,rm}: Removed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
sigscheme/src/module-srfi34.c
 
1
/*===========================================================================
 
2
 *  Filename : module-srfi34.c
 
3
 *  About    : SRFI-34 Exception Handling for Programs
 
4
 *
 
5
 *  Copyright (C) 2005-2006 YAMAMOTO Kengo <yamaken AT bp.iij4u.or.jp>
 
6
 *  Copyright (c) 2007 SigScheme Project <uim AT freedesktop.org>
 
7
 *
 
8
 *  All rights reserved.
 
9
 *
 
10
 *  Redistribution and use in source and binary forms, with or without
 
11
 *  modification, are permitted provided that the following conditions
 
12
 *  are met:
 
13
 *
 
14
 *  1. Redistributions of source code must retain the above copyright
 
15
 *     notice, this list of conditions and the following disclaimer.
 
16
 *  2. Redistributions in binary form must reproduce the above copyright
 
17
 *     notice, this list of conditions and the following disclaimer in the
 
18
 *     documentation and/or other materials provided with the distribution.
 
19
 *  3. Neither the name of authors nor the names of its contributors
 
20
 *     may be used to endorse or promote products derived from this software
 
21
 *     without specific prior written permission.
 
22
 *
 
23
 *  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
 
24
 *  IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
 
25
 *  THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
 
26
 *  PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
 
27
 *  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
 
28
 *  EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
 
29
 *  PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
 
30
 *  OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
 
31
 *  WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
 
32
 *  OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
 
33
 *  ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
34
===========================================================================*/
 
35
 
 
36
/*
 
37
 * This file implements C-version of the reference implementation written in
 
38
 * the SRFI-34 specification. All parts are written in C since:
 
39
 *
 
40
 * - SigScheme's hygienic-macros feature is not efficient yet
 
41
 *
 
42
 * - To avoid namespace pollution (with-exception-handlers, guard-aux, etc),
 
43
 *   since SigScheme doesn't have a module or namespace feature (yet)
 
44
 */
 
45
 
 
46
#include <config.h>
 
47
 
 
48
#include "sigscheme.h"
 
49
#include "sigschemeinternal.h"
 
50
 
 
51
/*=======================================
 
52
  File Local Macro Definitions
 
53
=======================================*/
 
54
#define USE_WITH_SIGSCHEME_FATAL_ERROR 1
 
55
 
 
56
#define ERRMSG_HANDLER_RETURNED    "handler returned"
 
57
#define ERRMSG_FALLBACK_EXHAUSTED  "fallback handler exhausted"
 
58
 
 
59
#define DECLARE_PRIVATE_FUNCTION(func_name, type)                            \
 
60
    DECLARE_INTERNAL_FUNCTION(func_name)
 
61
 
 
62
/*=======================================
 
63
  File Local Type Definitions
 
64
=======================================*/
 
65
 
 
66
/*=======================================
 
67
  Variable Definitions
 
68
=======================================*/
 
69
#include "functable-srfi34.c"
 
70
 
 
71
#define N_GLOBAL_SCMOBJ                                                      \
 
72
    (sizeof(SCM_GLOBAL_VARS_INSTANCE(static_srfi34)) / sizeof(ScmObj *))
 
73
 
 
74
/* NOTE: ScmObjs must be aligned to be scanned and protected */
 
75
SCM_GLOBAL_VARS_BEGIN(static_srfi34);
 
76
#define static
 
77
static ScmObj l_current_exception_handlers;
 
78
 
 
79
/* error messages */
 
80
static ScmObj l_errmsg_unhandled_exception, l_errmsg_handler_returned;
 
81
static ScmObj l_errmsg_fallback_exhausted;
 
82
 
 
83
/* symbols */
 
84
static ScmObj l_sym_error, l_sym_raise;
 
85
static ScmObj l_sym_lex_env, l_sym_cond_catch, l_sym_body;
 
86
static ScmObj l_sym_condition, l_sym_guard_k, l_sym_handler_k;
 
87
 
 
88
/* procedures and syntaxes */
 
89
static ScmObj l_syn_raw_quote, l_syn_apply, l_proc_values;
 
90
static ScmObj l_syn_set_cur_handlers, l_proc_fallback_handler;
 
91
static ScmObj l_proc_with_exception_handlers;
 
92
static ScmObj l_syn_guard_internal, l_syn_guard_handler, l_syn_guard_handler_body;
 
93
static ScmObj l_syn_guard_body;
 
94
#undef static
 
95
SCM_GLOBAL_VARS_END(static_srfi34);
 
96
#define l_current_exception_handlers                                         \
 
97
    SCM_GLOBAL_VAR(static_srfi34, l_current_exception_handlers)
 
98
#define l_errmsg_unhandled_exception                                         \
 
99
    SCM_GLOBAL_VAR(static_srfi34, l_errmsg_unhandled_exception)
 
100
#define l_errmsg_handler_returned                                            \
 
101
    SCM_GLOBAL_VAR(static_srfi34, l_errmsg_handler_returned)
 
102
#define l_errmsg_fallback_exhausted                                          \
 
103
    SCM_GLOBAL_VAR(static_srfi34, l_errmsg_fallback_exhausted)
 
104
#define l_sym_error             SCM_GLOBAL_VAR(static_srfi34, l_sym_error)
 
105
#define l_sym_raise             SCM_GLOBAL_VAR(static_srfi34, l_sym_raise)
 
106
#define l_sym_lex_env           SCM_GLOBAL_VAR(static_srfi34, l_sym_lex_env)
 
107
#define l_sym_cond_catch        SCM_GLOBAL_VAR(static_srfi34, l_sym_cond_catch)
 
108
#define l_sym_body              SCM_GLOBAL_VAR(static_srfi34, l_sym_body)
 
109
#define l_sym_condition         SCM_GLOBAL_VAR(static_srfi34, l_sym_condition)
 
110
#define l_sym_guard_k           SCM_GLOBAL_VAR(static_srfi34, l_sym_guard_k)
 
111
#define l_sym_handler_k         SCM_GLOBAL_VAR(static_srfi34, l_sym_handler_k)
 
112
#define l_syn_raw_quote         SCM_GLOBAL_VAR(static_srfi34, l_syn_raw_quote)
 
113
#define l_syn_apply             SCM_GLOBAL_VAR(static_srfi34, l_syn_apply)
 
114
#define l_proc_values           SCM_GLOBAL_VAR(static_srfi34, l_proc_values)
 
115
#define l_syn_set_cur_handlers                                               \
 
116
    SCM_GLOBAL_VAR(static_srfi34, l_syn_set_cur_handlers)
 
117
#define l_proc_fallback_handler                                              \
 
118
    SCM_GLOBAL_VAR(static_srfi34, l_proc_fallback_handler)
 
119
#define l_proc_with_exception_handlers                                       \
 
120
    SCM_GLOBAL_VAR(static_srfi34, l_proc_with_exception_handlers)
 
121
#define l_syn_guard_internal                                                 \
 
122
    SCM_GLOBAL_VAR(static_srfi34, l_syn_guard_internal)
 
123
#define l_syn_guard_handler                                                  \
 
124
    SCM_GLOBAL_VAR(static_srfi34, l_syn_guard_handler)
 
125
#define l_syn_guard_handler_body                                             \
 
126
    SCM_GLOBAL_VAR(static_srfi34, l_syn_guard_handler_body)
 
127
#define l_syn_guard_body        SCM_GLOBAL_VAR(static_srfi34, l_syn_guard_body)
 
128
SCM_DEFINE_STATIC_VARS(static_srfi34);
 
129
 
 
130
/*=======================================
 
131
  File Local Function Declarations
 
132
=======================================*/
 
133
static ScmObj raw_quote(ScmObj datum, ScmObj env);
 
134
static ScmObj enclose(ScmObj exp, ScmObj env);
 
135
static ScmObj set_cur_handlers(ScmObj handlers, ScmObj env);
 
136
static ScmObj with_exception_handlers(ScmObj new_handlers, ScmObj thunk);
 
137
static ScmObj guard_internal(ScmObj q_guard_k, ScmObj env);
 
138
static ScmObj guard_handler(ScmObj q_condition, ScmEvalState *eval_state);
 
139
static ScmObj delay(ScmObj evaled_obj, ScmObj env);
 
140
static ScmObj guard_handler_body(ScmObj q_handler_k, ScmObj env);
 
141
static ScmObj guard_body(ScmEvalState *eval_state);
 
142
 
 
143
/*=======================================
 
144
  Function Definitions
 
145
=======================================*/
 
146
SCM_EXPORT void
 
147
scm_initialize_srfi34(void)
 
148
{
 
149
    ScmObj *vars, *var;
 
150
 
 
151
    SCM_GLOBAL_VARS_INIT(static_srfi34);
 
152
 
 
153
    scm_use("srfi-23");
 
154
 
 
155
    /* protect global variables: assumes that all ScmObj of the global vars
 
156
     * instance is aligned */
 
157
    for (vars = var = (ScmObj *)&SCM_GLOBAL_VARS_INSTANCE(static_srfi34);
 
158
         var < &vars[N_GLOBAL_SCMOBJ];
 
159
         var++)
 
160
    {
 
161
        scm_gc_protect_with_init(var, SCM_UNDEF);
 
162
    }
 
163
 
 
164
    l_errmsg_unhandled_exception = CONST_STRING(ERRMSG_UNHANDLED_EXCEPTION);
 
165
    l_errmsg_handler_returned    = CONST_STRING(ERRMSG_HANDLER_RETURNED);
 
166
    l_errmsg_fallback_exhausted  = CONST_STRING(ERRMSG_FALLBACK_EXHAUSTED);
 
167
 
 
168
    l_sym_error      = scm_intern("error");
 
169
    l_sym_raise      = scm_intern("raise");
 
170
 
 
171
    l_sym_lex_env    = scm_intern("lex-env");
 
172
    l_sym_cond_catch = scm_intern("cond-catch");
 
173
    l_sym_body       = scm_intern("body");
 
174
    l_sym_condition  = scm_intern("condition");
 
175
    l_sym_guard_k    = scm_intern("guard-k");
 
176
    l_sym_handler_k  = scm_intern("handler-k");
 
177
 
 
178
    /* prepare procedures and syntaxes */
 
179
    l_syn_apply
 
180
        = scm_symbol_value(scm_intern("apply"),  SCM_INTERACTION_ENV);
 
181
    l_proc_values
 
182
        = scm_symbol_value(scm_intern("values"), SCM_INTERACTION_ENV);
 
183
 
 
184
    SCM_ASSERT_FUNCTYPE(scm_syntax_fixed_1,         &raw_quote);
 
185
    SCM_ASSERT_FUNCTYPE(scm_syntax_fixed_1,         &set_cur_handlers);
 
186
    SCM_ASSERT_FUNCTYPE(scm_procedure_fixed_2,      &with_exception_handlers);
 
187
    SCM_ASSERT_FUNCTYPE(scm_syntax_fixed_1,         &guard_internal);
 
188
    SCM_ASSERT_FUNCTYPE(scm_syntax_fixed_tailrec_1, &guard_handler);
 
189
    SCM_ASSERT_FUNCTYPE(scm_syntax_fixed_1,         &guard_handler_body);
 
190
    SCM_ASSERT_FUNCTYPE(scm_syntax_fixed_tailrec_0, &guard_body);
 
191
 
 
192
    l_syn_raw_quote
 
193
        = MAKE_FUNC(SCM_SYNTAX_FIXED_1,         &raw_quote);
 
194
    l_syn_set_cur_handlers
 
195
        = MAKE_FUNC(SCM_SYNTAX_FIXED_1,         &set_cur_handlers);
 
196
    l_proc_with_exception_handlers
 
197
        = MAKE_FUNC(SCM_PROCEDURE_FIXED_2,      &with_exception_handlers);
 
198
    l_syn_guard_internal
 
199
        = MAKE_FUNC(SCM_SYNTAX_FIXED_1,         &guard_internal);
 
200
    l_syn_guard_handler
 
201
        = MAKE_FUNC(SCM_SYNTAX_FIXED_TAILREC_1, &guard_handler);
 
202
    l_syn_guard_handler_body
 
203
        = MAKE_FUNC(SCM_SYNTAX_FIXED_1,         &guard_handler_body);
 
204
    l_syn_guard_body
 
205
        = MAKE_FUNC(SCM_SYNTAX_FIXED_TAILREC_0, &guard_body);
 
206
 
 
207
    /*
 
208
     * The 'error' procedure should not be invoked directly by
 
209
     * scm_p_srfi23_error(), to allow dynamic redifinition, and keep SRFI-23
 
210
     * implementation abstract.
 
211
     */
 
212
#if USE_WITH_SIGSCHEME_FATAL_ERROR
 
213
    l_proc_fallback_handler
 
214
        = scm_s_lambda(LIST_1(l_sym_condition),
 
215
                       LIST_1(LIST_4(scm_intern("if"),
 
216
                                     LIST_2(scm_intern("%%error-object?"),
 
217
                                            l_sym_condition),
 
218
                                     LIST_2(scm_intern("%%fatal-error"),
 
219
                                            l_sym_condition),
 
220
                                     LIST_3(l_sym_error,
 
221
                                            l_errmsg_unhandled_exception,
 
222
                                            l_sym_condition))),
 
223
                       SCM_INTERACTION_ENV);
 
224
#else /* USE_WITH_SIGSCHEME_FATAL_ERROR */
 
225
    l_proc_fallback_handler
 
226
        = scm_s_lambda(LIST_1(l_sym_condition),
 
227
                       LIST_1(LIST_3(l_sym_error,
 
228
                                     l_errmsg_unhandled_exception,
 
229
                                     l_sym_condition)),
 
230
                       SCM_INTERACTION_ENV);
 
231
#endif /* USE_WITH_SIGSCHEME_FATAL_ERROR */
 
232
 
 
233
    scm_register_funcs(scm_functable_srfi34);
 
234
 
 
235
    l_current_exception_handlers = LIST_1(l_proc_fallback_handler);
 
236
}
 
237
 
 
238
/* to avoid unwanted unwrap-syntax application by ordinary quote */
 
239
static ScmObj
 
240
raw_quote(ScmObj datum, ScmObj env)
 
241
{
 
242
    DECLARE_PRIVATE_FUNCTION("raw_quote", syntax_fixed_1);
 
243
 
 
244
    return datum;
 
245
}
 
246
 
 
247
static ScmObj
 
248
enclose(ScmObj exp, ScmObj env)
 
249
{
 
250
    return scm_s_lambda(SCM_NULL, LIST_1(exp), env);
 
251
}
 
252
 
 
253
static ScmObj
 
254
set_cur_handlers(ScmObj handlers, ScmObj env)
 
255
{
 
256
    DECLARE_PRIVATE_FUNCTION("with_exception_handlers", syntax_fixed_1);
 
257
 
 
258
    l_current_exception_handlers = handlers;
 
259
    return SCM_UNDEF;
 
260
}
 
261
 
 
262
static ScmObj
 
263
with_exception_handlers(ScmObj new_handlers, ScmObj thunk)
 
264
{
 
265
    ScmObj prev_handlers, before, after;
 
266
    DECLARE_PRIVATE_FUNCTION("with_exception_handlers", procedure_fixed_2);
 
267
 
 
268
    prev_handlers = l_current_exception_handlers;
 
269
    before = scm_s_lambda(SCM_NULL,
 
270
                          LIST_1(LIST_2(l_syn_set_cur_handlers, new_handlers)),
 
271
                          SCM_INTERACTION_ENV);
 
272
    after = scm_s_lambda(SCM_NULL,
 
273
                         LIST_1(LIST_2(l_syn_set_cur_handlers, prev_handlers)),
 
274
                         SCM_INTERACTION_ENV);
 
275
    return scm_dynamic_wind(before, thunk, after);
 
276
}
 
277
 
 
278
/* with-exception-handler */
 
279
 
 
280
SCM_EXPORT ScmObj
 
281
scm_p_srfi34_with_exception_handler(ScmObj handler, ScmObj thunk)
 
282
{
 
283
    ScmObj handlers;
 
284
    DECLARE_FUNCTION("with-exception-handler", procedure_fixed_2);
 
285
 
 
286
    ENSURE_PROCEDURE(handler);
 
287
    ENSURE_PROCEDURE(thunk);
 
288
 
 
289
    handlers = CONS(handler, l_current_exception_handlers);
 
290
    return with_exception_handlers(handlers, thunk);
 
291
}
 
292
 
 
293
/* raise */
 
294
 
 
295
SCM_EXPORT ScmObj
 
296
scm_p_srfi34_raise(ScmObj obj)
 
297
{
 
298
    ScmObj handler, rest_handlers, thunk, err_obj;
 
299
    DECLARE_FUNCTION("raise", procedure_fixed_1);
 
300
 
 
301
    if (NULLP(l_current_exception_handlers)) {
 
302
        if (ERROBJP(obj))
 
303
            err_obj = obj;
 
304
        else
 
305
            err_obj
 
306
                = scm_make_error_obj(l_errmsg_fallback_exhausted, LIST_1(obj));
 
307
        scm_p_fatal_error(err_obj);
 
308
        /* NOTREACHED */
 
309
    }
 
310
 
 
311
    handler = CAR(l_current_exception_handlers);
 
312
    rest_handlers = CDR(l_current_exception_handlers);
 
313
    obj = LIST_2(SYM_QUOTE, obj);
 
314
    thunk = scm_s_lambda(SCM_NULL,
 
315
                         LIST_2(LIST_2(handler, obj),
 
316
                                LIST_4(l_sym_error,
 
317
                                       l_errmsg_handler_returned,
 
318
                                       handler, obj)),
 
319
                         SCM_INTERACTION_ENV);
 
320
    return with_exception_handlers(rest_handlers, thunk);
 
321
}
 
322
 
 
323
/* guard */
 
324
 
 
325
SCM_EXPORT ScmObj
 
326
scm_s_srfi34_guard(ScmObj cond_catch, ScmObj body, ScmEvalState *eval_state)
 
327
{
 
328
    ScmObj lex_env, proc_guard_int, ret;
 
329
    DECLARE_FUNCTION("guard", syntax_variadic_tailrec_1);
 
330
 
 
331
    ENSURE_CONS(cond_catch);
 
332
    ENSURE_CONS(body);
 
333
 
 
334
    lex_env = eval_state->env;
 
335
    eval_state->env
 
336
        = scm_extend_environment(LIST_3(l_sym_lex_env, l_sym_cond_catch, l_sym_body),
 
337
                                 LIST_3(lex_env, cond_catch, body),
 
338
                                 lex_env);
 
339
    proc_guard_int = scm_s_lambda(LIST_1(l_sym_guard_k),
 
340
                                  LIST_1(LIST_2(l_syn_guard_internal, l_sym_guard_k)),
 
341
                                  eval_state->env);
 
342
 
 
343
    ret = scm_call_with_current_continuation(proc_guard_int, eval_state);
 
344
    eval_state->env      = lex_env;
 
345
    eval_state->ret_type = SCM_VALTYPE_AS_IS;
 
346
    return scm_call(ret, SCM_NULL);
 
347
}
 
348
 
 
349
static ScmObj
 
350
guard_internal(ScmObj q_guard_k, ScmObj env)
 
351
{
 
352
    ScmObj handler, body;
 
353
    DECLARE_PRIVATE_FUNCTION("guard", syntax_fixed_1);
 
354
 
 
355
    handler = scm_s_lambda(LIST_1(l_sym_condition),
 
356
                           LIST_1(LIST_2(l_syn_guard_handler, l_sym_condition)),
 
357
                           env);
 
358
    body = scm_s_lambda(SCM_NULL,
 
359
                        LIST_1(LIST_1(l_syn_guard_body)),
 
360
                        env);
 
361
 
 
362
    return scm_p_srfi34_with_exception_handler(handler, body);
 
363
}
 
364
 
 
365
static ScmObj
 
366
guard_handler(ScmObj q_condition, ScmEvalState *eval_state)
 
367
{
 
368
    ScmObj handler_body, ret;
 
369
    DECLARE_PRIVATE_FUNCTION("guard", syntax_fixed_tailrec_1);
 
370
 
 
371
    handler_body
 
372
        = scm_s_lambda(LIST_1(l_sym_handler_k),
 
373
                       LIST_1(LIST_2(l_syn_guard_handler_body, l_sym_handler_k)),
 
374
                       eval_state->env);
 
375
    ret = scm_call_with_current_continuation(handler_body, eval_state);
 
376
    ret = SCM_FINISH_TAILREC_CALL(ret, eval_state);
 
377
    return scm_call(ret, SCM_NULL);
 
378
}
 
379
 
 
380
static ScmObj
 
381
delay(ScmObj evaled_obj, ScmObj env)
 
382
{
 
383
    ScmObj vals;
 
384
 
 
385
    if (VALUEPACKETP(evaled_obj)) {
 
386
        vals = SCM_VALUEPACKET_VALUES(evaled_obj);
 
387
        return enclose(LIST_3(l_syn_apply,
 
388
                              l_proc_values,
 
389
                              LIST_2(l_syn_raw_quote, vals)),
 
390
                       env);
 
391
    } else {
 
392
        return enclose(LIST_2(l_syn_raw_quote, evaled_obj), env);
 
393
    }
 
394
}
 
395
 
 
396
static ScmObj
 
397
guard_handler_body(ScmObj q_handler_k, ScmObj env)
 
398
{
 
399
    ScmEvalState eval_state;
 
400
    ScmObj lex_env, cond_env, condition, cond_catch, guard_k, handler_k;
 
401
    ScmObj sym_var, clauses, caught, reraise;
 
402
    DECLARE_PRIVATE_FUNCTION("guard", syntax_fixed_1);
 
403
 
 
404
    lex_env    = scm_symbol_value(l_sym_lex_env, env);
 
405
    condition  = scm_symbol_value(l_sym_condition, env);
 
406
    cond_catch = scm_symbol_value(l_sym_cond_catch, env);
 
407
    guard_k    = scm_symbol_value(l_sym_guard_k, env);
 
408
    handler_k  = EVAL(q_handler_k, env);
 
409
 
 
410
    /* eval cond-catch block */
 
411
    sym_var = CAR(cond_catch);
 
412
    clauses = CDR(cond_catch);
 
413
    ENSURE_SYMBOL(sym_var);
 
414
    cond_env
 
415
        = scm_extend_environment(LIST_1(sym_var), LIST_1(condition), lex_env);
 
416
    SCM_EVAL_STATE_INIT1(eval_state, cond_env);
 
417
    caught = scm_s_cond_internal(clauses, &eval_state);
 
418
 
 
419
    if (VALIDP(caught)) {
 
420
        if (eval_state.ret_type == SCM_VALTYPE_NEED_EVAL)
 
421
            caught = EVAL(caught, cond_env);
 
422
        scm_call_continuation(guard_k, delay(caught, cond_env));
 
423
    } else {
 
424
        reraise = enclose(LIST_2(l_sym_raise, LIST_2(SYM_QUOTE, condition)),
 
425
                          cond_env);
 
426
        scm_call_continuation(handler_k, reraise);
 
427
    }
 
428
    /* NOTREACHED */
 
429
    return SCM_UNDEF;
 
430
}
 
431
 
 
432
static ScmObj
 
433
guard_body(ScmEvalState *eval_state)
 
434
{
 
435
    ScmEvalState lex_eval_state;
 
436
    ScmObj lex_env, guard_k, body, result;
 
437
    DECLARE_PRIVATE_FUNCTION("guard", syntax_fixed_tailrec_0);
 
438
 
 
439
    lex_env = scm_symbol_value(l_sym_lex_env, eval_state->env);
 
440
    guard_k = scm_symbol_value(l_sym_guard_k, eval_state->env);
 
441
    body    = scm_symbol_value(l_sym_body,    eval_state->env);
 
442
 
 
443
    /* evaluate the body */
 
444
    SCM_EVAL_STATE_INIT1(lex_eval_state, lex_env);
 
445
    result = scm_s_body(body, &lex_eval_state);
 
446
    result = SCM_FINISH_TAILREC_CALL(result, &lex_eval_state);
 
447
 
 
448
    scm_call_continuation(guard_k, delay(result, lex_env));
 
449
    /* NOTREACHED */
 
450
    return SCM_UNDEF;
 
451
}