[uim-commit] r1580 - in branches/r5rs: sigscheme sigscheme/test uim
yamaken at freedesktop.org
yamaken at freedesktop.org
Sun Sep 25 04:43:54 PDT 2005
Author: yamaken
Date: 2005-09-25 04:43:52 -0700 (Sun, 25 Sep 2005)
New Revision: 1580
Modified:
branches/r5rs/sigscheme/debug.c
branches/r5rs/sigscheme/eval.c
branches/r5rs/sigscheme/io.c
branches/r5rs/sigscheme/operations-srfi8.c
branches/r5rs/sigscheme/operations.c
branches/r5rs/sigscheme/runtest.sh
branches/r5rs/sigscheme/sigscheme.c
branches/r5rs/sigscheme/sigscheme.h
branches/r5rs/sigscheme/sigschemetype.h
branches/r5rs/sigscheme/test/test-exp.scm
branches/r5rs/sigscheme/test/unittest.scm
branches/r5rs/uim/uim-scm.c
Log:
* This commit applies Jun Inoue's grand FUNCTYPE reorganization II
patches posted in [Anthy-dev 2398] and [Anthy-dev 2432]. Thank you
for the great work! No other changes except configuration macros are
applied
* sigscheme/sigschemetype.h
- (struct ScmEvalState_, ScmEvalState): New type
- (enum ScmReductionState): New enum
- (enum ScmFuncTypeCode): Reorganize for the new procedure calling
interface
- (struct ScmObjInternal_, SCM_FUNC_CFUNC,
ScmFuncTypeRawListTailRec, ScmFuncTypeRawListWithTailFlag): Follow
the new procedure calling interface
* sigscheme/sigscheme.h
- (SCM_VOLATILE_OUTPUT): New macro
- (Scm_call): New function decl
- (ScmOp_apply, ScmOp_quote, ScmExp_if, ScmExp_set, ScmExp_cond,
ScmExp_case, ScmExp_and, ScmExp_or, ScmExp_let, ScmExp_let_star,
ScmExp_letrec, ScmExp_begin, ScmExp_do, ScmExp_define, ScmOp_add,
ScmOp_multiply, ScmOp_subtract, ScmOp_divide, ScmOp_equal,
ScmOp_less, ScmOp_greater, ScmOp_less_eq, ScmOp_greater_eq,
ScmOp_max, ScmOp_min, ScmOp_call_with_values,
ScmOp_SRFI8_receive): Follow the new procedure calling interface
- (ScmOp_delay, ScmOp_quasiquote, ScmOp_unquote,
ScmOp_unquote_splicing): Change argument names
- (Scm_RegisterReductionOperator, Scm_RegisterSyntaxFixed0,
Scm_RegisterSyntaxFixed1, Scm_RegisterSyntaxFixed2,
Scm_RegisterSyntaxFixed3, Scm_RegisterSyntaxFixed4,
Scm_RegisterSyntaxFixed5, Scm_RegisterSyntaxFixed6,
Scm_RegisterSyntaxFixed7, Scm_RegisterSyntaxFixed8,
Scm_RegisterSyntaxFixed9, Scm_RegisterSyntaxFixed10,
Scm_RegisterSyntaxFixed11, Scm_RegisterSyntaxFixed12,
Scm_RegisterSyntaxFixed13, Scm_RegisterSyntaxFixed14,
Scm_RegisterSyntaxFixed15, Scm_RegisterSyntaxFixedTailRec0,
Scm_RegisterSyntaxFixedTailRec1, Scm_RegisterSyntaxFixedTailRec2,
Scm_RegisterSyntaxFixedTailRec3, Scm_RegisterSyntaxFixedTailRec4,
Scm_RegisterSyntaxFixedTailRec5, Scm_RegisterSyntaxFixedTailRec6,
Scm_RegisterSyntaxFixedTailRec7, Scm_RegisterSyntaxFixedTailRec8,
Scm_RegisterSyntaxFixedTailRec9, Scm_RegisterSyntaxFixedTailRec10,
Scm_RegisterSyntaxFixedTailRec11,
Scm_RegisterSyntaxFixedTailRec12,
Scm_RegisterSyntaxFixedTailRec13,
Scm_RegisterSyntaxFixedTailRec14,
Scm_RegisterSyntaxFixedTailRec15, Scm_RegisterSyntaxVariadic0,
Scm_RegisterSyntaxVariadic1, Scm_RegisterSyntaxVariadic2,
Scm_RegisterSyntaxVariadic3, Scm_RegisterSyntaxVariadic4,
Scm_RegisterSyntaxVariadic5, Scm_RegisterSyntaxVariadic6,
Scm_RegisterSyntaxVariadic7, Scm_RegisterSyntaxVariadic8,
Scm_RegisterSyntaxVariadic9, Scm_RegisterSyntaxVariadic10,
Scm_RegisterSyntaxVariadic11, Scm_RegisterSyntaxVariadic12,
Scm_RegisterSyntaxVariadic13, Scm_RegisterSyntaxVariadic14,
Scm_RegisterSyntaxVariadic15, Scm_RegisterSyntaxVariadicTailRec0,
Scm_RegisterSyntaxVariadicTailRec1,
Scm_RegisterSyntaxVariadicTailRec2,
Scm_RegisterSyntaxVariadicTailRec3,
Scm_RegisterSyntaxVariadicTailRec4,
Scm_RegisterSyntaxVariadicTailRec5,
Scm_RegisterSyntaxVariadicTailRec6,
Scm_RegisterSyntaxVariadicTailRec7,
Scm_RegisterSyntaxVariadicTailRec8,
Scm_RegisterSyntaxVariadicTailRec9,
Scm_RegisterSyntaxVariadicTailRec10,
Scm_RegisterSyntaxVariadicTailRec11,
Scm_RegisterSyntaxVariadicTailRec12,
Scm_RegisterSyntaxVariadicTailRec13,
Scm_RegisterSyntaxVariadicTailRec14,
Scm_RegisterSyntaxVariadicTailRec15, Scm_RegisterProcedureFixed0,
Scm_RegisterProcedureFixed1, Scm_RegisterProcedureFixed2,
Scm_RegisterProcedureFixed3, Scm_RegisterProcedureFixed4,
Scm_RegisterProcedureFixed5, Scm_RegisterProcedureFixed6,
Scm_RegisterProcedureFixed7, Scm_RegisterProcedureFixed8,
Scm_RegisterProcedureFixed9, Scm_RegisterProcedureFixed10,
Scm_RegisterProcedureFixed11, Scm_RegisterProcedureFixed12,
Scm_RegisterProcedureFixed13, Scm_RegisterProcedureFixed14,
Scm_RegisterProcedureFixed15, Scm_RegisterProcedureFixedTailRec0,
Scm_RegisterProcedureFixedTailRec1,
Scm_RegisterProcedureFixedTailRec2,
Scm_RegisterProcedureFixedTailRec3,
Scm_RegisterProcedureFixedTailRec4,
Scm_RegisterProcedureFixedTailRec5,
Scm_RegisterProcedureFixedTailRec6,
Scm_RegisterProcedureFixedTailRec7,
Scm_RegisterProcedureFixedTailRec8,
Scm_RegisterProcedureFixedTailRec9,
Scm_RegisterProcedureFixedTailRec10,
Scm_RegisterProcedureFixedTailRec11,
Scm_RegisterProcedureFixedTailRec12,
Scm_RegisterProcedureFixedTailRec13,
Scm_RegisterProcedureFixedTailRec14,
Scm_RegisterProcedureFixedTailRec15,
Scm_RegisterProcedureVariadic0, Scm_RegisterProcedureVariadic1,
Scm_RegisterProcedureVariadic2, Scm_RegisterProcedureVariadic3,
Scm_RegisterProcedureVariadic4, Scm_RegisterProcedureVariadic5,
Scm_RegisterProcedureVariadic6, Scm_RegisterProcedureVariadic7,
Scm_RegisterProcedureVariadic8, Scm_RegisterProcedureVariadic9,
Scm_RegisterProcedureVariadic10, Scm_RegisterProcedureVariadic11,
Scm_RegisterProcedureVariadic12, Scm_RegisterProcedureVariadic13,
Scm_RegisterProcedureVariadic14, Scm_RegisterProcedureVariadic15,
Scm_RegisterProcedureVariadicTailRec0,
Scm_RegisterProcedureVariadicTailRec1,
Scm_RegisterProcedureVariadicTailRec2,
Scm_RegisterProcedureVariadicTailRec3,
Scm_RegisterProcedureVariadicTailRec4,
Scm_RegisterProcedureVariadicTailRec5,
Scm_RegisterProcedureVariadicTailRec6,
Scm_RegisterProcedureVariadicTailRec7,
Scm_RegisterProcedureVariadicTailRec8,
Scm_RegisterProcedureVariadicTailRec9,
Scm_RegisterProcedureVariadicTailRec10,
Scm_RegisterProcedureVariadicTailRec11,
Scm_RegisterProcedureVariadicTailRec12,
Scm_RegisterProcedureVariadicTailRec13,
Scm_RegisterProcedureVariadicTailRec14,
Scm_RegisterProcedureVariadicTailRec15): New function decl
* sigscheme/sigscheme.c
- (Scm_RegisterFunc): Change the interface
- (SigScm_Initialize_internal):
* Follow the new procedure calling interface
* Disable SIOD-compatible "=" temporarily
- (Scm_RegisterReductionOperator, Scm_RegisterSyntaxFixed0,
Scm_RegisterSyntaxFixed1, Scm_RegisterSyntaxFixed2,
Scm_RegisterSyntaxFixed3, Scm_RegisterSyntaxFixed4,
Scm_RegisterSyntaxFixed5, Scm_RegisterSyntaxFixed6,
Scm_RegisterSyntaxFixed7, Scm_RegisterSyntaxFixed8,
Scm_RegisterSyntaxFixed9, Scm_RegisterSyntaxFixed10,
Scm_RegisterSyntaxFixed11, Scm_RegisterSyntaxFixed12,
Scm_RegisterSyntaxFixed13, Scm_RegisterSyntaxFixed14,
Scm_RegisterSyntaxFixed15, Scm_RegisterSyntaxFixedTailRec0,
Scm_RegisterSyntaxFixedTailRec1, Scm_RegisterSyntaxFixedTailRec2,
Scm_RegisterSyntaxFixedTailRec3, Scm_RegisterSyntaxFixedTailRec4,
Scm_RegisterSyntaxFixedTailRec5, Scm_RegisterSyntaxFixedTailRec6,
Scm_RegisterSyntaxFixedTailRec7, Scm_RegisterSyntaxFixedTailRec8,
Scm_RegisterSyntaxFixedTailRec9, Scm_RegisterSyntaxFixedTailRec10,
Scm_RegisterSyntaxFixedTailRec11,
Scm_RegisterSyntaxFixedTailRec12,
Scm_RegisterSyntaxFixedTailRec13,
Scm_RegisterSyntaxFixedTailRec14,
Scm_RegisterSyntaxFixedTailRec15, Scm_RegisterSyntaxVariadic0,
Scm_RegisterSyntaxVariadic1, Scm_RegisterSyntaxVariadic2,
Scm_RegisterSyntaxVariadic3, Scm_RegisterSyntaxVariadic4,
Scm_RegisterSyntaxVariadic5, Scm_RegisterSyntaxVariadic6,
Scm_RegisterSyntaxVariadic7, Scm_RegisterSyntaxVariadic8,
Scm_RegisterSyntaxVariadic9, Scm_RegisterSyntaxVariadic10,
Scm_RegisterSyntaxVariadic11, Scm_RegisterSyntaxVariadic12,
Scm_RegisterSyntaxVariadic13, Scm_RegisterSyntaxVariadic14,
Scm_RegisterSyntaxVariadic15, Scm_RegisterSyntaxVariadicTailRec0,
Scm_RegisterSyntaxVariadicTailRec1,
Scm_RegisterSyntaxVariadicTailRec2,
Scm_RegisterSyntaxVariadicTailRec3,
Scm_RegisterSyntaxVariadicTailRec4,
Scm_RegisterSyntaxVariadicTailRec5,
Scm_RegisterSyntaxVariadicTailRec6,
Scm_RegisterSyntaxVariadicTailRec7,
Scm_RegisterSyntaxVariadicTailRec8,
Scm_RegisterSyntaxVariadicTailRec9,
Scm_RegisterSyntaxVariadicTailRec10,
Scm_RegisterSyntaxVariadicTailRec11,
Scm_RegisterSyntaxVariadicTailRec12,
Scm_RegisterSyntaxVariadicTailRec13,
Scm_RegisterSyntaxVariadicTailRec14,
Scm_RegisterSyntaxVariadicTailRec15, Scm_RegisterProcedureFixed0,
Scm_RegisterProcedureFixed1, Scm_RegisterProcedureFixed2,
Scm_RegisterProcedureFixed3, Scm_RegisterProcedureFixed4,
Scm_RegisterProcedureFixed5, Scm_RegisterProcedureFixed6,
Scm_RegisterProcedureFixed7, Scm_RegisterProcedureFixed8,
Scm_RegisterProcedureFixed9, Scm_RegisterProcedureFixed10,
Scm_RegisterProcedureFixed11, Scm_RegisterProcedureFixed12,
Scm_RegisterProcedureFixed13, Scm_RegisterProcedureFixed14,
Scm_RegisterProcedureFixed15, Scm_RegisterProcedureFixedTailRec0,
Scm_RegisterProcedureFixedTailRec1,
Scm_RegisterProcedureFixedTailRec2,
Scm_RegisterProcedureFixedTailRec3,
Scm_RegisterProcedureFixedTailRec4,
Scm_RegisterProcedureFixedTailRec5,
Scm_RegisterProcedureFixedTailRec6,
Scm_RegisterProcedureFixedTailRec7,
Scm_RegisterProcedureFixedTailRec8,
Scm_RegisterProcedureFixedTailRec9,
Scm_RegisterProcedureFixedTailRec10,
Scm_RegisterProcedureFixedTailRec11,
Scm_RegisterProcedureFixedTailRec12,
Scm_RegisterProcedureFixedTailRec13,
Scm_RegisterProcedureFixedTailRec14,
Scm_RegisterProcedureFixedTailRec15,
Scm_RegisterProcedureVariadic0, Scm_RegisterProcedureVariadic1,
Scm_RegisterProcedureVariadic2, Scm_RegisterProcedureVariadic3,
Scm_RegisterProcedureVariadic4, Scm_RegisterProcedureVariadic5,
Scm_RegisterProcedureVariadic6, Scm_RegisterProcedureVariadic7,
Scm_RegisterProcedureVariadic8, Scm_RegisterProcedureVariadic9,
Scm_RegisterProcedureVariadic10, Scm_RegisterProcedureVariadic11,
Scm_RegisterProcedureVariadic12, Scm_RegisterProcedureVariadic13,
Scm_RegisterProcedureVariadic14, Scm_RegisterProcedureVariadic15,
Scm_RegisterProcedureVariadicTailRec0,
Scm_RegisterProcedureVariadicTailRec1,
Scm_RegisterProcedureVariadicTailRec2,
Scm_RegisterProcedureVariadicTailRec3,
Scm_RegisterProcedureVariadicTailRec4,
Scm_RegisterProcedureVariadicTailRec5,
Scm_RegisterProcedureVariadicTailRec6,
Scm_RegisterProcedureVariadicTailRec7,
Scm_RegisterProcedureVariadicTailRec8,
Scm_RegisterProcedureVariadicTailRec9,
Scm_RegisterProcedureVariadicTailRec10,
Scm_RegisterProcedureVariadicTailRec11,
Scm_RegisterProcedureVariadicTailRec12,
Scm_RegisterProcedureVariadicTailRec13,
Scm_RegisterProcedureVariadicTailRec14,
Scm_RegisterProcedureVariadicTailRec15): New function
- (Scm_RegisterFunc0, Scm_RegisterFunc1, Scm_RegisterFunc2,
Scm_RegisterFunc3, Scm_RegisterFunc4, Scm_RegisterFunc5,
Scm_RegisterFuncEvaledList, Scm_RegisterFuncRawList,
Scm_RegisterFuncRawListTailRec,
Scm_RegisterFuncRawListWithTailFlag): Follow the change of
Scm_RegisterFunc()
* sigscheme/eval.c
- (reduce, call_closure, call): New static function
- (Scm_call): New function
- (ScmOp_eval, ScmOp_apply): Simplify with call()
- (ScmOp_quote, ScmExp_if, ScmExp_set, ScmExp_cond, ScmExp_case,
ScmExp_and, ScmExp_or, ScmExp_let, ScmExp_let_star, ScmExp_letrec,
ScmExp_begin, ScmExp_do, ScmOp_delay, ScmOp_quasiquote,
ScmOp_unquote, ScmOp_unquote_splicing, ScmExp_define): Follow the
new procedure calling interface
* sigscheme/operations.c
- (COMPARATOR_BODY): New macro
- (ScmOp_add, ScmOp_multiply, ScmOp_subtract, ScmOp_divide,
ScmOp_equal, ScmOp_less, ScmOp_less_eq, ScmOp_greater,
ScmOp_greater_eq, ScmOp_max, ScmOp_min): Rewrite with new
SCM_REDUCTION_OPERATOR
- (ScmOp_map, ScmOp_call_with_values): Follow the new procedure
calling interface
* sigscheme/operations-srfi8.c
- (ScmOp_SRFI8_receive): Follow the new procedure calling interface
* sigscheme/io.c
- (ScmOp_call_with_input_file, ScmOp_call_with_output_file,
ScmOp_with_input_from_file, ScmOp_with_output_to_file): Follow the
new procedure calling interface
* sigscheme/debug.c
- (SigScm_Display, SigScm_WriteToPort, SigScm_DisplayToPort):
Support SCM_VOLATILE_OUTPUT
- (print_ScmObj_internal): Fix (write (values)) handling
* uim/uim-scm.c
- (uim_scm_apply): Simplify with Scm_call()
* sigscheme/runtest.sh
- Print extra newlines
* sigscheme/test/test-exp.scm
- Fix an invalid assumption about result of set!
- Add some tests for "values"
- Remove some tests temporarily
* sigscheme/test/unittest.scm
- (eval-counter): New procedure
Modified: branches/r5rs/sigscheme/debug.c
===================================================================
--- branches/r5rs/sigscheme/debug.c 2005-09-25 06:00:01 UTC (rev 1579)
+++ branches/r5rs/sigscheme/debug.c 2005-09-25 11:43:52 UTC (rev 1580)
@@ -122,6 +122,9 @@
{
print_ScmObj_internal(SCM_PORTINFO_FILE(scm_current_output_port), obj, AS_WRITE);
fprintf(SCM_PORTINFO_FILE(scm_current_output_port), "\n");
+#if SCM_VOLATILE_OUTPUT
+ fflush(SCM_PORTINFO_FILE(scm_current_output_port));
+#endif
}
void SigScm_WriteToPort(ScmObj port, ScmObj obj)
@@ -131,6 +134,9 @@
if (SCM_PORTINFO_PORTTYPE(port) == PORT_FILE) {
f = SCM_PORTINFO_FILE(port);
print_ScmObj_internal(f, obj, AS_WRITE);
+#if SCM_VOLATILE_OUTPUT
+ fflush(f);
+#endif
return;
}
@@ -144,6 +150,9 @@
if (SCM_PORTINFO_PORTTYPE(port) == PORT_FILE) {
f = SCM_PORTINFO_FILE(port);
print_ScmObj_internal(f, obj, AS_DISPLAY);
+#if SCM_VOLATILE_OUTPUT
+ fflush(f);
+#endif
return;
}
@@ -202,7 +211,10 @@
break;
case ScmValuePacket:
fputs("#<values ", f);
- print_list(f, SCM_VALUEPACKET_VALUES(obj), otype);
+ if (NULLP (SCM_VALUEPACKET_VALUES(obj)))
+ fputs("()", f);
+ else
+ print_list(f, SCM_VALUEPACKET_VALUES(obj), otype);
putc('>', f);
break;
case ScmEtc:
Modified: branches/r5rs/sigscheme/eval.c
===================================================================
--- branches/r5rs/sigscheme/eval.c 2005-09-25 06:00:01 UTC (rev 1579)
+++ branches/r5rs/sigscheme/eval.c 2005-09-25 11:43:52 UTC (rev 1580)
@@ -81,6 +81,7 @@
/*=======================================
File Local Function Declarations
=======================================*/
+static ScmObj call(ScmObj proc, ScmObj args, ScmEvalState *eval_state, int suppress_eval);
static ScmObj map_eval(ScmObj args, ScmObj env);
static ScmObj qquote_internal(ScmObj expr, ScmObj env, int nest);
static ScmObj qquote_vector(ScmObj vec, ScmObj env, int nest);
@@ -219,389 +220,354 @@
return SCM_NULL;
}
-/*===========================================================================
- S-Expression Evaluation
-===========================================================================*/
-/*
- * TODO: split function invocation handling off into a function and share it
- * with ScmOp_apply
- */
-ScmObj ScmOp_eval(ScmObj obj, ScmObj env)
+/* Wrapper for call(). Just like ScmOp_apply(), except ARGS is used
+ * as given---nothing special is done about the last item in the
+ * list. */
+ScmObj Scm_call(ScmObj proc, ScmObj args)
{
- ScmObj tmp = SCM_NULL;
- ScmObj arg = SCM_NULL;
- ScmObj arg0, arg1, arg2, arg3, arg4;
- ScmObj rest = SCM_NULL;
- ScmObj args = SCM_NULL;
- ScmObj ret = SCM_NULL;
- int tail_flag = 0;
+ ScmEvalState state;
+ ScmObj ret;
- /* for debugging */
- struct trace_frame frame;
- frame.prev = scm_trace_root;
- frame.obj = obj;
- scm_trace_root = &frame;
+ /* We don't need a nonempty environemnt, because this function
+ * will never be called directly from Scheme code. If PROC is a
+ * closure, it'll have its own environment, if it's a syntax, it's
+ * an error, and if it's a C procedure, it doesn't have any free
+ * variables at the Scheme level. */
+ state.env = SCM_NULL;
+ state.ret_type = SCM_RETTYPE_AS_IS;
-eval_loop:
- switch (SCM_TYPE(obj)) {
- case ScmSymbol:
- ret = symbol_value(obj, env);
- goto eval_done;
+ ret = call(proc, args, &state, 1);
+ if (state.ret_type == SCM_RETTYPE_NEED_EVAL)
+ ret = EVAL(ret, state.env);
+ return ret;
+}
- /*====================================================================
- Evaluating a list form
- ====================================================================*/
- case ScmCons:
- /*============================================================
- Evaluating car of the form (syntax or procedure)
- ============================================================*/
- tmp = CAR(obj);
- switch (SCM_TYPE(tmp)) {
- case ScmFunc:
- break;
- case ScmClosure:
- break;
- case ScmSymbol:
- tmp = symbol_value(tmp, env);
- break;
- case ScmCons:
- tmp = ScmOp_eval(tmp, env);
- break;
- case ScmEtc:
- break;
- default:
- SigScm_ErrorObj("eval : invalid operation ", obj);
- break;
- }
+/* ARGS should NOT be evaluated yet. */
+static ScmObj reduce(ScmObj (*func)(), ScmObj args, ScmObj env, int suppress_eval)
+{
+ ScmObj left;
+ ScmObj right;
+ enum ScmReductionState state;
- /*===============================================================
- Evaluating the rest of the form according to type of the car
- ===============================================================*/
- switch (SCM_TYPE(tmp)) {
- case ScmFunc:
- /*
- * FUNCTYPE_RAW_LIST_TAIL_REC represents a form that contains tail
- * expressions, which must be evaluated without consuming storage
- * (proper tail recursion). A function of this type returns an
- * S-expression that the caller must evaluate to obtain the
- * resultant value of the entire form.
- * FUNCYTPE_RAW_LIST_WITH_TAIL_FLAG has the same semantics, except
- * that the return value must be evaluated if and only if the
- * callee sets tail_flag (an int passed by reference) to nonzero.
- * The two types receive a *reference* to the effective environment
- * so that they can extend it as necessary.
- *
- * FUNCTYPE_0 through 5 and FUNCTYPE_EVALED_LIST require the caller
- * to evaluate arguments. Others do it on their own.
- *
- * For FUNCTYPE_0 through 5, the caller checks the number of
- * arguments, and passes only the arguments. For other types,
- * checking is the callee's reponsibility, and they receive the
- * current environment.
- */
- switch (SCM_FUNC_TYPECODE(tmp)) {
- case FUNCTYPE_EVALED_LIST:
- ret = SCM_FUNC_EXEC_SUBRL(tmp,
- map_eval(CDR(obj), env),
- env);
- goto eval_done;
+ state = SCM_REDUCE_0;
+ if (NULLP(args))
+ return (*func)(SCM_INVALID, SCM_INVALID, &state);
- case FUNCTYPE_RAW_LIST:
- ret = SCM_FUNC_EXEC_SUBRL(tmp,
- CDR(obj),
- env);
- goto eval_done;
+ state = SCM_REDUCE_1;
+ SCM_SHIFT_RAW(left, args);
+ if (!suppress_eval)
+ left = EVAL(left, env);
+ if (NULLP(args))
+ return (*func)(left, left, &state);
- case FUNCTYPE_RAW_LIST_TAIL_REC:
- obj = SCM_FUNC_EXEC_SUBRR(tmp,
- CDR(obj),
- &env);
- goto eval_loop;
+ /* Reduce upto all but the last argument. */
+ state = SCM_REDUCE_PARTWAY;
+ while (SCM_SHIFT_RAW(right, args), !NULLP(args)) {
+ if (!suppress_eval)
+ right = EVAL(right, env);
+ left = (*func)(left, right, &state);
+ if (state == SCM_REDUCE_STOP)
+ return left;
+ }
- case FUNCTYPE_RAW_LIST_WITH_TAIL_FLAG:
- obj = SCM_FUNC_EXEC_SUBRF(tmp,
- CDR(obj),
- &env,
- &tail_flag);
+ /* Make the last call. */
+ state = SCM_REDUCE_LAST;
+ if (!suppress_eval)
+ right = EVAL(right, env);
+ return (*func)(left, right, &state);
+}
- /*
- * If tail_flag is nonzero, SCM_FUNC_EXEC_SUBRR returns a raw
- * S-expression. So we need to evaluate it! This is not to
- * consume stack, that is, tail-recursion optimization.
- */
- if (tail_flag)
- goto eval_loop;
+/* ARGS should already be evaluated. */
+static ScmObj call_closure(ScmObj proc, ScmObj args, ScmEvalState *eval_state)
+{
+ ScmObj formals;
+ /*
+ * Description of the ScmClosure handling
+ *
+ * (lambda <formals> <body>)
+ *
+ * <formals> should have 3 forms.
+ *
+ * (1) : <variable>
+ * (2) : (<variable1> <variable2> ...)
+ * (3) : (<variable1> <variable2> ... <variable n-1> . <variable n>)
+ */
+ formals = CAR(SCM_CLOSURE_EXP(proc));
- ret = obj;
- goto eval_done;
+ if (SYMBOLP(formals)) {
+ /* (1) : <variable> */
+ eval_state->env = extend_environment(LIST_1(formals),
+ LIST_1(args),
+ SCM_CLOSURE_ENV(proc));
+ } else if (CONSP(formals)) {
+ /*
+ * (2) : (<variable1> <variable2> ...)
+ * (3) : (<variable1> <variable2> ... <variable n-1> . <variable n>)
+ *
+ * - dot list is handled in lookup_frame().
+ */
+ eval_state->env = extend_environment(formals,
+ args,
+ SCM_CLOSURE_ENV(proc));
+ } else if (NULLP(formals)) {
+ /*
+ * (2') : <variable> is '()
+ */
+ eval_state->env
+ = extend_environment(SCM_NULL,
+ SCM_NULL,
+ SCM_CLOSURE_ENV(proc));
+ } else {
+ SigScm_ErrorObj("lambda : bad formals list: ", formals);
+ }
- case FUNCTYPE_0:
- ret = SCM_FUNC_EXEC_SUBR0(tmp);
- goto eval_done;
+ eval_state->ret_type = SCM_RETTYPE_NEED_EVAL;
+ return ScmExp_begin(CDR(SCM_CLOSURE_EXP(proc)), eval_state);
+}
- case FUNCTYPE_1:
- args = rest = CDR(obj);
- if (!NULLP(SCM_SHIFT_EVALED_1(arg0, rest, env)))
- SigScm_ErrorObj("func1 :" SCM_ERRMSG_WRONG_NR_ARG, args);
- ret = SCM_FUNC_EXEC_SUBR1(tmp, arg0);
- goto eval_done;
+/**
+ * @param proc The procedure or syntax to call.
+ *
+ * @param args The argument list.
+ *
+ * @param eval_state The calling evaluator's state.
+ *
+ * @param suppress_eval PROC and ARGS are assumed to have already gone
+ * through all necessary evaluations if this flag is nonzero.
+ */
+static ScmObj call(ScmObj proc, ScmObj args, ScmEvalState *eval_state, int suppress_eval)
+{
+ ScmObj env = eval_state->env;
+ ScmObj (*func)() = NULL;
+ enum ScmFuncTypeCode type = -1;
+ int mand_count = 0; /* Number of mandatory args. */
- case FUNCTYPE_2:
- args = rest = CDR(obj);
- if (!NULLP(SCM_SHIFT_EVALED_2(arg0, arg1, rest, env)))
- SigScm_ErrorObj("func2 :" SCM_ERRMSG_WRONG_NR_ARG, args);
- ret = SCM_FUNC_EXEC_SUBR2(tmp, arg0, arg1);
- goto eval_done;
+ void* argbuf[SCM_FUNCTYPE_MAND_MAX+2] = {0}; /* The +2 is for rest and env/eval_state. */
+ int i = 0; /* Number of arguments already stored in argbuf. */
- case FUNCTYPE_3:
- args = rest = CDR(obj);
- if (!NULLP(SCM_SHIFT_EVALED_3(arg0, arg1, arg2, rest, env)))
- SigScm_ErrorObj("func3 :" SCM_ERRMSG_WRONG_NR_ARG, args);
- ret = SCM_FUNC_EXEC_SUBR3(tmp, arg0, arg1, arg2);
- goto eval_done;
+ if (!suppress_eval)
+ proc = EVAL(proc, env);
- case FUNCTYPE_4:
- args = rest = CDR(obj);
- if (!NULLP(SCM_SHIFT_EVALED_4(arg0, arg1, arg2, arg3,
- rest, env)))
- SigScm_ErrorObj("func4 :" SCM_ERRMSG_WRONG_NR_ARG, args);
- ret = SCM_FUNC_EXEC_SUBR4(tmp, arg0, arg1, arg2, arg3);
- goto eval_done;
+ switch (SCM_TYPE(proc)) {
+ case ScmClosure:
+ return call_closure(proc,
+ suppress_eval ? args : map_eval(args, env),
+ eval_state);
+ case ScmContinuation:
+ if (NULLP(args)) {
+ SigScm_Error("Continuation invocation lacks an argument.");
+ }
+ scm_continuation_thrown_obj = EVAL(CAR(args), env);
+ longjmp(SCM_CONTINUATION_JMPENV(proc), 1);
+ return SCM_INVALID;
- case FUNCTYPE_5:
- args = rest = CDR(obj);
- if (!NULLP(SCM_SHIFT_EVALED_5(arg0, arg1, arg2, arg3, arg4,
- rest, env)))
- SigScm_ErrorObj("func5 :" SCM_ERRMSG_WRONG_NR_ARG, args);
- ret = SCM_FUNC_EXEC_SUBR5(tmp, arg0, arg1, arg2, arg3, arg4);
- goto eval_done;
+ case ScmFunc:
+ type = SCM_FUNC_TYPECODE(proc);
+ break;
+ default:
+ SigScm_ErrorObj("bad operator: ", proc);
+ }
- default:
- SigScm_Error("eval : unknown functype\n");
- }
+ /* We have a C function. */
- case ScmClosure:
- /*
- * Description of the ScmClosure handling
- *
- * (lambda <formals> <body>)
- *
- * <formals> should have 3 forms.
- *
- * (1) : <variable>
- * (2) : (<variable1> <variable2> ...)
- * (3) : (<variable1> <variable2> ... <variable n-1> . <variable n>)
- */
- arg = CAR(SCM_CLOSURE_EXP(tmp)); /* arg is <formals> */
-
- if (SYMBOLP(arg)) {
- /* (1) : <variable> */
- env = extend_environment(CONS(arg, SCM_NULL),
- CONS(map_eval(CDR(obj), env),
- SCM_NULL),
- SCM_CLOSURE_ENV(tmp));
- } else if (CONSP(arg)) {
- /*
- * (2) : (<variable1> <variable2> ...)
- * (3) : (<variable1> <variable2> ... <variable n-1> . <variable n>)
- *
- * - dot list is handled in lookup_frame().
- */
- env = extend_environment(arg,
- map_eval(CDR(obj), env),
- SCM_CLOSURE_ENV(tmp));
- } else if (NULLP(arg)) {
- /*
- * (2') : <variable> is '()
- */
- env = extend_environment(SCM_NULL,
- SCM_NULL,
- SCM_CLOSURE_ENV(tmp));
- } else {
- SigScm_ErrorObj("lambda : bad syntax with ", arg);
- }
-
- /*
- * Notice
- *
- * The return obj of ScmExp_begin is the raw S-expression.
- * So we need to re-evaluate this!.
- */
- obj = ScmExp_begin(CDR(SCM_CLOSURE_EXP(tmp)), &env);
- goto eval_loop;
+ func = SCM_FUNC_CFUNC(proc);
- case ScmContinuation:
- /*
- * Description of ScmContinuation handling
- *
- * (1) eval 1st arg
- * (2) store it to global variable "scm_continuation_thrown_obj"
- * (3) then longjmp
- *
- * PROBLEM : setjmp/longjmp is stack based operation, so we
- * cannot jump from the bottom of the stack to the top of
- * the stack. Is there any efficient way to implement first
- * class continuation? (TODO).
- */
- obj = CADR(obj);
- scm_continuation_thrown_obj = ScmOp_eval(obj, env);
- longjmp(SCM_CONTINUATION_JMPENV(tmp), 1);
- break;
+ if (type == SCM_REDUCTION_OPERATOR)
+ return reduce(func, args, env, suppress_eval);
- case ScmEtc:
- SigScm_ErrorObj("eval : invalid application: ", obj);
+ /* Suppress argument evaluation for syntaxes. */
+ if (suppress_eval) {
+ if (type & SCM_FUNCTYPE_SYNTAX)
+ SigScm_ErrorObj("can't apply/map a syntax: ", proc);
+ } else {
+ suppress_eval = type & SCM_FUNCTYPE_SYNTAX;
+ }
- default:
- SigScm_ErrorObj("eval : What type of function? ", arg);
- }
+ /* Collect mandatory arguments. */
+ mand_count = type & SCM_FUNCTYPE_MAND_MASK;
+ if (mand_count > SCM_FUNCTYPE_MAND_MAX)
+ SigScm_Error("Corrupted function: typecode=0x%x", type);
+ for (i=0; i < mand_count; i++) {
+ if (NULLP(args))
+ SigScm_Error("%d or more argument(s) required but got only %d\n",
+ mand_count, i);
+ SCM_SHIFT_RAW(argbuf[i], args);
+ if (!suppress_eval)
+ argbuf[i] = EVAL(argbuf[i], env);
+ }
- default:
- ret = obj;
- goto eval_done;
+ if (type & SCM_FUNCTYPE_VARIADIC) {
+ if (!suppress_eval)
+ args = map_eval(args, env);
+ argbuf[i++] = args;
}
+#if SCM_STRICT_ARGCHECK
+ else if (!NULLP(args)) {
+ SigScm_ErrorObj("superfluous arguments: ", args);
+ }
+#endif
-eval_done:
- scm_trace_root = frame.prev;
- return ret;
+ if (type & SCM_FUNCTYPE_TAIL_REC) {
+ eval_state->ret_type = SCM_RETTYPE_NEED_EVAL;
+ argbuf[i++] = eval_state;
+ } else {
+ eval_state->ret_type = SCM_RETTYPE_AS_IS;
+ if (type & SCM_FUNCTYPE_SYNTAX)
+ argbuf[i++] = env;
+ }
+
+ switch (i) {
+ case 0:
+ return (*func)();
+ case 1:
+ return (*func)(argbuf[0]);
+ case 2:
+ return (*func)(argbuf[0], argbuf[1]);
+#if SCM_FUNCTYPE_MAND_MAX >= 1
+ case 3:
+ return (*func)(argbuf[0], argbuf[1], argbuf[2]);
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 2
+ case 4:
+ return (*func)(argbuf[0], argbuf[1], argbuf[2], argbuf[3]);
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 3
+ case 5:
+ return (*func)(argbuf[0], argbuf[1], argbuf[2], argbuf[3], argbuf[4]);
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 4
+ case 6:
+ return (*func)(argbuf[0], argbuf[1], argbuf[2], argbuf[3], argbuf[4], argbuf[5]);
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 5
+ case 7:
+ return (*func)(argbuf[0], argbuf[1], argbuf[2], argbuf[3], argbuf[4], argbuf[5], argbuf[6]);
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 6
+ case 8:
+ return (*func)(argbuf[0], argbuf[1], argbuf[2], argbuf[3], argbuf[4], argbuf[5], argbuf[6], argbuf[7]);
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 7
+ case 9:
+ return (*func)(argbuf[0], argbuf[1], argbuf[2], argbuf[3], argbuf[4], argbuf[5], argbuf[6], argbuf[7], argbuf[8]);
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 8
+ case 10:
+ return (*func)(argbuf[0], argbuf[1], argbuf[2], argbuf[3], argbuf[4], argbuf[5], argbuf[6], argbuf[7], argbuf[8], argbuf[9]);
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 9
+ case 11:
+ return (*func)(argbuf[0], argbuf[1], argbuf[2], argbuf[3], argbuf[4], argbuf[5], argbuf[6], argbuf[7], argbuf[8], argbuf[9], argbuf[10]);
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 10
+ case 12:
+ return (*func)(argbuf[0], argbuf[1], argbuf[2], argbuf[3], argbuf[4], argbuf[5], argbuf[6], argbuf[7], argbuf[8], argbuf[9], argbuf[10], argbuf[11]);
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 11
+ case 13:
+ return (*func)(argbuf[0], argbuf[1], argbuf[2], argbuf[3], argbuf[4], argbuf[5], argbuf[6], argbuf[7], argbuf[8], argbuf[9], argbuf[10], argbuf[11], argbuf[12]);
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 12
+ case 14:
+ return (*func)(argbuf[0], argbuf[1], argbuf[2], argbuf[3], argbuf[4], argbuf[5], argbuf[6], argbuf[7], argbuf[8], argbuf[9], argbuf[10], argbuf[11], argbuf[12], argbuf[13]);
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 13
+ case 15:
+ return (*func)(argbuf[0], argbuf[1], argbuf[2], argbuf[3], argbuf[4], argbuf[5], argbuf[6], argbuf[7], argbuf[8], argbuf[9], argbuf[10], argbuf[11], argbuf[12], argbuf[13], argbuf[14]);
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 14
+ case 16:
+ return (*func)(argbuf[0], argbuf[1], argbuf[2], argbuf[3], argbuf[4], argbuf[5], argbuf[6], argbuf[7], argbuf[8], argbuf[9], argbuf[10], argbuf[11], argbuf[12], argbuf[13], argbuf[14], argbuf[15]);
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 15
+ case 17:
+ return (*func)(argbuf[0], argbuf[1], argbuf[2], argbuf[3], argbuf[4], argbuf[5], argbuf[6], argbuf[7], argbuf[8], argbuf[9], argbuf[10], argbuf[11], argbuf[12], argbuf[13], argbuf[14], argbuf[15], argbuf[16]);
+#endif
+ default:
+ SigScm_Error("Corrupted function: typecode=0x%x", type);
+ }
+ return SCM_INVALID;
}
+/*===========================================================================
+ S-Expression Evaluation
+===========================================================================*/
/*
- * TODO:
- * - Simplify and optimize with SCM_SHIFT_EVALED_*() macro
- * - split function invocation handling off to a function and share it with
- * ScmOp_eval
+ * TODO: split function invocation handling off into a function and share it
+ * with ScmOp_apply
*/
-ScmObj ScmOp_apply(ScmObj args, ScmObj env)
+ScmObj ScmOp_eval(ScmObj obj, ScmObj env)
{
- ScmObj proc = SCM_NULL;
- ScmObj obj = SCM_NULL;
- ScmObj rest = SCM_NULL;
- ScmObj arg0, arg1, arg2, arg3, arg4;
- int tail_flag = 0;
+ ScmObj ret = SCM_NULL;
+ ScmEvalState state = {0};
- /* sanity check */
- if CHECK_2_ARGS(args)
- SigScm_Error("apply : Wrong number of arguments\n");
- if (!NULLP(CDDR(args)))
- SigScm_Error("apply : Multiarg apply is not supported\n");
+ /* for debugging */
+ struct trace_frame frame;
+ frame.prev = scm_trace_root;
+ frame.obj = obj;
+ scm_trace_root = &frame;
- /* 1st elem of list is proc */
- proc = CAR(args);
+ state.env = env;
+ state.ret_type = SCM_RETTYPE_AS_IS;
- /* 2nd elem of list is obj */
- obj = CADR(args);
+eval_loop:
+ switch (SCM_TYPE(obj)) {
+ case ScmSymbol:
+ ret = symbol_value(obj, state.env);
+ break;
- /* apply proc */
- switch (SCM_TYPE(proc)) {
- case ScmFunc:
- switch (SCM_FUNC_TYPECODE(proc)) {
- case FUNCTYPE_EVALED_LIST:
- return SCM_FUNC_EXEC_SUBRL(proc,
- obj,
- env);
+ case ScmCons:
+ obj = call(CAR(obj), CDR(obj), &state, 0);
+ if (state.ret_type == SCM_RETTYPE_NEED_EVAL)
+ goto eval_loop;
+ ret = obj;
+#if SCM_STRICT_R5RS
+ if (!VALUEPACKETP(obj))
+#endif
+ break;
- case FUNCTYPE_RAW_LIST_WITH_TAIL_FLAG:
- obj = SCM_FUNC_EXEC_SUBRF(proc, obj, &env, &tail_flag);
- if (tail_flag)
- obj = EVAL(obj, env);
- return obj;
+ case ScmValuePacket:
+#if SCM_STRICT_R5RS
+ SigScm_ErrorObj("a continuation expecting 1 value got: ", obj);
+#endif
+ /* Otherwise fallthrough. */
- case FUNCTYPE_0:
- return SCM_FUNC_EXEC_SUBR0(proc);
+ default:
+ ret = obj;
+ break;
+ }
- case FUNCTYPE_1:
- rest = obj;
- if (!NULLP(SCM_SHIFT_RAW_1(arg0, rest)))
- SigScm_ErrorObj("apply func1 :" SCM_ERRMSG_WRONG_NR_ARG, obj);
- return SCM_FUNC_EXEC_SUBR1(proc, arg0);
+ scm_trace_root = frame.prev;
+ return ret;
+}
- case FUNCTYPE_2:
- rest = obj;
- if (!NULLP(SCM_SHIFT_RAW_2(arg0, arg1, rest)))
- SigScm_ErrorObj("apply func2 :" SCM_ERRMSG_WRONG_NR_ARG, obj);
- return SCM_FUNC_EXEC_SUBR2(proc, arg0, arg1);
+ScmObj ScmOp_apply(ScmObj proc, ScmObj arg0, ScmObj rest, ScmEvalState *eval_state)
+{
+ ScmObj args = SCM_INVALID;
+ ScmObj tail = SCM_INVALID;
+ ScmObj last = SCM_INVALID;
+ ScmObj lst = SCM_INVALID;
- case FUNCTYPE_3:
- rest = obj;
- if (!NULLP(SCM_SHIFT_RAW_3(arg0, arg1, arg2, rest)))
- SigScm_ErrorObj("apply func3 :" SCM_ERRMSG_WRONG_NR_ARG, obj);
- return SCM_FUNC_EXEC_SUBR3(proc, arg0, arg1, arg2);
-
- case FUNCTYPE_4:
- rest = obj;
- if (!NULLP(SCM_SHIFT_RAW_4(arg0, arg1, arg2, arg3, rest)))
- SigScm_ErrorObj("apply func4 :" SCM_ERRMSG_WRONG_NR_ARG, obj);
- return SCM_FUNC_EXEC_SUBR4(proc, arg0, arg1, arg2, arg3);
-
- case FUNCTYPE_5:
- rest = obj;
- if (!NULLP(SCM_SHIFT_RAW_5(arg0, arg1, arg2, arg3, arg4, rest)))
- SigScm_ErrorObj("apply func5 :" SCM_ERRMSG_WRONG_NR_ARG, obj);
- return SCM_FUNC_EXEC_SUBR5(proc, arg0, arg1, arg2, arg3, arg4);
-
- case FUNCTYPE_RAW_LIST:
- return SCM_FUNC_EXEC_SUBRL(proc,
- map_eval(obj, env),
- env);
-
- case FUNCTYPE_RAW_LIST_TAIL_REC:
- default:
- SigScm_ErrorObj("apply : invalid application ", proc);
+ if (NULLP(rest)) {
+ args = last = arg0;
+ } else {
+ /* More than one argument given. */
+ tail = args = LIST_1(arg0);
+ for (lst=rest; CONSP(CDR(lst)); lst = CDR(lst)) {
+ SET_CDR(tail, LIST_1(CAR(lst)));
+ tail = CDR(tail);
}
-
- case ScmClosure:
- /*
- * Description of the ScmClosure handling
- *
- * (lambda <formals> <body>)
- *
- * <formals> should have 3 forms.
- *
- * (1) : <variable>
- * (2) : (<variable1> <variable2> ...)
- * (3) : (<variable1> <variable2> ... <variable n-1> . <variable n>)
- */
- args = CAR(SCM_CLOSURE_EXP(proc)); /* arg is <formals> */
- if (SYMBOLP(args)) {
- /* (1) : <variable> */
- env = extend_environment(CONS(args, SCM_NULL),
- CONS(obj, SCM_NULL),
- SCM_CLOSURE_ENV(proc));
- } else if (CONSP(args)) {
- /*
- * (2) : (<variable1> <variable2> ...)
- * (3) : (<variable1> <variable2> ... <variable n-1> . <variable n>)
- *
- * - dot list is handled in lookup_frame().
- */
- env = extend_environment(args,
- obj,
- SCM_CLOSURE_ENV(proc));
- } else if (NULLP(args)) {
- /*
- * (2') : <variable> is '()
- */
- env = extend_environment(SCM_NULL,
- SCM_NULL,
- SCM_CLOSURE_ENV(proc));
- } else {
- SigScm_ErrorObj("lambda : bad syntax with ", args);
- }
- /*
- * Notice
- *
- * The return obj of ScmExp_begin is the raw S-expression.
- * So we need to re-evaluate this!.
- */
- obj = ScmExp_begin(CDR(SCM_CLOSURE_EXP(proc)), &env);
- return EVAL(obj, env);
-
- default:
- SigScm_ErrorObj("apply : invalid application ", args);
+ last = CAR(lst);
+ SET_CDR(tail, last); /* The last one is spliced. */
+ if (!NULLP(CDR(lst)))
+ SigScm_ErrorObj("apply : improper argument list: ", CONS(arg0, rest));
}
- /* never reaches here */
- return SCM_NULL;
+ if (FALSEP(ScmOp_listp(last)))
+ SigScm_ErrorObj("apply : list required but got: ", last);
+
+ /* The last argument inhibits argument re-evaluation. */
+ return call(proc, args, eval_state, 1);
}
ScmObj symbol_value(ScmObj var, ScmObj env)
@@ -902,14 +868,8 @@
R5RS : 4.1 Primitive expression types : 4.1.2 Literal expressions
===========================================================================*/
/* FIXME: rename to ScmExp_quote since quote is a syntax */
-ScmObj ScmOp_quote(ScmObj args, ScmObj env)
+ScmObj ScmOp_quote(ScmObj datum, ScmObj env)
{
- ScmObj datum;
- ScmObj rest = args;
-
- if (!NULLP(SCM_SHIFT_RAW_1(datum, rest)))
- SigScm_ErrorObj("quote: syntax error : ", args);
-
return datum;
}
@@ -927,55 +887,29 @@
/*===========================================================================
R5RS : 4.1 Primitive expression types : 4.1.5 Conditionals
===========================================================================*/
-ScmObj ScmExp_if(ScmObj args, ScmObj *envp)
+ScmObj ScmExp_if(ScmObj test, ScmObj conseq, ScmObj rest, ScmEvalState *eval_state)
{
- ScmObj test, conseq, alt;
- ScmObj rest = args;
- ScmObj env = *envp;
+ ScmObj env = eval_state->env;
/*========================================================================
(if <test> <consequent>)
(if <test> <consequent> <alternate>)
========================================================================*/
- if (!(SCM_SHIFT_RAW_2(test, conseq, rest)))
- SigScm_ErrorObj("if : syntax error : ", args);
-
- if (NFALSEP(EVAL(test, env))) {
-#if SCM_STRICT_R5RS
- /* excessive arguments */
- if (!NULLP(rest) && !NULLP(CDR(rest)))
- SigScm_ErrorObj("if : syntax error : ", args);
-#endif
-
- /* doesn't evaluate now for tail-recursion. */
+ if (NFALSEP(EVAL(test, env)))
return conseq;
- } else {
- if (NULLP(rest))
- return SCM_UNDEF;
-
- /* excessive arguments */
- if (!NULLP(SCM_SHIFT_RAW_1(alt, rest)))
- SigScm_ErrorObj("if : syntax error : ", args);
-
- /* doesn't evaluate now for tail-recursion. */
- return alt;
- }
+ else
+ return NULLP(rest) ? SCM_UNDEF : CAR(rest);
}
/*===========================================================================
R5RS : 4.1 Primitive expression types : 4.1.6 Assignment
===========================================================================*/
-ScmObj ScmExp_set(ScmObj args, ScmObj env)
+ScmObj ScmExp_set(ScmObj sym, ScmObj exp, ScmObj env)
{
- ScmObj sym, exp;
- ScmObj rest = args;
ScmObj evaled = SCM_FALSE;
ScmObj locally_bound = SCM_NULL;
- if (!NULLP(SCM_SHIFT_RAW_2(sym, exp, rest)))
- SigScm_ErrorObj("set : syntax error ", args);
-
evaled = EVAL(exp, env);
locally_bound = lookup_environment(sym, env);
if (NULLP(locally_bound)) {
@@ -1011,7 +945,7 @@
* - depending on its own true value
* - can appeared in other than last clause
*/
-ScmObj ScmExp_cond(ScmObj arg, ScmObj *envp)
+ScmObj ScmExp_cond(ScmObj arg, ScmEvalState *eval_state)
{
/*
* (cond <clause1> <clause2> ...)
@@ -1025,7 +959,7 @@
* last <clause> may be of the form
* (else <expression1> <expression2> ...)
*/
- ScmObj env = *envp;
+ ScmObj env = eval_state->env;
ScmObj clause = SCM_NULL;
ScmObj test = SCM_NULL;
ScmObj exps = SCM_NULL;
@@ -1064,12 +998,10 @@
if (FALSEP(ScmOp_procedurep(proc)))
SigScm_ErrorObj("cond : the value of exp after => must be the procedure but got ", proc);
- return ScmOp_apply(SCM_LIST_2(proc,
- CONS(test, SCM_NULL)),
- env);
+ return Scm_call(proc, LIST_1(test));
}
- return ScmExp_begin(exps, &env);
+ return ScmExp_begin(exps, eval_state);
}
}
@@ -1077,9 +1009,9 @@
}
/* FIXME: argument extraction */
-ScmObj ScmExp_case(ScmObj arg, ScmObj *envp)
+ScmObj ScmExp_case(ScmObj arg, ScmEvalState *eval_state)
{
- ScmObj env = *envp;
+ ScmObj env = eval_state->env;
ScmObj key = EVAL(CAR(arg), env);
ScmObj clause = SCM_NULL;
ScmObj data = SCM_NULL;
@@ -1095,12 +1027,12 @@
/* check "else" symbol */
if (NULLP(CDR(arg)) && !CONSP(data) && NFALSEP(SCM_SYMBOL_VCELL(data)))
- return ScmExp_begin(exps, &env);
+ return ScmExp_begin(exps, eval_state);
/* evaluate data and compare to key by eqv? */
for (; !NULLP(data); data = CDR(data)) {
if (NFALSEP(ScmOp_eqvp(CAR(data), key))) {
- return ScmExp_begin(exps, &env);
+ return ScmExp_begin(exps, eval_state);
}
}
}
@@ -1108,9 +1040,9 @@
return SCM_UNDEF;
}
-ScmObj ScmExp_and(ScmObj arg, ScmObj *envp, int *tail_flag)
+ScmObj ScmExp_and(ScmObj arg, ScmEvalState *eval_state)
{
- ScmObj env = *envp;
+ ScmObj env = eval_state->env;
ScmObj obj = SCM_NULL;
if (NULLP(arg))
@@ -1124,19 +1056,13 @@
obj = CAR(arg);
/* return last item */
- if (NULLP(CDR(arg))) {
- /* set tail_flag */
- (*tail_flag) = 1;
-
+ if (NULLP(CDR(arg)))
return obj;
- }
/* evaluate obj */
obj = EVAL(obj, env);
if (FALSEP(obj)) {
- /* set tail_flag */
- (*tail_flag) = 0;
-
+ eval_state->ret_type = SCM_RETTYPE_AS_IS;
return SCM_FALSE;
}
}
@@ -1144,9 +1070,9 @@
return SCM_NULL;
}
-ScmObj ScmExp_or(ScmObj arg, ScmObj *envp, int *tail_flag)
+ScmObj ScmExp_or(ScmObj arg, ScmEvalState *eval_state)
{
- ScmObj env = *envp;
+ ScmObj env = eval_state->env;
ScmObj obj = SCM_NULL;
if (NULLP(arg))
@@ -1160,18 +1086,13 @@
obj = CAR(arg);
/* return last item */
- if (NULLP(CDR(arg))) {
- /* set tail_flag */
- (*tail_flag) = 1;
-
+ if (NULLP(CDR(arg)))
return obj;
- }
obj = EVAL(obj, env);
if (NFALSEP(obj)) {
- /* set tail_flag */
- (*tail_flag) = 0;
-
+ /* Suppress return value evaluation. */
+ eval_state->ret_type = SCM_RETTYPE_AS_IS;
return obj;
}
@@ -1184,9 +1105,9 @@
R5RS : 4.2 Derived expression types : 4.2.2 Binding constructs
===========================================================================*/
/* TODO: Simplify and optimize with SCM_SHIFT_*() macro */
-ScmObj ScmExp_let(ScmObj arg, ScmObj *envp)
+ScmObj ScmExp_let(ScmObj arg, ScmEvalState *eval_state)
{
- ScmObj env = *envp;
+ ScmObj env = eval_state->env;
ScmObj bindings = SCM_NULL;
ScmObj body = SCM_NULL;
ScmObj vars = SCM_NULL;
@@ -1229,16 +1150,20 @@
/* create new environment for */
env = extend_environment(vars, vals, env);
- *envp = env;
+ eval_state->env = env;
- return ScmExp_begin(body, &env);
+ return ScmExp_begin(body, eval_state);
}
- return ScmExp_begin(body, &env);
+ return ScmExp_begin(body, eval_state);
named_let:
+ /* This code needs reworking. <init>s should be evaluated in an
+ environment where <procname> is not bound to the closure.
+ <procname>'s scope also penetrates to the surrounding
+ environment. */
/*========================================================================
- (let <variable> <bindings> <body>)
+ (let <procname> <bindings> <body>)
<bindings> == ((<variable1> <init1>)
(<variable2> <init2>)
...)
@@ -1255,9 +1180,8 @@
vals = ScmOp_reverse(vals);
/* (define (<variable> <variable1> <variable2> ...>) <body>) */
- ScmExp_define(CONS(CONS(CAR(arg),
- vars),
- body),
+ ScmExp_define(CAR(arg),
+ LIST_1(Scm_NewClosure(CONS(vars, body), env)),
env);
/* (func <init1> <init2> ...) */
@@ -1265,9 +1189,9 @@
}
/* TODO: Simplify and optimize with SCM_SHIFT_*() macro */
-ScmObj ScmExp_let_star(ScmObj arg, ScmObj *envp)
+ScmObj ScmExp_let_star(ScmObj arg, ScmEvalState *eval_state)
{
- ScmObj env = *envp;
+ ScmObj env = eval_state->env;
ScmObj bindings = SCM_NULL;
ScmObj body = SCM_NULL;
ScmObj vars = SCM_NULL;
@@ -1307,9 +1231,9 @@
env = extend_environment(vars, vals, env);
}
/* set new env */
- *envp = env;
+ eval_state->env = env;
/* evaluate */
- return ScmExp_begin(body, &env);
+ return ScmExp_begin(body, eval_state);
} else if (NULLP(bindings)) {
/* extend null environment */
env = extend_environment(SCM_NULL,
@@ -1317,18 +1241,18 @@
env);
/* set new env */
- *envp = env;
+ eval_state->env = env;
/* evaluate */
- return ScmExp_begin(body, &env);
+ return ScmExp_begin(body, eval_state);
}
return SCM_UNDEF;
}
/* TODO: Simplify and optimize with SCM_SHIFT_*() macro */
-ScmObj ScmExp_letrec(ScmObj arg, ScmObj *envp)
+ScmObj ScmExp_letrec(ScmObj arg, ScmEvalState *eval_state)
{
- ScmObj env = *envp;
+ ScmObj env = eval_state->env;
ScmObj bindings = SCM_NULL;
ScmObj body = SCM_NULL;
ScmObj vars = SCM_NULL;
@@ -1383,7 +1307,7 @@
scm_letrec_env = SCM_NULL;
/* set new env */
- *envp = env;
+ eval_state->env = env;
/* evaluate vals */
for (; !NULLP(vals); vals = CDR(vals)) {
@@ -1391,7 +1315,7 @@
}
/* evaluate body */
- return ScmExp_begin(body, &env);
+ return ScmExp_begin(body, eval_state);
}
SigScm_Error("letrec : syntax error\n");
@@ -1402,43 +1326,32 @@
/*===========================================================================
R5RS : 4.2 Derived expression types : 4.2.3 Sequencing
===========================================================================*/
-ScmObj ScmExp_begin(ScmObj arg, ScmObj *envp)
+ScmObj ScmExp_begin(ScmObj args, ScmEvalState *eval_state)
{
- ScmObj env = *envp;
- ScmObj exp = SCM_NULL;
+ ScmObj env = eval_state->env;
+ ScmObj lst = args;
/* sanity check */
- if (NULLP(arg))
+ if (NULLP(lst))
return SCM_UNDEF;
- /* FIXME: expensive operation */
- if (FALSEP(ScmOp_listp(arg)))
- SigScm_ErrorObj("begin : list required but got ", arg);
- /* eval recursively */
- for (; !NULLP(arg); arg = CDR(arg)) {
- exp = CAR(arg);
+ if (!CONSP(lst))
+ SigScm_ErrorObj("begin: improper argument list: ", args);
- /* return last expression's result */
- if (EQ(CDR(arg), SCM_NULL)) {
- /* doesn't evaluate exp now for tail-recursion. */
- return exp;
- }
+ for (; CONSP(CDR(lst)); lst = CDR(lst))
+ EVAL(CAR(lst), env);
- /* evaluate exp */
- EVAL(exp, env);
+ if (!NULLP(CDR(lst)))
+ SigScm_ErrorObj("begin: improper argument list: ", args);
- /* set new env */
- *envp = env;
- }
-
- return SCM_UNDEF;
+ /* Return tail expression. */
+ return CAR(lst);
}
/*===========================================================================
R5RS : 4.2 Derived expression types : 4.2.4 Iteration
===========================================================================*/
-/* FIXME: Make safe, simple and optimized with SCM_SHIFT_*() macro */
-ScmObj ScmExp_do(ScmObj arg, ScmObj *envp)
+ScmObj ScmExp_do(ScmObj arg, ScmEvalState *eval_state)
{
/*
* (do ((<variable1> <init1> <step1>)
@@ -1447,7 +1360,7 @@
* (<test> <expression> ...)
* <command> ...)
*/
- ScmObj env = *envp;
+ ScmObj env = eval_state->env;
ScmObj bindings = CAR(arg);
ScmObj vars = SCM_NULL;
ScmObj vals = SCM_NULL;
@@ -1491,16 +1404,16 @@
/* construct commands */
commands = CDDR(arg);
- /* now excution phase! */
+ /* now execution phase! */
while (FALSEP(EVAL(test, env))) {
/* execute commands */
- EVAL(ScmExp_begin(commands, &env), env);
+ EVAL(ScmExp_begin(commands, eval_state), env);
/*
* Notice
*
* the result of the execution of <step>s must not depend on each other's
- * results. each excution must be done independently. So, we store the
+ * results. each execution must be done independently. So, we store the
* results to the "vals" variable and set it in hand.
*/
vals = SCM_NULL;
@@ -1526,26 +1439,19 @@
}
}
- /* set new env */
- *envp = env;
+ eval_state->env = env;
- return ScmExp_begin(expression, &env);
+ return ScmExp_begin(expression, eval_state);
}
/*===========================================================================
R5RS : 4.2 Derived expression types : 4.2.5 Delayed evaluation
===========================================================================*/
/* FIXME: rename to ScmExp_delay since delay is a syntax */
-ScmObj ScmOp_delay(ScmObj args, ScmObj env)
+ScmObj ScmOp_delay(ScmObj expr, ScmObj env)
{
- ScmObj exp;
- ScmObj rest = args;
-
- if (!NULLP(SCM_SHIFT_RAW_1(exp, rest)))
- SigScm_ErrorObj("delay : syntax error ", args);
-
/* (lambda () exp) */
- return Scm_NewClosure(SCM_LIST_2(SCM_NULL, exp), env);
+ return Scm_NewClosure(SCM_LIST_2(SCM_NULL, expr), env);
}
/*===========================================================================
@@ -1553,24 +1459,19 @@
===========================================================================*/
/* FIXME: rename to ScmExp_quasiquote since quasiquote is a syntax */
/* TODO: Simplify and optimize with SCM_SHIFT_*() macro */
-ScmObj ScmOp_quasiquote(ScmObj obj, ScmObj env)
+ScmObj ScmOp_quasiquote(ScmObj datum, ScmObj env)
{
ScmObj ret;
- if (!IS_LIST_LEN_1(obj))
- SigScm_ErrorObj("quasiquote: bad argument list: ", obj);
- obj = CAR(obj);
- ret = qquote_internal(obj, env, 1);
+ ret = qquote_internal(datum, env, 1);
if (QQUOTE_IS_VERBATIM(ret))
- return obj;
+ return datum;
return ret;
}
/* FIXME: rename to ScmExp_unquote since unquote is a syntax */
-ScmObj ScmOp_unquote(ScmObj obj, ScmObj env)
+ScmObj ScmOp_unquote(ScmObj dummy, ScmObj env)
{
- if (!CONSP(obj) || !NULLP(CDR(obj)))
- SigScm_ErrorObj("unquote: bad argument list: ", obj);
SigScm_Error("unquote outside quasiquote");
return SCM_NULL;
}
@@ -1579,10 +1480,8 @@
* FIXME: rename to ScmExp_unquote_splicing since unquote_splicing is a
* syntax
*/
-ScmObj ScmOp_unquote_splicing(ScmObj obj, ScmObj env)
+ScmObj ScmOp_unquote_splicing(ScmObj dummy, ScmObj env)
{
- if (!CONSP(obj) || !NULLP(CDR(obj)))
- SigScm_ErrorObj("unquote-splicing: bad argument list: ", obj);
SigScm_Error("unquote-splicing outside quasiquote");
return SCM_NULL;
}
@@ -1591,23 +1490,19 @@
/*=======================================
R5RS : 5.2 Definitions
=======================================*/
-ScmObj ScmExp_define(ScmObj args, ScmObj env)
+ScmObj ScmExp_define(ScmObj var, ScmObj rest, ScmObj env)
{
- ScmObj var, exp;
- ScmObj rest = args;
- ScmObj lambda_var = SCM_FALSE;
- ScmObj body = SCM_NULL;
- ScmObj formals = SCM_NULL;
+ ScmObj exp = SCM_NULL;
+ ScmObj procname = SCM_NULL;
+ ScmObj body = SCM_NULL;
+ ScmObj formals = SCM_NULL;
- if (!SCM_SHIFT_RAW_1(var, rest))
- SigScm_ErrorObj("define : syntax error ", args);
-
/*========================================================================
(define <variable> <expression>)
========================================================================*/
if (SYMBOLP(var)) {
if (!NULLP(SCM_SHIFT_RAW_1(exp, rest)))
- SigScm_ErrorObj("define : syntax error ", args);
+ SigScm_Error("define : missing expression\n");
if (NULLP(env)) {
/* given top-level environment */
@@ -1625,33 +1520,28 @@
}
/*========================================================================
- (define (<variable> <formals>) <body>)
+ (define (<variable> . <formals>) <body>)
=> (define <variable>
(lambda (<formals>) <body>))
========================================================================*/
- /*========================================================================
- (define (<variable> . <formal>) <body>)
-
- => (define <variable>
- (lambda <formal> <body>))
- ========================================================================*/
if (CONSP(var)) {
- lambda_var = CAR(var);
+ procname = CAR(var);
formals = CDR(var);
body = rest;
if (NULLP(body))
- SigScm_ErrorObj("define : badly formed body ", args);
+ SigScm_Error("define : missing function body\n");
- /* (var (lambda formals body)) */
- args = SCM_LIST_2(lambda_var,
- ScmExp_lambda(CONS(formals, body), env));
+ if (!SYMBOLP(procname))
+ SigScm_ErrorObj("define : symbol required but got ", procname);
- return ScmExp_define(args, env);
+ return ScmExp_define(procname,
+ LIST_1(Scm_NewClosure(CONS(formals, body), env)),
+ env);
}
- SigScm_ErrorObj("define : syntax error ", args);
+ SigScm_ErrorObj("define : symbol required but got ", var);
return SCM_UNDEF;
}
Modified: branches/r5rs/sigscheme/io.c
===================================================================
--- branches/r5rs/sigscheme/io.c 2005-09-25 06:00:01 UTC (rev 1579)
+++ branches/r5rs/sigscheme/io.c 2005-09-25 11:43:52 UTC (rev 1580)
@@ -101,10 +101,7 @@
/* open port */
port = ScmOp_open_input_file(filepath);
- /* (apply proc (port)) */
- ret = ScmOp_apply(SCM_LIST_2(proc,
- CONS(port, SCM_NULL)),
- SCM_NULL);
+ ret = Scm_call(proc, LIST_1(port));
/* close port */
ScmOp_close_input_port(port);
@@ -126,9 +123,7 @@
port = ScmOp_open_output_file(filepath);
/* (apply proc (port)) */
- ret = ScmOp_apply(SCM_LIST_2(proc,
- CONS(port, SCM_NULL)),
- SCM_NULL);
+ ret = Scm_call(proc, LIST_1(port));
/* close port */
ScmOp_close_output_port(port);
@@ -177,9 +172,7 @@
scm_current_input_port = ScmOp_open_input_file(filepath);
/* (apply thunk ())*/
- ret = ScmOp_apply(SCM_LIST_2(thunk,
- CONS(SCM_NULL, SCM_NULL)),
- SCM_NULL);
+ ret = Scm_call(thunk, SCM_NULL);
/* close port */
ScmOp_close_input_port(scm_current_input_port);
@@ -204,10 +197,8 @@
tmp_port = scm_current_output_port;
scm_current_output_port = ScmOp_open_output_file(filepath);
- /* (apply thunk ())*/
- ret = ScmOp_apply(SCM_LIST_2(thunk,
- CONS(SCM_NULL, SCM_NULL)),
- SCM_NULL);
+ /* (thunk)*/
+ ret = Scm_call(thunk, SCM_NULL);
/* close port */
ScmOp_close_output_port(scm_current_output_port);
Modified: branches/r5rs/sigscheme/operations-srfi8.c
===================================================================
--- branches/r5rs/sigscheme/operations-srfi8.c 2005-09-25 06:00:01 UTC (rev 1579)
+++ branches/r5rs/sigscheme/operations-srfi8.c 2005-09-25 11:43:52 UTC (rev 1580)
@@ -39,6 +39,7 @@
Local Include
=======================================*/
#include "sigscheme.h"
+#include "sigschemeinternal.h"
/*=======================================
File Local Struct Declarations
@@ -63,40 +64,25 @@
/*=============================================================================
SRFI8 : Receive
=============================================================================*/
-/* TODO: Simplify and optimize with SCM_SHIFT_*() macro */
-ScmObj ScmOp_SRFI8_receive(ScmObj args, ScmObj *envp)
+ScmObj ScmOp_SRFI8_receive(ScmObj formals, ScmObj expr, ScmObj body, ScmEvalState *eval_state)
{
/*
* (receive <formals> <expression> <body>)
*/
- ScmObj env = *envp;
- ScmObj formals = SCM_NULL;
- ScmObj expr = SCM_NULL;
- ScmObj body = SCM_NULL;
+ ScmObj env = eval_state->env;
ScmObj actuals = SCM_NULL;
- ScmObj closure = SCM_NULL;
- /* sanity check */
- if (CHECK_3_ARGS(args))
- SigScm_ErrorObj("receive: bad argument list: ", args);
-
- formals = CAR(args);
- expr = CADR(args);
- body = CDDR(args);
-
- /* TODO: Check: do we have to extend the environment first? The SRFI-8
+ /* FIXME: do we have to extend the environment first? The SRFI-8
* document contradicts itself on this part. */
actuals = EVAL(expr, env);
- if (VALUEPACKETP(actuals))
+ if (SCM_VALUEPACKETP(actuals))
actuals = SCM_VALUEPACKET_VALUES(actuals);
else
actuals = CONS(actuals, SCM_NULL);
- closure = Scm_NewClosure(CONS(formals, body), env);
-
- /* set new env */
- (*envp) = env;
-
- return CONS(closure, actuals);
+ return ScmOp_apply(Scm_NewClosure(CONS(formals, body), env),
+ actuals,
+ SCM_NULL,
+ eval_state);
}
Modified: branches/r5rs/sigscheme/operations.c
===================================================================
--- branches/r5rs/sigscheme/operations.c 2005-09-25 06:00:01 UTC (rev 1579)
+++ branches/r5rs/sigscheme/operations.c 2005-09-25 11:43:52 UTC (rev 1580)
@@ -251,90 +251,100 @@
==============================================================================*/
/* Note: SigScheme supports only the integer part of the numerical tower. */
-/* TODO: Simplify with SCM_REDUCE*() macro */
-ScmObj ScmOp_add(ScmObj args, ScmObj env)
+ScmObj ScmOp_add(ScmObj left, ScmObj right, enum ScmReductionState *state)
{
int result = 0;
- ScmObj operand = SCM_NULL;
-
- for (; !NULLP(args); args = CDR(args)) {
- operand = EVAL(CAR(args), env);
- if (!INTP(operand))
- SigScm_ErrorObj("+ : integer required but got ", operand);
- result += SCM_INT_VALUE(operand);
+ switch (*state) {
+ case SCM_REDUCE_PARTWAY:
+ case SCM_REDUCE_LAST:
+ if (!INTP(left))
+ SigScm_ErrorObj("+ : integer required but got ", left);
+ result = SCM_INT_VALUE(left);
+ /* Fall through. */
+ case SCM_REDUCE_1:
+ if (!INTP(right))
+ SigScm_ErrorObj("+ : integer required but got ", right);
+ result += SCM_INT_VALUE(right);
+ /* Fall through. */
+ case SCM_REDUCE_0:
+ break;
+ default:
+ SigScm_Error("+ : (internal error) unrecognized state specifier: ", *state);
}
return Scm_NewInt(result);
}
-/* TODO: Simplify with SCM_REDUCE*() macro */
-ScmObj ScmOp_multiply(ScmObj args, ScmObj env)
+ScmObj ScmOp_multiply(ScmObj left, ScmObj right, enum ScmReductionState *state)
{
int result = 1;
- ScmObj operand = SCM_NULL;
-
- for (; !NULLP(args); args = CDR(args)) {
- operand = EVAL(CAR(args), env);
- if (!INTP(operand))
- SigScm_ErrorObj("* : integer required but got ", operand);
- result *= SCM_INT_VALUE(operand);
+ switch (*state) {
+ case SCM_REDUCE_PARTWAY:
+ case SCM_REDUCE_LAST:
+ if (!INTP(left))
+ SigScm_ErrorObj("* : integer required but got ", left);
+ result = SCM_INT_VALUE(left);
+ /* Fall through. */
+ case SCM_REDUCE_1:
+ if (!INTP(right))
+ SigScm_ErrorObj("* : integer required but got ", right);
+ result *= SCM_INT_VALUE(right);
+ /* Fall through. */
+ case SCM_REDUCE_0:
+ break;
+ default:
+ SigScm_Error("* : (internal error) unrecognized state specifier: ", *state);
}
return Scm_NewInt(result);
}
-/* TODO: Simplify with SCM_REDUCE*() macro */
-ScmObj ScmOp_subtract(ScmObj args, ScmObj env)
+ScmObj ScmOp_subtract(ScmObj left, ScmObj right, enum ScmReductionState *state)
{
int result = 0;
- ScmObj operand = SCM_NULL;
+ switch (*state) {
+ case SCM_REDUCE_PARTWAY:
+ case SCM_REDUCE_LAST:
+ if (!INTP(left))
+ SigScm_ErrorObj("- : integer required but got ", left);
+ result = SCM_INT_VALUE(left);
+ /* Fall through. */
+ case SCM_REDUCE_1:
+ if (!INTP(right))
+ SigScm_ErrorObj("- : integer required but got ", right);
+ result -= SCM_INT_VALUE(right);
+ break;
- if (NULLP(args))
+ case SCM_REDUCE_0:
SigScm_Error("- : at least 1 argument required\n");
-
- result = SCM_INT_VALUE(EVAL(CAR(args), env));
- args = CDR(args);
-
- /* single arg */
- if (NULLP(args))
- return Scm_NewInt(-result);
-
- for (; !NULLP(args); args = CDR(args)) {
- operand = EVAL(CAR(args), env);
- if (!INTP(operand))
- SigScm_ErrorObj("- : integer required but got ", operand);
- result -= SCM_INT_VALUE(operand);
+ default:
+ SigScm_Error("- : (internal error) unrecognized state specifier: ", *state);
}
-
return Scm_NewInt(result);
}
-/* TODO: Simplify with SCM_REDUCE*() macro */
-ScmObj ScmOp_divide(ScmObj args, ScmObj env)
+ScmObj ScmOp_divide(ScmObj left, ScmObj right, enum ScmReductionState *state)
{
- int result = 0;
- ScmObj operand = SCM_NULL;
-
- if (NULLP(args))
+ int result = 1;
+ switch (*state) {
+ case SCM_REDUCE_PARTWAY:
+ case SCM_REDUCE_LAST:
+ if (!INTP(left))
+ SigScm_ErrorObj("/ : integer required but got ", left);
+ result = SCM_INT_VALUE(left);
+ /* Fall through. */
+ case SCM_REDUCE_1:
+ if (!INTP(right))
+ SigScm_ErrorObj("/ : integer required but got ", right);
+ if (SCM_INT_VALUE(right) == 0)
+ SigScm_Error("/ : division by zero\n");
+ result /= SCM_INT_VALUE(right);
+ break;
+ case SCM_REDUCE_0:
SigScm_Error("/ : at least 1 argument required\n");
-
- result = SCM_INT_VALUE(EVAL(CAR(args), env));
- args = CDR(args);
-
- /* single arg */
- if (NULLP(args))
- return Scm_NewInt(1 / result);
-
- for (; !NULLP(args); args = CDR(args)) {
- operand = EVAL(CAR(args), env);
- if (!INTP(operand))
- SigScm_ErrorObj("/ : integer required but got ", operand);
-
- if (SCM_INT_VALUE(operand) == 0)
- SigScm_ErrorObj("/ : division by zero ", args);
- result /= SCM_INT_VALUE(operand);
+ default:
+ SigScm_Error("/ : (internal error) unrecognized state specifier: ", *state);
}
-
return Scm_NewInt(result);
}
@@ -343,171 +353,51 @@
return (INTP(obj)) ? SCM_TRUE : SCM_FALSE;
}
-/* TODO: Simplify with SCM_REDUCE*() macro */
-ScmObj ScmOp_equal(ScmObj args, ScmObj env)
+ScmObj ScmOp_equal(ScmObj left, ScmObj right, enum ScmReductionState *state)
{
- int val = 0;
- ScmObj obj = SCM_NULL;
- /* arglen check */
- if CHECK_2_ARGS(args)
- SigScm_Error("= : Wrong number of arguments\n");
+#define COMPARATOR_BODY(op, opstr) \
+ switch (*state) { \
+ case SCM_REDUCE_0: \
+ case SCM_REDUCE_1: \
+ SigScm_Error(opstr " : at least 2 arguments required\n"); \
+ case SCM_REDUCE_PARTWAY: \
+ case SCM_REDUCE_LAST: \
+ if (!INTP(left)) \
+ SigScm_ErrorObj(opstr " : integer required but got ", left); \
+ if (!INTP(right)) \
+ SigScm_ErrorObj(opstr " : integer required but got ", right); \
+ if (SCM_INT_VALUE(left) op SCM_INT_VALUE(right)) \
+ return *state == SCM_REDUCE_LAST ? SCM_TRUE : right; \
+ *state = SCM_REDUCE_STOP; \
+ return SCM_FALSE; \
+ default: \
+ SigScm_Error(opstr " : (internal error) unrecognized state specifier: ", *state); \
+ } \
+ return SCM_INVALID
- /* type check */
- if (FALSEP(ScmOp_numberp(CAR(args))))
- SigScm_ErrorObj("= : number required but got ", CAR(args));
-
- /* Get first value */
- val = SCM_INT_VALUE(CAR(args));
-
- /* compare following value */
- for (args = CDR(args); !NULLP(args); args = CDR(args)) {
- obj = CAR(args);
- if (FALSEP(ScmOp_numberp(obj)))
- SigScm_ErrorObj("= : number required but got ", obj);
-
- if (SCM_INT_VALUE(obj) != val)
- return SCM_FALSE;
- }
-
- return SCM_TRUE;
+ COMPARATOR_BODY(==, "=");
}
-/* TODO: Simplify with SCM_REDUCE*() macro */
-ScmObj ScmOp_less(ScmObj args, ScmObj env )
+ScmObj ScmOp_less(ScmObj left, ScmObj right, enum ScmReductionState *state)
{
- int val = 0;
- int car_val = 0;
- ScmObj obj = SCM_NULL;
-
- if (NULLP(args) || NULLP(CDR(args)))
- SigScm_Error("< : Wrong number of arguments\n");
-
- /* type check */
- if (FALSEP(ScmOp_numberp(CAR(args))))
- SigScm_ErrorObj("< : number required but got ", CAR(args));
-
- /* Get first value */
- val = SCM_INT_VALUE(CAR(args));
-
- /* compare following value */
- for (args = CDR(args); !NULLP(args); args = CDR(args)) {
- obj = CAR(args);
- if (FALSEP(ScmOp_numberp(obj)))
- SigScm_ErrorObj("< : number required but got ", obj);
-
- car_val = SCM_INT_VALUE(obj);
- if (val < car_val)
- val = car_val;
- else
- return SCM_FALSE;
- }
-
- return SCM_TRUE;
+ COMPARATOR_BODY(<, "<");
}
-/* TODO: Simplify with SCM_REDUCE*() macro */
-ScmObj ScmOp_greater(ScmObj args, ScmObj env )
+ScmObj ScmOp_less_eq(ScmObj left, ScmObj right, enum ScmReductionState *state)
{
- int val = 0;
- int car_val = 0;
- ScmObj obj = SCM_NULL;
-
- /* type check */
- if (FALSEP(ScmOp_numberp(CAR(args))))
- SigScm_ErrorObj("> : number required but got ", CAR(args));
-
- /* arglen check */
- if CHECK_2_ARGS(args)
- SigScm_Error("> : Wrong number of arguments\n");
-
- /* Get first value */
- val = SCM_INT_VALUE(CAR(args));
-
- /* compare following value */
- for (args = CDR(args); !NULLP(args); args = CDR(args)) {
- obj = CAR(args);
- if (FALSEP(ScmOp_numberp(obj)))
- SigScm_ErrorObj("> : number required but got ", obj);
-
- car_val = SCM_INT_VALUE(obj);
- if (val > car_val)
- val = car_val;
- else
- return SCM_FALSE;
- }
-
- return SCM_TRUE;
+ COMPARATOR_BODY(<=, "<=");
}
-/* TODO: Simplify with SCM_REDUCE*() macro */
-ScmObj ScmOp_less_eq(ScmObj args, ScmObj env )
+ScmObj ScmOp_greater(ScmObj left, ScmObj right, enum ScmReductionState *state)
{
- int val = 0;
- int car_val = 0;
- ScmObj obj = SCM_NULL;
-
- /* type check */
- if (FALSEP(ScmOp_numberp(CAR(args))))
- SigScm_ErrorObj("<= : number required but got ", CAR(args));
-
- /* arglen check */
- if CHECK_2_ARGS(args)
- SigScm_Error("<= : Wrong number of arguments\n");
-
- /* Get first value */
- val = SCM_INT_VALUE(CAR(args));
-
- /* compare following value */
- obj = SCM_NULL;
- for (args = CDR(args); !NULLP(args); args = CDR(args)) {
- obj = CAR(args);
- if (FALSEP(ScmOp_numberp(obj)))
- SigScm_ErrorObj("<= : number required but got ", obj);
-
- car_val = SCM_INT_VALUE(obj);
- if (val <= car_val)
- val = car_val;
- else
- return SCM_FALSE;
- }
-
- return SCM_TRUE;
+ COMPARATOR_BODY(>, ">");
}
-/* TODO: Simplify with SCM_REDUCE*() macro */
-ScmObj ScmOp_greater_eq(ScmObj args, ScmObj env )
+ScmObj ScmOp_greater_eq(ScmObj left, ScmObj right, enum ScmReductionState *state)
{
- int val = 0;
- int car_val = 0;
- ScmObj obj = SCM_NULL;
-
- /* type check */
- if (FALSEP(ScmOp_numberp(CAR(args))))
- SigScm_ErrorObj(">= : number required but got ", CAR(args));
-
- /* arglen check */
- if CHECK_2_ARGS(args)
- SigScm_Error(">= : Wrong number of arguments\n");
-
- /* Get first value */
- val = SCM_INT_VALUE(CAR(args));
-
- /* compare following value */
- obj = SCM_NULL;
- for (args = CDR(args); !NULLP(args); args = CDR(args)) {
- obj = CAR(args);
- if (FALSEP(ScmOp_numberp(obj)))
- SigScm_ErrorObj(">= : number required but got ", obj);
-
- car_val = SCM_INT_VALUE(obj);
- if (val >= car_val)
- val = car_val;
- else
- return SCM_FALSE;
- }
-
- return SCM_TRUE;
+ COMPARATOR_BODY(>=, ">=");
+#undef COMPARATOR_BODY
}
ScmObj ScmOp_zerop(ScmObj scm_num)
@@ -550,50 +440,28 @@
return (SCM_INT_VALUE(scm_num) & 0x1) ? SCM_FALSE : SCM_TRUE;
}
-/* TODO: Simplify with SCM_REDUCE*() macro */
-ScmObj ScmOp_max(ScmObj args, ScmObj env )
+ScmObj ScmOp_max(ScmObj left, ScmObj right, enum ScmReductionState *state)
{
- int max = 0;
- int val = 0;
- ScmObj scm_num = SCM_NULL;
+ if (*state == SCM_REDUCE_0)
+ SigScm_Error("max : at least 1 argument required\n");
+ if (!INTP(left))
+ SigScm_Error("max : integer required but got ", left);
+ if (!INTP(right))
+ SigScm_Error("max : integer required but got ", right);
- if (NULLP(args))
- SigScm_Error("max : at least 1 number required\n");
-
- for (; !NULLP(args); args = CDR(args)) {
- scm_num = EVAL(CAR(args), env);
- if (FALSEP(ScmOp_numberp(scm_num)))
- SigScm_ErrorObj("max : number required but got ", scm_num);
-
- val = SCM_INT_VALUE(scm_num);
- if (max < val)
- max = val;
- }
-
- return Scm_NewInt(max);
+ return SCM_INT_VALUE(left) > SCM_INT_VALUE(right) ? left : right;
}
-/* TODO: Simplify with SCM_REDUCE*() macro */
-ScmObj ScmOp_min(ScmObj args, ScmObj env )
+ScmObj ScmOp_min(ScmObj left, ScmObj right, enum ScmReductionState *state)
{
- int min = 0;
- int val = 0;
- ScmObj scm_num = SCM_NULL;
+ if (*state == SCM_REDUCE_0)
+ SigScm_Error("min : at least 1 argument required\n");
+ if (!INTP(left))
+ SigScm_Error("min : integer required but got ", left);
+ if (!INTP(right))
+ SigScm_Error("min : integer required but got ", right);
- if (NULLP(args))
- SigScm_Error("min : at least 1 number required\n");
-
- for (; !NULLP(args); args = CDR(args)) {
- scm_num = EVAL(CAR(args), env);
- if (FALSEP(ScmOp_numberp(scm_num)))
- SigScm_ErrorObj("min : number required but got ", scm_num);
-
- val = SCM_INT_VALUE(scm_num);
- if (val < min)
- min = val;
- }
-
- return Scm_NewInt(min);
+ return SCM_INT_VALUE(left) < SCM_INT_VALUE(right) ? left : right;
}
@@ -1883,15 +1751,8 @@
if (arg_len == 2) {
/* apply func to each item */
for (args = CADR(map_arg); !NULLP(args); args = CDR(args)) {
- /* create proc's arg */
- tmp = CAR(args);
-
- /* create list for "apply" op */
- tmp = SCM_LIST_2(proc,
- CONS(tmp, SCM_NULL));
-
/* apply proc */
- ret = CONS(ScmOp_apply(tmp, env), ret);
+ ret = CONS(Scm_call(proc, LIST_1(CAR(args))), ret);
}
return ScmOp_reverse(ret);
}
@@ -1918,8 +1779,7 @@
arg1 = ScmOp_reverse(arg1);
/* apply proc to arg1 */
- ret = CONS(ScmOp_apply(SCM_LIST_2(proc, arg1), env),
- ret);
+ ret = CONS(Scm_call(proc, arg1), ret);
}
/* never reaches here */
@@ -1980,19 +1840,12 @@
return Scm_NewValuePacket(argl);
}
-/* TODO: Simplify and optimize with SCM_SHIFT_*() macro */
-ScmObj ScmOp_call_with_values(ScmObj argl, ScmObj *envp)
+ScmObj ScmOp_call_with_values(ScmObj producer, ScmObj consumer)
{
ScmObj vals;
- ScmObj cons_wrapper;
- if (CHECK_2_ARGS(argl))
- SigScm_ErrorObj("call-with-values: too few arguments: ", argl);
+ vals = Scm_call(producer, SCM_NULL);
- /* make the list (producer) and evaluate it */
- cons_wrapper = CONS(CAR(argl), SCM_NULL);
- vals = EVAL(cons_wrapper, *envp);
-
if (!VALUEPACKETP(vals)) {
/* got back a single value */
vals = CONS(vals, SCM_NULL);
@@ -2000,12 +1853,8 @@
/* extract */
vals = SCM_VALUEPACKET_VALUES(vals);
}
-
- /* cons_wrapper would have no chance of being referenced from
- * anywhere else, so we'll reuse that object. */
- SET_CAR(cons_wrapper, CADR(argl));
- SET_CDR(cons_wrapper, vals);
- return cons_wrapper;
+
+ return Scm_call(consumer, vals);
}
#if SCM_USE_SRFI1
Modified: branches/r5rs/sigscheme/runtest.sh
===================================================================
--- branches/r5rs/sigscheme/runtest.sh 2005-09-25 06:00:01 UTC (rev 1579)
+++ branches/r5rs/sigscheme/runtest.sh 2005-09-25 11:43:52 UTC (rev 1580)
@@ -6,6 +6,7 @@
do
echo "Running test $test..."
./sscm $test
+ echo ; echo
done
echo "[ Run Test ported from Gauche ]"
@@ -13,6 +14,7 @@
do
echo "Running test $test..."
./sscm $test
+ echo; echo
done
echo "[ Run SigScheme Test ]"
@@ -20,4 +22,5 @@
do
echo "Running test $test..."
./sscm $test
+ echo ; echo
done
Modified: branches/r5rs/sigscheme/sigscheme.c
===================================================================
--- branches/r5rs/sigscheme/sigscheme.c 2005-09-25 06:00:01 UTC (rev 1579)
+++ branches/r5rs/sigscheme/sigscheme.c 2005-09-25 11:43:52 UTC (rev 1580)
@@ -62,7 +62,7 @@
static void SigScm_Initialize_internal(void);
#endif
-static void Scm_RegisterFunc(const char *name, enum ScmFuncTypeCode type, ScmFuncType func);
+static int Scm_RegisterFunc(const char *name, ScmFuncType func, enum ScmFuncTypeCode type);
ScmObj SigScm_null, SigScm_true, SigScm_false, SigScm_eof;
ScmObj SigScm_quote, SigScm_quasiquote, SigScm_unquote, SigScm_unquote_splicing;
@@ -147,26 +147,26 @@
Export Scheme Functions
=======================================================================*/
/* eval.c */
- Scm_RegisterFunc2("eval" , ScmOp_eval);
- Scm_RegisterFuncEvaledList("apply" , ScmOp_apply);
- Scm_RegisterFuncRawList("quote" , ScmOp_quote);
- Scm_RegisterFuncRawList("lambda" , ScmExp_lambda);
- Scm_RegisterFuncRawList("set!" , ScmExp_set);
- Scm_RegisterFuncRawList("delay" , ScmOp_delay);
- Scm_RegisterFuncRawList("quasiquote" , ScmOp_quasiquote);
- Scm_RegisterFuncRawList("unquote" , ScmOp_unquote);
- Scm_RegisterFuncRawList("unquote-splicing" , ScmOp_unquote_splicing);
- Scm_RegisterFuncRawList("define" , ScmExp_define);
- Scm_RegisterFuncRawListTailRec("if" , ScmExp_if);
- Scm_RegisterFuncRawListTailRec("cond" , ScmExp_cond);
- Scm_RegisterFuncRawListTailRec("case" , ScmExp_case);
- Scm_RegisterFuncRawListTailRec("let" , ScmExp_let);
- Scm_RegisterFuncRawListTailRec("let*" , ScmExp_let_star);
- Scm_RegisterFuncRawListTailRec("letrec" , ScmExp_letrec);
- Scm_RegisterFuncRawListTailRec("begin" , ScmExp_begin);
- Scm_RegisterFuncRawListTailRec("do" , ScmExp_do);
- Scm_RegisterFuncRawListWithTailFlag("and" , ScmExp_and);
- Scm_RegisterFuncRawListWithTailFlag("or" , ScmExp_or);
+ Scm_RegisterProcedureFixed2("eval" , ScmOp_eval);
+ Scm_RegisterProcedureVariadicTailRec2("apply" , ScmOp_apply);
+ Scm_RegisterSyntaxFixed1("quote" , ScmOp_quote);
+ Scm_RegisterSyntaxVariadic0("lambda" , ScmExp_lambda);
+ Scm_RegisterSyntaxFixed2("set!" , ScmExp_set);
+ Scm_RegisterSyntaxFixed1("delay" , ScmOp_delay);
+ Scm_RegisterSyntaxFixed1("quasiquote" , ScmOp_quasiquote);
+ Scm_RegisterSyntaxFixed1("unquote" , ScmOp_unquote);
+ Scm_RegisterSyntaxFixed1("unquote-splicing" , ScmOp_unquote_splicing);
+ Scm_RegisterSyntaxVariadic1("define" , ScmExp_define);
+ Scm_RegisterSyntaxVariadicTailRec2("if" , ScmExp_if);
+ Scm_RegisterSyntaxVariadicTailRec0("cond" , ScmExp_cond); /* FIXME */
+ Scm_RegisterSyntaxVariadicTailRec0("case" , ScmExp_case); /* FIXME */
+ Scm_RegisterSyntaxVariadicTailRec0("let" , ScmExp_let); /* FIXME */
+ Scm_RegisterSyntaxVariadicTailRec0("let*" , ScmExp_let_star); /* FIXME */
+ Scm_RegisterSyntaxVariadicTailRec0("letrec" , ScmExp_letrec); /* FIXME */
+ Scm_RegisterSyntaxVariadicTailRec0("begin" , ScmExp_begin);
+ Scm_RegisterSyntaxVariadicTailRec0("do" , ScmExp_do); /* FIXME */
+ Scm_RegisterSyntaxVariadicTailRec0("and" , ScmExp_and);
+ Scm_RegisterSyntaxVariadicTailRec0("or" , ScmExp_or);
Scm_RegisterFunc1("scheme-report-environment", ScmOp_scheme_report_environment);
Scm_RegisterFunc1("null-environment" , ScmOp_null_environment);
Scm_RegisterFunc0("interaction-environment" , ScmOp_interaction_environment);
@@ -176,22 +176,22 @@
Scm_RegisterFunc2("equal?" , ScmOp_equalp);
Scm_RegisterFunc1("number?" , ScmOp_numberp);
SCM_DEFINE_ALIAS("integer?" , "number?");
- Scm_RegisterFuncEvaledList("=" , ScmOp_equal);
- Scm_RegisterFuncEvaledList("<" , ScmOp_less);
- Scm_RegisterFuncEvaledList(">" , ScmOp_greater);
- Scm_RegisterFuncEvaledList("<=" , ScmOp_less_eq);
- Scm_RegisterFuncEvaledList(">=" , ScmOp_greater_eq);
+ Scm_RegisterReductionOperator("=" , ScmOp_equal);
+ Scm_RegisterReductionOperator("<" , ScmOp_less);
+ Scm_RegisterReductionOperator(">" , ScmOp_greater);
+ Scm_RegisterReductionOperator("<=" , ScmOp_less_eq);
+ Scm_RegisterReductionOperator(">=" , ScmOp_greater_eq);
Scm_RegisterFunc1("zero?" , ScmOp_zerop);
Scm_RegisterFunc1("positive?" , ScmOp_positivep);
Scm_RegisterFunc1("negative?" , ScmOp_negativep);
Scm_RegisterFunc1("odd?" , ScmOp_oddp);
Scm_RegisterFunc1("even?" , ScmOp_evenp);
- Scm_RegisterFuncRawList("max" , ScmOp_max);
- Scm_RegisterFuncRawList("min" , ScmOp_min);
- Scm_RegisterFuncRawList("+" , ScmOp_add);
- Scm_RegisterFuncRawList("*" , ScmOp_multiply);
- Scm_RegisterFuncRawList("-" , ScmOp_subtract);
- Scm_RegisterFuncRawList("/" , ScmOp_divide);
+ Scm_RegisterReductionOperator("max" , ScmOp_max);
+ Scm_RegisterReductionOperator("min" , ScmOp_min);
+ Scm_RegisterReductionOperator("+" , ScmOp_add);
+ Scm_RegisterReductionOperator("*" , ScmOp_multiply);
+ Scm_RegisterReductionOperator("-" , ScmOp_subtract);
+ Scm_RegisterReductionOperator("/" , ScmOp_divide);
Scm_RegisterFunc1("abs" , ScmOp_abs);
Scm_RegisterFunc2("quotient" , ScmOp_quotient);
Scm_RegisterFunc2("modulo" , ScmOp_modulo);
@@ -288,7 +288,7 @@
Scm_RegisterFuncEvaledList("force" , ScmOp_force);
Scm_RegisterFuncEvaledList("values" , ScmOp_values);
Scm_RegisterFuncEvaledList("call-with-current-continuation", ScmOp_call_with_current_continuation);
- Scm_RegisterFuncRawListTailRec("call-with-values" , ScmOp_call_with_values);
+ Scm_RegisterProcedureFixed2("call-with-values" , ScmOp_call_with_values);
/* io.c */
Scm_RegisterFunc2("call-with-input-file" , ScmOp_call_with_input_file);
Scm_RegisterFunc2("call-with-output-file" , ScmOp_call_with_output_file);
@@ -370,13 +370,13 @@
/*=======================================================================
SRFI-8 Procedure
=======================================================================*/
- Scm_RegisterFuncRawListTailRec("receive", ScmOp_SRFI8_receive);
+ Scm_RegisterSyntaxVariadicTailRec2("receive", ScmOp_SRFI8_receive);
#endif
#if SCM_USE_SRFI23
/*=======================================================================
SRFI-23 Procedure
=======================================================================*/
- Scm_RegisterFuncEvaledList("error", ScmOp_SRFI23_error);
+ Scm_RegisterProcedureVariadic1("error", ScmOp_SRFI23_error);
#endif
#if SCM_USE_SRFI38
/*=======================================================================
@@ -410,7 +410,10 @@
Scm_RegisterFunc1("symbol-bound?" , ScmOp_symbol_boundp);
Scm_RegisterFunc1("symbol-value" , ScmOp_symbol_value);
Scm_RegisterFunc2("set-symbol-value!" , ScmOp_set_symbol_value);
-#if SCM_COMPAT_SIOD_BUGS
+#if 0
+ /*SCM_COMPAT_SIOD_BUGS*/
+ /* Is this necessary? This procedure's functionality is a full
+ subset of what's specified by R5RS. */
Scm_RegisterFunc2("=" , ScmOp_siod_eql);
#endif
SCM_DEFINE_ALIAS("bit-and" , "logand");
@@ -433,60 +436,952 @@
/*===========================================================================
Scheme Function Export Related Functions
===========================================================================*/
-static void Scm_RegisterFunc(const char *name, enum ScmFuncTypeCode type, ScmFuncType c_func)
+static int Scm_RegisterFunc(const char *name, ScmFuncType c_func, enum ScmFuncTypeCode type)
{
ScmObj sym = Scm_Intern(name);
ScmObj func = Scm_NewFunc(type, c_func);
+ /* TODO: reject bad TYPE */
SCM_SYMBOL_SET_VCELL(sym, func);
+ return 1;
}
+/* Not implemented yet. */
+void Scm_RegisterReductionOperator(const char *name, ScmObj (*func)(ScmObj, ScmObj, enum ScmReductionState*))
+{
+ Scm_RegisterFunc(name, func, SCM_REDUCTION_OPERATOR);
+}
+
+/* So, yeah, um... this isn't really such a big deal if you think
+ * about W32.... */
+void Scm_RegisterSyntaxFixed0(const char *name, ScmObj (*func)(ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_FIXED | 0);
+}
+
+#if SCM_FUNCTYPE_MAND_MAX >= 1
+void Scm_RegisterSyntaxFixed1(const char *name, ScmObj (*func)(ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_FIXED | 1);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 2
+void Scm_RegisterSyntaxFixed2(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_FIXED | 2);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 3
+void Scm_RegisterSyntaxFixed3(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_FIXED | 3);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 4
+void Scm_RegisterSyntaxFixed4(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_FIXED | 4);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 5
+void Scm_RegisterSyntaxFixed5(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_FIXED | 5);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 6
+void Scm_RegisterSyntaxFixed6(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_FIXED | 6);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 7
+void Scm_RegisterSyntaxFixed7(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_FIXED | 7);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 8
+void Scm_RegisterSyntaxFixed8(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_FIXED | 8);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 9
+void Scm_RegisterSyntaxFixed9(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_FIXED | 9);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 10
+void Scm_RegisterSyntaxFixed10(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_FIXED | 10);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 11
+void Scm_RegisterSyntaxFixed11(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_FIXED | 11);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 12
+void Scm_RegisterSyntaxFixed12(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_FIXED | 12);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 13
+void Scm_RegisterSyntaxFixed13(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_FIXED | 13);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 14
+void Scm_RegisterSyntaxFixed14(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_FIXED | 14);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 15
+void Scm_RegisterSyntaxFixed15(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_FIXED | 15);
+}
+#endif
+
+void Scm_RegisterSyntaxFixedTailRec0(const char *name, ScmObj (*func)(ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_FIXED_TAIL_REC | 0);
+}
+
+#if SCM_FUNCTYPE_MAND_MAX >= 1
+void Scm_RegisterSyntaxFixedTailRec1(const char *name, ScmObj (*func)(ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_FIXED_TAIL_REC | 1);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 2
+void Scm_RegisterSyntaxFixedTailRec2(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_FIXED_TAIL_REC | 2);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 3
+void Scm_RegisterSyntaxFixedTailRec3(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_FIXED_TAIL_REC | 3);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 4
+void Scm_RegisterSyntaxFixedTailRec4(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_FIXED_TAIL_REC | 4);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 5
+void Scm_RegisterSyntaxFixedTailRec5(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_FIXED_TAIL_REC | 5);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 6
+void Scm_RegisterSyntaxFixedTailRec6(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_FIXED_TAIL_REC | 6);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 7
+void Scm_RegisterSyntaxFixedTailRec7(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_FIXED_TAIL_REC | 7);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 8
+void Scm_RegisterSyntaxFixedTailRec8(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_FIXED_TAIL_REC | 8);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 9
+void Scm_RegisterSyntaxFixedTailRec9(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_FIXED_TAIL_REC | 9);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 10
+void Scm_RegisterSyntaxFixedTailRec10(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_FIXED_TAIL_REC | 10);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 11
+void Scm_RegisterSyntaxFixedTailRec11(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_FIXED_TAIL_REC | 11);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 12
+void Scm_RegisterSyntaxFixedTailRec12(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_FIXED_TAIL_REC | 12);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 13
+void Scm_RegisterSyntaxFixedTailRec13(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_FIXED_TAIL_REC | 13);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 14
+void Scm_RegisterSyntaxFixedTailRec14(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_FIXED_TAIL_REC | 14);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 15
+void Scm_RegisterSyntaxFixedTailRec15(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_FIXED_TAIL_REC | 15);
+}
+#endif
+
+void Scm_RegisterSyntaxVariadic0(const char *name, ScmObj (*func)(ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_VARIADIC | 0);
+}
+
+#if SCM_FUNCTYPE_MAND_MAX >= 1
+void Scm_RegisterSyntaxVariadic1(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_VARIADIC | 1);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 2
+void Scm_RegisterSyntaxVariadic2(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_VARIADIC | 2);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 3
+void Scm_RegisterSyntaxVariadic3(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_VARIADIC | 3);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 4
+void Scm_RegisterSyntaxVariadic4(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_VARIADIC | 4);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 5
+void Scm_RegisterSyntaxVariadic5(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_VARIADIC | 5);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 6
+void Scm_RegisterSyntaxVariadic6(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_VARIADIC | 6);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 7
+void Scm_RegisterSyntaxVariadic7(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_VARIADIC | 7);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 8
+void Scm_RegisterSyntaxVariadic8(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_VARIADIC | 8);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 9
+void Scm_RegisterSyntaxVariadic9(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_VARIADIC | 9);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 10
+void Scm_RegisterSyntaxVariadic10(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_VARIADIC | 10);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 11
+void Scm_RegisterSyntaxVariadic11(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_VARIADIC | 11);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 12
+void Scm_RegisterSyntaxVariadic12(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_VARIADIC | 12);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 13
+void Scm_RegisterSyntaxVariadic13(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_VARIADIC | 13);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 14
+void Scm_RegisterSyntaxVariadic14(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_VARIADIC | 14);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 15
+void Scm_RegisterSyntaxVariadic15(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_VARIADIC | 15);
+}
+#endif
+
+void Scm_RegisterSyntaxVariadicTailRec0(const char *name, ScmObj (*func)(ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_VARIADIC_TAIL_REC | 0);
+}
+
+#if SCM_FUNCTYPE_MAND_MAX >= 1
+void Scm_RegisterSyntaxVariadicTailRec1(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_VARIADIC_TAIL_REC | 1);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 2
+void Scm_RegisterSyntaxVariadicTailRec2(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_VARIADIC_TAIL_REC | 2);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 3
+void Scm_RegisterSyntaxVariadicTailRec3(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_VARIADIC_TAIL_REC | 3);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 4
+void Scm_RegisterSyntaxVariadicTailRec4(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_VARIADIC_TAIL_REC | 4);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 5
+void Scm_RegisterSyntaxVariadicTailRec5(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_VARIADIC_TAIL_REC | 5);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 6
+void Scm_RegisterSyntaxVariadicTailRec6(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_VARIADIC_TAIL_REC | 6);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 7
+void Scm_RegisterSyntaxVariadicTailRec7(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_VARIADIC_TAIL_REC | 7);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 8
+void Scm_RegisterSyntaxVariadicTailRec8(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_VARIADIC_TAIL_REC | 8);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 9
+void Scm_RegisterSyntaxVariadicTailRec9(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_VARIADIC_TAIL_REC | 9);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 10
+void Scm_RegisterSyntaxVariadicTailRec10(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_VARIADIC_TAIL_REC | 10);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 11
+void Scm_RegisterSyntaxVariadicTailRec11(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_VARIADIC_TAIL_REC | 11);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 12
+void Scm_RegisterSyntaxVariadicTailRec12(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_VARIADIC_TAIL_REC | 12);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 13
+void Scm_RegisterSyntaxVariadicTailRec13(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_VARIADIC_TAIL_REC | 13);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 14
+void Scm_RegisterSyntaxVariadicTailRec14(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_VARIADIC_TAIL_REC | 14);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 15
+void Scm_RegisterSyntaxVariadicTailRec15(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_SYNTAX_VARIADIC_TAIL_REC | 15);
+}
+#endif
+
+void Scm_RegisterProcedureFixed0(const char *name, ScmObj (*func)())
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_FIXED | 0);
+}
+
+#if SCM_FUNCTYPE_MAND_MAX >= 1
+void Scm_RegisterProcedureFixed1(const char *name, ScmObj (*func)(ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_FIXED | 1);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 2
+void Scm_RegisterProcedureFixed2(const char *name, ScmObj (*func)(ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_FIXED | 2);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 3
+void Scm_RegisterProcedureFixed3(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_FIXED | 3);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 4
+void Scm_RegisterProcedureFixed4(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_FIXED | 4);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 5
+void Scm_RegisterProcedureFixed5(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_FIXED | 5);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 6
+void Scm_RegisterProcedureFixed6(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_FIXED | 6);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 7
+void Scm_RegisterProcedureFixed7(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_FIXED | 7);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 8
+void Scm_RegisterProcedureFixed8(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_FIXED | 8);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 9
+void Scm_RegisterProcedureFixed9(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_FIXED | 9);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 10
+void Scm_RegisterProcedureFixed10(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_FIXED | 10);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 11
+void Scm_RegisterProcedureFixed11(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_FIXED | 11);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 12
+void Scm_RegisterProcedureFixed12(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_FIXED | 12);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 13
+void Scm_RegisterProcedureFixed13(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_FIXED | 13);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 14
+void Scm_RegisterProcedureFixed14(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_FIXED | 14);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 15
+void Scm_RegisterProcedureFixed15(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_FIXED | 15);
+}
+#endif
+
+void Scm_RegisterProcedureFixedTailRec0(const char *name, ScmObj (*func)(ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_FIXED_TAIL_REC | 0);
+}
+
+#if SCM_FUNCTYPE_MAND_MAX >= 1
+void Scm_RegisterProcedureFixedTailRec1(const char *name, ScmObj (*func)(ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_FIXED_TAIL_REC | 1);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 2
+void Scm_RegisterProcedureFixedTailRec2(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_FIXED_TAIL_REC | 2);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 3
+void Scm_RegisterProcedureFixedTailRec3(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_FIXED_TAIL_REC | 3);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 4
+void Scm_RegisterProcedureFixedTailRec4(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_FIXED_TAIL_REC | 4);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 5
+void Scm_RegisterProcedureFixedTailRec5(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_FIXED_TAIL_REC | 5);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 6
+void Scm_RegisterProcedureFixedTailRec6(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_FIXED_TAIL_REC | 6);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 7
+void Scm_RegisterProcedureFixedTailRec7(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_FIXED_TAIL_REC | 7);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 8
+void Scm_RegisterProcedureFixedTailRec8(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_FIXED_TAIL_REC | 8);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 9
+void Scm_RegisterProcedureFixedTailRec9(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_FIXED_TAIL_REC | 9);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 10
+void Scm_RegisterProcedureFixedTailRec10(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_FIXED_TAIL_REC | 10);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 11
+void Scm_RegisterProcedureFixedTailRec11(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_FIXED_TAIL_REC | 11);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 12
+void Scm_RegisterProcedureFixedTailRec12(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_FIXED_TAIL_REC | 12);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 13
+void Scm_RegisterProcedureFixedTailRec13(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_FIXED_TAIL_REC | 13);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 14
+void Scm_RegisterProcedureFixedTailRec14(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_FIXED_TAIL_REC | 14);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 15
+void Scm_RegisterProcedureFixedTailRec15(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_FIXED_TAIL_REC | 15);
+}
+#endif
+
+void Scm_RegisterProcedureVariadic0(const char *name, ScmObj (*func)(ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_VARIADIC | 0);
+}
+
+#if SCM_FUNCTYPE_MAND_MAX >= 1
+void Scm_RegisterProcedureVariadic1(const char *name, ScmObj (*func)(ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_VARIADIC | 1);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 2
+void Scm_RegisterProcedureVariadic2(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_VARIADIC | 2);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 3
+void Scm_RegisterProcedureVariadic3(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_VARIADIC | 3);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 4
+void Scm_RegisterProcedureVariadic4(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_VARIADIC | 4);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 5
+void Scm_RegisterProcedureVariadic5(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_VARIADIC | 5);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 6
+void Scm_RegisterProcedureVariadic6(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_VARIADIC | 6);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 7
+void Scm_RegisterProcedureVariadic7(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_VARIADIC | 7);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 8
+void Scm_RegisterProcedureVariadic8(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_VARIADIC | 8);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 9
+void Scm_RegisterProcedureVariadic9(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_VARIADIC | 9);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 10
+void Scm_RegisterProcedureVariadic10(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_VARIADIC | 10);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 11
+void Scm_RegisterProcedureVariadic11(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_VARIADIC | 11);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 12
+void Scm_RegisterProcedureVariadic12(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_VARIADIC | 12);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 13
+void Scm_RegisterProcedureVariadic13(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_VARIADIC | 13);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 14
+void Scm_RegisterProcedureVariadic14(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_VARIADIC | 14);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 15
+void Scm_RegisterProcedureVariadic15(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_VARIADIC | 15);
+}
+#endif
+
+void Scm_RegisterProcedureVariadicTailRec0(const char *name, ScmObj (*func)(ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_VARIADIC_TAIL_REC | 0);
+}
+
+#if SCM_FUNCTYPE_MAND_MAX >= 1
+void Scm_RegisterProcedureVariadicTailRec1(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_VARIADIC_TAIL_REC | 1);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 2
+void Scm_RegisterProcedureVariadicTailRec2(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_VARIADIC_TAIL_REC | 2);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 3
+void Scm_RegisterProcedureVariadicTailRec3(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_VARIADIC_TAIL_REC | 3);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 4
+void Scm_RegisterProcedureVariadicTailRec4(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_VARIADIC_TAIL_REC | 4);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 5
+void Scm_RegisterProcedureVariadicTailRec5(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_VARIADIC_TAIL_REC | 5);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 6
+void Scm_RegisterProcedureVariadicTailRec6(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_VARIADIC_TAIL_REC | 6);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 7
+void Scm_RegisterProcedureVariadicTailRec7(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_VARIADIC_TAIL_REC | 7);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 8
+void Scm_RegisterProcedureVariadicTailRec8(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_VARIADIC_TAIL_REC | 8);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 9
+void Scm_RegisterProcedureVariadicTailRec9(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_VARIADIC_TAIL_REC | 9);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 10
+void Scm_RegisterProcedureVariadicTailRec10(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_VARIADIC_TAIL_REC | 10);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 11
+void Scm_RegisterProcedureVariadicTailRec11(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_VARIADIC_TAIL_REC | 11);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 12
+void Scm_RegisterProcedureVariadicTailRec12(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_VARIADIC_TAIL_REC | 12);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 13
+void Scm_RegisterProcedureVariadicTailRec13(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_VARIADIC_TAIL_REC | 13);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 14
+void Scm_RegisterProcedureVariadicTailRec14(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_VARIADIC_TAIL_REC | 14);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 15
+void Scm_RegisterProcedureVariadicTailRec15(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ Scm_RegisterFunc(name, func, SCM_PROCEDURE_VARIADIC_TAIL_REC | 15);
+}
+#endif
+
+
+/* Left for compatibility only. To be removed after complete transition. */
void Scm_RegisterFunc0(const char *name, ScmFuncType0 func)
{
- Scm_RegisterFunc(name, FUNCTYPE_0, func);
+ Scm_RegisterFunc(name, func, FUNCTYPE_0);
}
void Scm_RegisterFunc1(const char *name, ScmFuncType1 func)
{
- Scm_RegisterFunc(name, FUNCTYPE_1, func);
+ Scm_RegisterFunc(name, func, FUNCTYPE_1);
}
void Scm_RegisterFunc2(const char *name, ScmFuncType2 func)
{
- Scm_RegisterFunc(name, FUNCTYPE_2, func);
+ Scm_RegisterFunc(name, func, FUNCTYPE_2);
}
void Scm_RegisterFunc3(const char *name, ScmFuncType3 func)
{
- Scm_RegisterFunc(name, FUNCTYPE_3, func);
+ Scm_RegisterFunc(name, func, FUNCTYPE_3);
}
void Scm_RegisterFunc4(const char *name, ScmFuncType4 func)
{
- Scm_RegisterFunc(name, FUNCTYPE_4, func);
+ Scm_RegisterFunc(name, func, FUNCTYPE_4);
}
void Scm_RegisterFunc5(const char *name, ScmFuncType5 func)
{
- Scm_RegisterFunc(name, FUNCTYPE_5, func);
+ Scm_RegisterFunc(name, func, FUNCTYPE_5);
}
void Scm_RegisterFuncEvaledList(const char *name, ScmFuncTypeEvaledList func)
{
- Scm_RegisterFunc(name, FUNCTYPE_EVALED_LIST, func);
+ Scm_RegisterFunc(name, func, FUNCTYPE_EVALED_LIST);
}
void Scm_RegisterFuncRawList(const char *name, ScmFuncTypeRawList func)
{
- Scm_RegisterFunc(name, FUNCTYPE_RAW_LIST, func);
+ Scm_RegisterFunc(name, func, FUNCTYPE_RAW_LIST);
}
void Scm_RegisterFuncRawListTailRec(const char *name, ScmFuncTypeRawListTailRec func)
{
- Scm_RegisterFunc(name, FUNCTYPE_RAW_LIST_TAIL_REC, func);
+ Scm_RegisterFunc(name, func, FUNCTYPE_RAW_LIST_TAIL_REC);
}
void Scm_RegisterFuncRawListWithTailFlag(const char *name, ScmFuncTypeRawListWithTailFlag func)
{
- Scm_RegisterFunc(name, FUNCTYPE_RAW_LIST_WITH_TAIL_FLAG, func);
+ Scm_RegisterFunc(name, func, FUNCTYPE_RAW_LIST_WITH_TAIL_FLAG);
}
Modified: branches/r5rs/sigscheme/sigscheme.h
===================================================================
--- branches/r5rs/sigscheme/sigscheme.h 2005-09-25 06:00:01 UTC (rev 1579)
+++ branches/r5rs/sigscheme/sigscheme.h 2005-09-25 11:43:52 UTC (rev 1580)
@@ -76,6 +76,7 @@
#define SCM_ACCESSOR_ASSERT 0 /* enable strict type check with accessor */
#define SCM_GCC4_READY_GC 1 /* use experimental gcc4-ready stack protection */
#define SCM_USE_VALUECONS 0 /* use experimental values passing */
+#define SCM_VOLATILE_OUTPUT 0 /* always flush files on write */
/* dependency resolution */
#if SCM_COMPAT_SIOD
@@ -173,6 +174,377 @@
/* sigscheme.c */
void SigScm_Initialize(void);
void SigScm_Finalize(void);
+void Scm_RegisterReductionOperator(const char *name, ScmObj (*func)(ScmObj, ScmObj, enum ScmReductionState*));
+void Scm_RegisterSyntaxFixed0(const char *name, ScmObj (*func)(ScmObj));
+#if SCM_FUNCTYPE_MAND_MAX >= 1
+void Scm_RegisterSyntaxFixed1(const char *name, ScmObj (*func)(ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 2
+void Scm_RegisterSyntaxFixed2(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 3
+void Scm_RegisterSyntaxFixed3(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 4
+void Scm_RegisterSyntaxFixed4(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 5
+void Scm_RegisterSyntaxFixed5(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 6
+void Scm_RegisterSyntaxFixed6(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 7
+void Scm_RegisterSyntaxFixed7(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 8
+void Scm_RegisterSyntaxFixed8(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 9
+void Scm_RegisterSyntaxFixed9(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 10
+void Scm_RegisterSyntaxFixed10(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 11
+void Scm_RegisterSyntaxFixed11(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 12
+void Scm_RegisterSyntaxFixed12(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 13
+void Scm_RegisterSyntaxFixed13(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 14
+void Scm_RegisterSyntaxFixed14(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 15
+void Scm_RegisterSyntaxFixed15(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+void Scm_RegisterSyntaxFixedTailRec0(const char *name, ScmObj (*func)(ScmEvalState*));
+#if SCM_FUNCTYPE_MAND_MAX >= 1
+void Scm_RegisterSyntaxFixedTailRec1(const char *name, ScmObj (*func)(ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 2
+void Scm_RegisterSyntaxFixedTailRec2(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 3
+void Scm_RegisterSyntaxFixedTailRec3(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 4
+void Scm_RegisterSyntaxFixedTailRec4(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 5
+void Scm_RegisterSyntaxFixedTailRec5(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 6
+void Scm_RegisterSyntaxFixedTailRec6(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 7
+void Scm_RegisterSyntaxFixedTailRec7(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 8
+void Scm_RegisterSyntaxFixedTailRec8(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 9
+void Scm_RegisterSyntaxFixedTailRec9(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 10
+void Scm_RegisterSyntaxFixedTailRec10(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 11
+void Scm_RegisterSyntaxFixedTailRec11(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 12
+void Scm_RegisterSyntaxFixedTailRec12(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 13
+void Scm_RegisterSyntaxFixedTailRec13(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 14
+void Scm_RegisterSyntaxFixedTailRec14(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 15
+void Scm_RegisterSyntaxFixedTailRec15(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+void Scm_RegisterSyntaxVariadic0(const char *name, ScmObj (*func)(ScmObj, ScmObj));
+#if SCM_FUNCTYPE_MAND_MAX >= 1
+void Scm_RegisterSyntaxVariadic1(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 2
+void Scm_RegisterSyntaxVariadic2(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 3
+void Scm_RegisterSyntaxVariadic3(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 4
+void Scm_RegisterSyntaxVariadic4(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 5
+void Scm_RegisterSyntaxVariadic5(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 6
+void Scm_RegisterSyntaxVariadic6(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 7
+void Scm_RegisterSyntaxVariadic7(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 8
+void Scm_RegisterSyntaxVariadic8(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 9
+void Scm_RegisterSyntaxVariadic9(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 10
+void Scm_RegisterSyntaxVariadic10(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 11
+void Scm_RegisterSyntaxVariadic11(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 12
+void Scm_RegisterSyntaxVariadic12(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 13
+void Scm_RegisterSyntaxVariadic13(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 14
+void Scm_RegisterSyntaxVariadic14(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 15
+void Scm_RegisterSyntaxVariadic15(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+void Scm_RegisterSyntaxVariadicTailRec0(const char *name, ScmObj (*func)(ScmObj, ScmEvalState*));
+#if SCM_FUNCTYPE_MAND_MAX >= 1
+void Scm_RegisterSyntaxVariadicTailRec1(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 2
+void Scm_RegisterSyntaxVariadicTailRec2(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 3
+void Scm_RegisterSyntaxVariadicTailRec3(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 4
+void Scm_RegisterSyntaxVariadicTailRec4(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 5
+void Scm_RegisterSyntaxVariadicTailRec5(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 6
+void Scm_RegisterSyntaxVariadicTailRec6(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 7
+void Scm_RegisterSyntaxVariadicTailRec7(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 8
+void Scm_RegisterSyntaxVariadicTailRec8(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 9
+void Scm_RegisterSyntaxVariadicTailRec9(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 10
+void Scm_RegisterSyntaxVariadicTailRec10(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 11
+void Scm_RegisterSyntaxVariadicTailRec11(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 12
+void Scm_RegisterSyntaxVariadicTailRec12(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 13
+void Scm_RegisterSyntaxVariadicTailRec13(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 14
+void Scm_RegisterSyntaxVariadicTailRec14(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 15
+void Scm_RegisterSyntaxVariadicTailRec15(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+void Scm_RegisterProcedureFixed0(const char *name, ScmObj (*func)());
+#if SCM_FUNCTYPE_MAND_MAX >= 1
+void Scm_RegisterProcedureFixed1(const char *name, ScmObj (*func)(ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 2
+void Scm_RegisterProcedureFixed2(const char *name, ScmObj (*func)(ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 3
+void Scm_RegisterProcedureFixed3(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 4
+void Scm_RegisterProcedureFixed4(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 5
+void Scm_RegisterProcedureFixed5(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 6
+void Scm_RegisterProcedureFixed6(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 7
+void Scm_RegisterProcedureFixed7(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 8
+void Scm_RegisterProcedureFixed8(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 9
+void Scm_RegisterProcedureFixed9(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 10
+void Scm_RegisterProcedureFixed10(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 11
+void Scm_RegisterProcedureFixed11(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 12
+void Scm_RegisterProcedureFixed12(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 13
+void Scm_RegisterProcedureFixed13(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 14
+void Scm_RegisterProcedureFixed14(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 15
+void Scm_RegisterProcedureFixed15(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+void Scm_RegisterProcedureFixedTailRec0(const char *name, ScmObj (*func)(ScmEvalState*));
+#if SCM_FUNCTYPE_MAND_MAX >= 1
+void Scm_RegisterProcedureFixedTailRec1(const char *name, ScmObj (*func)(ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 2
+void Scm_RegisterProcedureFixedTailRec2(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 3
+void Scm_RegisterProcedureFixedTailRec3(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 4
+void Scm_RegisterProcedureFixedTailRec4(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 5
+void Scm_RegisterProcedureFixedTailRec5(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 6
+void Scm_RegisterProcedureFixedTailRec6(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 7
+void Scm_RegisterProcedureFixedTailRec7(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 8
+void Scm_RegisterProcedureFixedTailRec8(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 9
+void Scm_RegisterProcedureFixedTailRec9(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 10
+void Scm_RegisterProcedureFixedTailRec10(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 11
+void Scm_RegisterProcedureFixedTailRec11(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 12
+void Scm_RegisterProcedureFixedTailRec12(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 13
+void Scm_RegisterProcedureFixedTailRec13(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 14
+void Scm_RegisterProcedureFixedTailRec14(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 15
+void Scm_RegisterProcedureFixedTailRec15(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+void Scm_RegisterProcedureVariadic0(const char *name, ScmObj (*func)(ScmObj));
+#if SCM_FUNCTYPE_MAND_MAX >= 1
+void Scm_RegisterProcedureVariadic1(const char *name, ScmObj (*func)(ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 2
+void Scm_RegisterProcedureVariadic2(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 3
+void Scm_RegisterProcedureVariadic3(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 4
+void Scm_RegisterProcedureVariadic4(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 5
+void Scm_RegisterProcedureVariadic5(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 6
+void Scm_RegisterProcedureVariadic6(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 7
+void Scm_RegisterProcedureVariadic7(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 8
+void Scm_RegisterProcedureVariadic8(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 9
+void Scm_RegisterProcedureVariadic9(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 10
+void Scm_RegisterProcedureVariadic10(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 11
+void Scm_RegisterProcedureVariadic11(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 12
+void Scm_RegisterProcedureVariadic12(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 13
+void Scm_RegisterProcedureVariadic13(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 14
+void Scm_RegisterProcedureVariadic14(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 15
+void Scm_RegisterProcedureVariadic15(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+#endif
+void Scm_RegisterProcedureVariadicTailRec0(const char *name, ScmObj (*func)(ScmObj, ScmEvalState*));
+#if SCM_FUNCTYPE_MAND_MAX >= 1
+void Scm_RegisterProcedureVariadicTailRec1(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 2
+void Scm_RegisterProcedureVariadicTailRec2(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 3
+void Scm_RegisterProcedureVariadicTailRec3(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 4
+void Scm_RegisterProcedureVariadicTailRec4(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 5
+void Scm_RegisterProcedureVariadicTailRec5(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 6
+void Scm_RegisterProcedureVariadicTailRec6(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 7
+void Scm_RegisterProcedureVariadicTailRec7(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 8
+void Scm_RegisterProcedureVariadicTailRec8(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 9
+void Scm_RegisterProcedureVariadicTailRec9(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 10
+void Scm_RegisterProcedureVariadicTailRec10(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 11
+void Scm_RegisterProcedureVariadicTailRec11(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 12
+void Scm_RegisterProcedureVariadicTailRec12(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 13
+void Scm_RegisterProcedureVariadicTailRec13(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 14
+void Scm_RegisterProcedureVariadicTailRec14(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+#if SCM_FUNCTYPE_MAND_MAX >= 15
+void Scm_RegisterProcedureVariadicTailRec15(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*));
+#endif
+
+/* For compatibility only; slated for removal. */
void Scm_RegisterFunc0(const char *name, ScmFuncType0 func);
void Scm_RegisterFunc1(const char *name, ScmFuncType1 func);
void Scm_RegisterFunc2(const char *name, ScmFuncType2 func);
@@ -237,50 +609,52 @@
/* eval.c */
ScmObj ScmOp_eval(ScmObj obj, ScmObj env);
-ScmObj ScmOp_apply(ScmObj args, ScmObj env);
-ScmObj ScmOp_quote(ScmObj args, ScmObj envp);
+ ScmObj ScmOp_apply(ScmObj proc, ScmObj arg0, ScmObj rest, ScmEvalState *eval_state);
+ ScmObj ScmOp_quote(ScmObj datum, ScmObj env);
ScmObj ScmExp_lambda(ScmObj args, ScmObj env);
-ScmObj ScmExp_if(ScmObj args, ScmObj *envp);
-ScmObj ScmExp_set(ScmObj args, ScmObj env);
-ScmObj ScmExp_cond(ScmObj arg, ScmObj *envp);
-ScmObj ScmExp_case(ScmObj arg, ScmObj *envp);
-ScmObj ScmExp_and(ScmObj arg, ScmObj *envp, int *tail_flag);
-ScmObj ScmExp_or(ScmObj arg, ScmObj *envp, int *tail_flag);
-ScmObj ScmExp_let(ScmObj arg, ScmObj *envp);
-ScmObj ScmExp_let_star(ScmObj arg, ScmObj *envp);
-ScmObj ScmExp_letrec(ScmObj arg, ScmObj *envp);
-ScmObj ScmExp_begin(ScmObj arg, ScmObj *envp);
-ScmObj ScmExp_do(ScmObj arg, ScmObj *envp);
-ScmObj ScmOp_delay(ScmObj args, ScmObj env);
-ScmObj ScmOp_quasiquote(ScmObj obj, ScmObj env);
-ScmObj ScmOp_unquote(ScmObj obj, ScmObj env);
-ScmObj ScmOp_unquote_splicing(ScmObj obj, ScmObj env);
-ScmObj ScmExp_define(ScmObj args, ScmObj env);
+ ScmObj ScmExp_if(ScmObj test, ScmObj conseq, ScmObj rest, ScmEvalState *eval_state);
+ScmObj ScmExp_set(ScmObj var, ScmObj val, ScmObj env);
+ ScmObj ScmExp_cond(ScmObj arg, ScmEvalState *eval_state);
+ ScmObj ScmExp_case(ScmObj arg, ScmEvalState *eval_state);
+ ScmObj ScmExp_and(ScmObj arg, ScmEvalState *eval_state);
+ ScmObj ScmExp_or(ScmObj arg, ScmEvalState *eval_state);
+ ScmObj ScmExp_let(ScmObj arg, ScmEvalState *eval_state);
+ScmObj ScmExp_let_star(ScmObj arg, ScmEvalState *eval_state);
+ScmObj ScmExp_letrec(ScmObj arg, ScmEvalState *eval_state);
+ScmObj ScmExp_begin(ScmObj arg, ScmEvalState *eval_state);
+ScmObj ScmExp_do(ScmObj arg, ScmEvalState *eval_state);
+ScmObj ScmOp_delay(ScmObj expr, ScmObj env);
+ ScmObj ScmOp_quasiquote(ScmObj datum, ScmObj env);
+ ScmObj ScmOp_unquote(ScmObj dummy, ScmObj env);
+ ScmObj ScmOp_unquote_splicing(ScmObj dummy, ScmObj env);
+ScmObj ScmExp_define(ScmObj var, ScmObj rest, ScmObj env);
ScmObj ScmOp_scheme_report_environment(ScmObj version);
ScmObj ScmOp_null_environment(ScmObj version);
ScmObj ScmOp_interaction_environment(void);
+ScmObj Scm_call(ScmObj proc, ScmObj args);
+
/* operations.c */
ScmObj ScmOp_eqvp(ScmObj obj1, ScmObj obj2);
ScmObj ScmOp_eqp(ScmObj obj1, ScmObj obj2);
ScmObj ScmOp_equalp(ScmObj obj1, ScmObj obj2);
-ScmObj ScmOp_add(ScmObj args, ScmObj env);
-ScmObj ScmOp_multiply(ScmObj args, ScmObj env);
-ScmObj ScmOp_subtract(ScmObj args, ScmObj env);
-ScmObj ScmOp_divide(ScmObj args, ScmObj env);
+ScmObj ScmOp_add(ScmObj left, ScmObj right, enum ScmReductionState *state);
+ScmObj ScmOp_subtract(ScmObj left, ScmObj right, enum ScmReductionState *state);
+ScmObj ScmOp_multiply(ScmObj left, ScmObj right, enum ScmReductionState *state);
+ScmObj ScmOp_divide(ScmObj left, ScmObj right, enum ScmReductionState *state);
+ScmObj ScmOp_equal(ScmObj left, ScmObj right, enum ScmReductionState *state);
+ScmObj ScmOp_less(ScmObj left, ScmObj right, enum ScmReductionState *state);
+ScmObj ScmOp_less_eq(ScmObj left, ScmObj right, enum ScmReductionState *state);
+ScmObj ScmOp_greater(ScmObj left, ScmObj right, enum ScmReductionState *state);
+ScmObj ScmOp_greater_eq(ScmObj left, ScmObj right, enum ScmReductionState *state);
ScmObj ScmOp_numberp(ScmObj obj);
-ScmObj ScmOp_equal(ScmObj args, ScmObj env);
-ScmObj ScmOp_less(ScmObj args, ScmObj env );
-ScmObj ScmOp_greater(ScmObj args, ScmObj env );
-ScmObj ScmOp_less_eq(ScmObj args, ScmObj env );
-ScmObj ScmOp_greater_eq(ScmObj args, ScmObj env );
ScmObj ScmOp_zerop(ScmObj scm_num);
ScmObj ScmOp_positivep(ScmObj scm_num);
ScmObj ScmOp_negativep(ScmObj scm_num);
ScmObj ScmOp_oddp(ScmObj scm_num);
ScmObj ScmOp_evenp(ScmObj scm_num);
-ScmObj ScmOp_max(ScmObj args, ScmObj env );
-ScmObj ScmOp_min(ScmObj args, ScmObj env );
+ScmObj ScmOp_max(ScmObj left, ScmObj right, enum ScmReductionState *state);
+ScmObj ScmOp_min(ScmObj left, ScmObj right, enum ScmReductionState *state);
ScmObj ScmOp_abs(ScmObj scm_num);
ScmObj ScmOp_quotient(ScmObj scm_n1, ScmObj scm_n2);
ScmObj ScmOp_modulo(ScmObj scm_n1, ScmObj scm_n2);
@@ -381,7 +755,7 @@
ScmObj ScmOp_force(ScmObj arg, ScmObj env);
ScmObj ScmOp_call_with_current_continuation(ScmObj arg, ScmObj env);
ScmObj ScmOp_values(ScmObj argl, ScmObj env);
-ScmObj ScmOp_call_with_values(ScmObj argl, ScmObj *envp);
+ScmObj ScmOp_call_with_values(ScmObj producer, ScmObj consumer);
/* io.c */
void SigScm_set_lib_path(const char *path);
@@ -485,7 +859,7 @@
#endif
#if SCM_USE_SRFI8
/* operations-srfi8.c */
-ScmObj ScmOp_SRFI8_receive(ScmObj args, ScmObj *envp);
+ScmObj ScmOp_SRFI8_receive(ScmObj formals, ScmObj expr, ScmObj body, ScmEvalState *eval_state);
#endif
#if SCM_USE_SRFI23
/* operations-srfi23.c */
Modified: branches/r5rs/sigscheme/sigschemetype.h
===================================================================
--- branches/r5rs/sigscheme/sigschemetype.h 2005-09-25 06:00:01 UTC (rev 1579)
+++ branches/r5rs/sigscheme/sigschemetype.h 2005-09-25 11:43:52 UTC (rev 1580)
@@ -50,6 +50,7 @@
typedef struct ScmObjInternal_ ScmObjInternal;
typedef ScmObjInternal *ScmObj;
typedef struct _ScmPortInfo ScmPortInfo;
+typedef struct ScmEvalState_ ScmEvalState;
typedef ScmObj (*ScmFuncType)();
typedef ScmObj (*ScmFuncType0)(void);
typedef ScmObj (*ScmFuncType1)(ScmObj arg1);
@@ -59,8 +60,8 @@
typedef ScmObj (*ScmFuncType5)(ScmObj arg1, ScmObj arg2, ScmObj arg3, ScmObj arg4, ScmObj arg5);
typedef ScmObj (*ScmFuncTypeEvaledList)(ScmObj args, ScmObj env);
typedef ScmObj (*ScmFuncTypeRawList)(ScmObj arglist, ScmObj env);
-typedef ScmObj (*ScmFuncTypeRawListTailRec)(ScmObj arglist, ScmObj *envp);
-typedef ScmObj (*ScmFuncTypeRawListWithTailFlag)(ScmObj arglist, ScmObj *envp, int *tail_flag);
+typedef ScmObj (*ScmFuncTypeRawListTailRec)(ScmObj arglist, ScmEvalState *eval_state);
+typedef ScmObj (*ScmFuncTypeRawListWithTailFlag)(ScmObj arglist, ScmEvalState *eval_state);
/*=======================================
Struct Declarations
@@ -140,46 +141,70 @@
/*
* Function types:
- * Built-in functions are classified by required argument type and
- * treatment of return value. The constraints for arguments are shown
- * beside each declaration. Enclosed in [] are examples of functions
- * that are implemented as that type and are likely to stay that way.
- * See the typedefs for the argument list template for each type.
*
- * For FUNCTYPE_0 through 5, the caller checks the number of
- * arguments, and passes only the arguments. For other types,
- * checking is the callee's reponsibility, and they receive the
- * current environment.
- *
- * FUNCTYPE_0 through 5 and FUNCTYPE_EVALED_LIST require the caller to
- * evaluate arguments. Others do it on their own.
- *
- * FUNCTYPE_RAW_LIST_TAIL_REC represents a form that contains tail
- * expressions, which must be evaluated without consuming storage
- * (proper tail recursion). A function of this type returns an
- * S-expression that the caller must evaluate to obtain the resultant
- * value of the entire form. FUNCYTPE_RAW_LIST_WITH_TAIL_FLAG has the
- * same semantics, except that the return value must be evaluated if
- * and only if the callee sets tail_flag (an int passed by reference)
- * to nonzero. The two types receive a *reference* to the effective
- * environment so that they can extend it as necessary.
+ * Function objects must tag themselves with proper information so
+ * that the evaluator can correctly invoke them. See doc/invocation
+ * for details.
*/
enum ScmFuncTypeCode {
- FUNCTYPE_0 = 0, /* 0 arg [current-input-port] */
- FUNCTYPE_1 = 1, /* 1 arg [pair? call/cc symbol->string] */
- FUNCTYPE_2 = 2, /* 2 args [eqv? string-ref] */
- FUNCTYPE_3 = 3, /* 3 args [list-set!] */
- FUNCTYPE_4 = 4, /* 4 args [TODO: is there any?] */
- FUNCTYPE_5 = 5, /* 5 args [TODO: is there any?] */
- FUNCTYPE_EVALED_LIST = 6, /* map_eval()ed arg list [values] */
- FUNCTYPE_RAW_LIST = 7, /* verbatim arg list [quote lambda define] */
- FUNCTYPE_RAW_LIST_TAIL_REC = 8, /* verbatim arg list, returns tail expr
- * (see above) [if let cond case begin] */
- FUNCTYPE_RAW_LIST_WITH_TAIL_FLAG = 9 /* verbatim arg list and tail_flag,
- * may or may not return tail expr
- * (see above) [and or] */
+ SCM_FUNCTYPE_MAND_BITS = 4,
+ SCM_FUNCTYPE_MAND_MASK = (1 << SCM_FUNCTYPE_MAND_BITS)-1,
+#define SCM_FUNCTYPE_MAND_MAX 5
+ /* SCM_FUNCTYPE_MAND_MAX = 5, */
+ SCM_FUNCTYPE_SYNTAX = 1 << SCM_FUNCTYPE_MAND_BITS,
+
+ SCM_FUNCTYPE_FIXED = 0 << (SCM_FUNCTYPE_MAND_BITS+1),
+ SCM_FUNCTYPE_VARIADIC = 1 << (SCM_FUNCTYPE_MAND_BITS+1),
+ SCM_FUNCTYPE_TAIL_REC = 1 << (SCM_FUNCTYPE_MAND_BITS+2),
+
+ SCM_FUNCTYPE_ODDBALL = 1 << (SCM_FUNCTYPE_MAND_BITS+10),
+
+ /* Compound types. */
+ SCM_PROCEDURE_FIXED = SCM_FUNCTYPE_FIXED,
+ SCM_PROCEDURE_FIXED_TAIL_REC = SCM_FUNCTYPE_TAIL_REC,
+ SCM_PROCEDURE_VARIADIC = SCM_FUNCTYPE_VARIADIC,
+ SCM_PROCEDURE_VARIADIC_TAIL_REC = SCM_FUNCTYPE_VARIADIC | SCM_FUNCTYPE_TAIL_REC,
+
+ SCM_SYNTAX_FIXED = SCM_PROCEDURE_FIXED | SCM_FUNCTYPE_SYNTAX,
+ SCM_SYNTAX_FIXED_TAIL_REC = SCM_PROCEDURE_FIXED_TAIL_REC | SCM_FUNCTYPE_SYNTAX,
+ SCM_SYNTAX_VARIADIC = SCM_PROCEDURE_VARIADIC | SCM_FUNCTYPE_SYNTAX,
+ SCM_SYNTAX_VARIADIC_TAIL_REC = SCM_PROCEDURE_VARIADIC_TAIL_REC | SCM_FUNCTYPE_SYNTAX,
+
+ /* Special type. */
+ SCM_REDUCTION_OPERATOR = SCM_FUNCTYPE_ODDBALL
+
+ /* Compatiblility defs. To be nuked after complete transition. */
+ ,
+ FUNCTYPE_0 = SCM_PROCEDURE_FIXED | 0,
+ FUNCTYPE_1 = SCM_PROCEDURE_FIXED | 1,
+ FUNCTYPE_2 = SCM_PROCEDURE_FIXED | 2,
+ FUNCTYPE_3 = SCM_PROCEDURE_FIXED | 3,
+ FUNCTYPE_4 = SCM_PROCEDURE_FIXED | 4,
+ FUNCTYPE_5 = SCM_PROCEDURE_FIXED | 5,
+ FUNCTYPE_EVALED_LIST = SCM_PROCEDURE_VARIADIC | 0,
+ FUNCTYPE_RAW_LIST = SCM_SYNTAX_VARIADIC | 0,
+ FUNCTYPE_RAW_LIST_TAIL_REC = SCM_SYNTAX_VARIADIC,
+ FUNCTYPE_RAW_LIST_WITH_TAIL_FLAG = SCM_FUNCTYPE_TAIL_REC | SCM_FUNCTYPE_SYNTAX
};
+/* Where we are in a reduction process. */
+enum ScmReductionState {
+ SCM_REDUCE_0, /* No argument was given. */
+ SCM_REDUCE_1, /* Only 1 argument was given. */
+ SCM_REDUCE_PARTWAY, /* We have more arguments pending. */
+ SCM_REDUCE_LAST, /* The callee must finalize. */
+ SCM_REDUCE_STOP /* Callee wants to stop. */
+};
+
+/* The evaluator's state */
+struct ScmEvalState_ {
+ ScmObj env;
+ enum {
+ SCM_RETTYPE_AS_IS = 0,
+ SCM_RETTYPE_NEED_EVAL = 1
+ } ret_type;
+};
+
/* Scheme Object */
struct ScmObjInternal_ {
enum ScmObjType type;
@@ -211,40 +236,7 @@
struct {
enum ScmFuncTypeCode type;
- union {
- struct {
- ScmFuncType0 func;
- } subr0;
- struct {
- ScmFuncType1 func;
- } subr1;
- struct {
- ScmFuncType2 func;
- } subr2;
- struct {
- ScmFuncType3 func;
- } subr3;
- struct {
- ScmFuncType4 func;
- } subr4;
- struct {
- ScmFuncType5 func;
- } subr5;
- /* -- these two are identical to subr2
- struct {
- ScmFuncTypeEvaledList func;
- } subr_evaled_list;
- struct {
- ScmFuncTypeRawList func;
- } subr_raw_list;
- */
- struct {
- ScmFuncTypeRawListTailRec func;
- } subrr;
- struct {
- ScmFuncTypeRawListWithTailFlag func;
- } subrf;
- } subrs;
+ ScmFuncType func;
} func;
struct ScmClosure {
@@ -354,7 +346,7 @@
#define SCM_ENTYPE_FUNC(a) (SCM_ENTYPE((a), ScmFunc))
#define SCM_FUNC_TYPECODE(a) (SCM_AS_FUNC(a)->obj.func.type)
#define SCM_FUNC_SET_TYPECODE(a, type) (SCM_FUNC_TYPECODE(a) = (type))
-#define SCM_FUNC_CFUNC(a) (SCM_AS_FUNC(a)->obj.func.subrs.subr0.func)
+#define SCM_FUNC_CFUNC(a) (SCM_AS_FUNC(a)->obj.func.func)
#define SCM_FUNC_SET_CFUNC(a, func) (SCM_FUNC_CFUNC(a) = (ScmFuncType)(func))
#define SCM_FUNC_EXEC_SUBR0(a) ((*(a)->obj.func.subrs.subr0.func) ())
Modified: branches/r5rs/sigscheme/test/test-exp.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-exp.scm 2005-09-25 06:00:01 UTC (rev 1579)
+++ branches/r5rs/sigscheme/test/test-exp.scm 2005-09-25 11:43:52 UTC (rev 1580)
@@ -88,16 +88,19 @@
(assert-equal? "basic let test1" 0 (let ((n 0))
n))
(assert-equal? "basic let test2" 1 (let ((n 0))
- (set! n 1)))
+ (set! n 1)
+ n))
(assert-equal? "basic let test3" 1 (let ((n 0))
- (set! n (+ n 1))))
+ (set! n (+ n 1))
+ n))
(assert-equal? "basic let test4" 3 (let ((n1 2)
- (n2 1))
- (+ n1 n2)))
+ (n2 1))
+ (+ n1 n2)))
(define count
(let ((n 0))
(lambda ()
- (set! n (+ n 1)))))
+ (set! n (+ n 1))
+ n)))
(assert-equal? "lexical scope test1" 1 (count))
(assert-equal? "lexical scope test2" 2 (count))
@@ -171,7 +174,8 @@
1))
(assert-equal? "basic begin test4" 1 (begin
(define n 0)
- (set! n 1)))
+ (set! n 1)
+ n))
;; do
(assert-equal? "do test1" '#(0 1 2 3 4) (do ((vec (make-vector 5))
(i 0 (+ i 1)))
@@ -201,24 +205,19 @@
(assert-equal? "do test5" '((5 6) (3 4) (1 2)) (nreverse '((1 2) (3 4) (5 6))))
;; from R5RS
-(assert-equal? "values test1"
- 5
+(assert-equal? "values test1" 5
(call-with-values (lambda () (values 4 5))
(lambda (a b) b)))
-(assert-true "values test2"
- (call-with-values (lambda () (values))
- (lambda args (null? args))))
-(assert-true "values test3"
- (call-with-values (lambda () (values))
- (lambda () #t)))
-(assert-equal? "values test4" -1 (call-with-values * -))
-(assert-true "values test5" (number? (values 5)))
-(assert-false "values test6" (number? (values 'five)))
+;(assert-equal? "values test2" -1 (call-with-values * -))
+(assert "values test3" (number? (values 5)))
+(assert-equal? "values test4"
+ '((eval-counter 1) (eval-counter 1))
+ (call-with-values
+ (lambda () (values (eval-counter 0) (eval-counter 0)))
+ (lambda x x)))
-; not asserted, just make sure we don't blow up
-(write (values))
-(begin (values 1 2 3) 'ignore)
+(begin (values 1 2 3) 'ignore) ; not asserted, just make sure we don't blow up
(total-report)
Modified: branches/r5rs/sigscheme/test/unittest.scm
===================================================================
--- branches/r5rs/sigscheme/test/unittest.scm 2005-09-25 06:00:01 UTC (rev 1579)
+++ branches/r5rs/sigscheme/test/unittest.scm 2005-09-25 11:43:52 UTC (rev 1580)
@@ -58,6 +58,9 @@
(write b)
(newline)))))
+(define (eval-counter n)
+ (list 'eval-counter (+ n 1)))
+
;; dummy definition to eval args for assert-error. real implementation needed.
(define assert-error
(lambda (msg exp)
Modified: branches/r5rs/uim/uim-scm.c
===================================================================
--- branches/r5rs/uim/uim-scm.c 2005-09-25 06:00:01 UTC (rev 1579)
+++ branches/r5rs/uim/uim-scm.c 2005-09-25 11:43:52 UTC (rev 1580)
@@ -437,9 +437,7 @@
uim_lisp
uim_scm_apply(uim_lisp proc, uim_lisp args)
{
- return (uim_lisp)ScmOp_apply(Scm_NewCons((ScmObj)proc,
- Scm_NewCons((ScmObj)args, SCM_NULL)),
- SCM_NULL);
+ return (uim_lisp)Scm_call(proc, Scm_NewCons((ScmObj)args, SCM_NULL));
}
#endif /* UIM_SCM_EXTENDED_API */
More information about the uim-commit
mailing list