[uim-commit] r1344 - in branches/r5rs/sigscheme: . test
kzk at freedesktop.org
kzk at freedesktop.org
Mon Aug 29 01:00:32 EST 2005
Author: kzk
Date: 2005-08-28 08:00:30 -0700 (Sun, 28 Aug 2005)
New Revision: 1344
Modified:
branches/r5rs/sigscheme/datas.c
branches/r5rs/sigscheme/eval.c
branches/r5rs/sigscheme/operations-srfi8.c
branches/r5rs/sigscheme/operations.c
branches/r5rs/sigscheme/sigscheme.c
branches/r5rs/sigscheme/sigscheme.h
branches/r5rs/sigscheme/sigschemetype.h
branches/r5rs/sigscheme/test/test-tail-rec.scm
Log:
* FuncType reorganization of SigScheme
* sigscheme/sigscheme.c
* sigscheme/sigscheme.h
* sigscheme/operations-srfi8.c
* sigscheme/sigschemetype.h
* sigscheme/operations.c
* sigscheme/eval.c
* sigscheme/datas.c
* sigscheme/sigschemetype.h
- (ScmFuncType0, ScmFuncType1, ScmFuncType2, ScmFuncType3,
ScmFuncType4, ScmFuncType5, ScmFuncTypeEvaledList,
ScmFuncTypeRawList, ScmFuncTypeRawListTailRec,
ScmFuncTypeRawListWithTailFlag): new types
- (ScmFuncTypeCode): renamed from ScmFuncArgType
- (Scm_RegisterFuncEvaledList, Scm_RegisterFuncRawList,
Scm_RegisterFuncRawListTailRec, Scm_RegisterFuncWithTailFlag)
: new type
- (SCM_FUNC_TYPECODE): renamed from SCM_FUNC_NUMARG
- (SCM_FUNC_SET_TYPECODE): renamed from SCM_FUNC_SET_NUMARG
* sigscheme/test/test-tail-rec.scm
- not to use print
Modified: branches/r5rs/sigscheme/datas.c
===================================================================
--- branches/r5rs/sigscheme/datas.c 2005-08-28 08:27:33 UTC (rev 1343)
+++ branches/r5rs/sigscheme/datas.c 2005-08-28 15:00:30 UTC (rev 1344)
@@ -674,13 +674,13 @@
return obj;
}
-ScmObj Scm_NewFunc(enum ScmFuncArgType num_arg, ScmFuncType func)
+ScmObj Scm_NewFunc(enum ScmFuncTypeCode type, ScmFuncType func)
{
ScmObj obj = SCM_NULL;
SCM_NEW_OBJ_INTERNAL(obj);
SCM_ENTYPE_FUNC(obj);
- SCM_FUNC_SET_NUMARG(obj, num_arg);
+ SCM_FUNC_SET_TYPECODE(obj, type);
SCM_FUNC_SET_CFUNC(obj, func);
return obj;
Modified: branches/r5rs/sigscheme/eval.c
===================================================================
--- branches/r5rs/sigscheme/eval.c 2005-08-28 08:27:33 UTC (rev 1343)
+++ branches/r5rs/sigscheme/eval.c 2005-08-28 15:00:30 UTC (rev 1344)
@@ -272,77 +272,61 @@
switch (SCM_TYPE(tmp)) {
case ScmFunc:
/*
- * Description of FUNCTYPE handling.
- *
- * - FUNCTYPE_L
- * - evaluate all the args and pass it to func
- *
- * - FUNCTYPE_R
- * - not evaluate all the arguments
- *
- * - FUNCTYPE_2N
- * - call the function with each 2 objs
- *
- * - FUNCTYPE_0
- * - FUNCTYPE_1
- * - FUNCTYPE_2
- * - FUNCTYPE_3
- * - FUNCTYPE_4
- * - FUNCTYPE_5
- * - call the function with 0-5 arguments
+ * 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_NUMARG(tmp)) {
- case FUNCTYPE_L:
+ switch (SCM_FUNC_TYPECODE(tmp)) {
+ case FUNCTYPE_EVALED_LIST:
ret = SCM_FUNC_EXEC_SUBRL(tmp,
map_eval(CDR(obj), env),
env);
goto eval_done;
- case FUNCTYPE_R:
+ case FUNCTYPE_RAW_LIST:
+ ret = SCM_FUNC_EXEC_SUBRL(tmp,
+ CDR(obj),
+ env);
+ goto eval_done;
+
+ case FUNCTYPE_RAW_LIST_TAIL_REC:
obj = SCM_FUNC_EXEC_SUBRR(tmp,
CDR(obj),
+ &env);
+ goto eval_loop;
+
+ case FUNCTYPE_RAW_LIST_WITH_TAIL_FLAG:
+ obj = SCM_FUNC_EXEC_SUBRF(tmp,
+ CDR(obj),
&env,
&tail_flag);
/*
- * The core point of tail-recursion
- *
- * if tail_flag == 1, SCM_FUNC_EXEC_SUBRR returns raw S-expression.
- * So we need to evaluate it! This is for not to consume stack,
- * that is, tail-recursion optimization.
+ * 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 == 1)
+ if (tail_flag)
goto eval_loop;
ret = obj;
goto eval_done;
- case FUNCTYPE_2N:
- obj = CDR(obj);
-
- /* check 1st arg */
- if (NULLP(obj)) {
- ret = SCM_FUNC_EXEC_SUBR2N(tmp, SCM_NULL, SCM_NULL);
- goto eval_done;
- }
-
- /* eval 1st arg */
- ret = ScmOp_eval(CAR(obj), env);
-
- /* check 2nd arg */
- if (NULLP(CDR(obj))) {
- ret = SCM_FUNC_EXEC_SUBR2N(tmp, ret, SCM_NULL);
- goto eval_done;
- }
-
- /* call proc with each 2 objs */
- for (obj = CDR(obj); !NULLP(obj); obj = CDR(obj)) {
- ret = SCM_FUNC_EXEC_SUBR2N(tmp,
- ret,
- ScmOp_eval(CAR(obj), env));
- }
- goto eval_done;
-
case FUNCTYPE_0:
ret = SCM_FUNC_EXEC_SUBR0(tmp);
goto eval_done;
@@ -443,7 +427,7 @@
* 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, &tail_flag);
+ obj = ScmExp_begin(CDR(SCM_CLOSURE_EXP(tmp)), &env);
goto eval_loop;
case ScmContinuation:
@@ -502,28 +486,16 @@
/* apply proc */
switch (SCM_TYPE(proc)) {
case ScmFunc:
- switch (SCM_FUNC_NUMARG(proc)) {
- case FUNCTYPE_L:
+ switch (SCM_FUNC_TYPECODE(proc)) {
+ case FUNCTYPE_EVALED_LIST:
return SCM_FUNC_EXEC_SUBRL(proc,
obj,
env);
- case FUNCTYPE_2N:
- args = obj;
- /* check 1st arg */
- if (NULLP(args))
- return SCM_FUNC_EXEC_SUBR2N(proc, SCM_NULL, SCM_NULL);
- /* eval 1st arg */
- obj = CAR(args);
- /* check 2nd arg */
- if (NULLP(CDR(args)))
- return SCM_FUNC_EXEC_SUBR2N(proc, obj, SCM_NULL);
- /* call proc with each 2 objs */
- for (args = CDR(args); !NULLP(args); args = CDR(args)) {
- obj = SCM_FUNC_EXEC_SUBR2N(proc,
- obj,
- CAR(args));
- }
+ case FUNCTYPE_RAW_LIST_WITH_TAIL_FLAG:
+ obj = SCM_FUNC_EXEC_SUBRF(proc, obj, &env, &tail_flag);
+ if (tail_flag)
+ obj = ScmOp_eval(obj, env);
return obj;
case FUNCTYPE_0:
@@ -559,6 +531,8 @@
CAR(CDR(CDR(CDR(obj)))),
CAR(CDR(CDR(CDR(CDR(obj))))));
+ case FUNCTYPE_RAW_LIST:
+ case FUNCTYPE_RAW_LIST_TAIL_REC:
default:
SigScm_ErrorObj("apply : invalid application ", proc);
}
@@ -607,7 +581,7 @@
* 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, &tail_flag);
+ obj = ScmExp_begin(CDR(SCM_CLOSURE_EXP(proc)), &env);
return ScmOp_eval(obj, env);
default:
@@ -915,24 +889,18 @@
/*===========================================================================
R5RS : 4.1 Primitive expression types : 4.1.2 Literal expressions
===========================================================================*/
-ScmObj ScmOp_quote(ScmObj obj, ScmObj *envp, int *tail_flag)
+ScmObj ScmOp_quote(ScmObj arglist, ScmObj env)
{
- if (!CONSP(obj) || !NULLP(CDR(obj)))
- SigScm_ErrorObj("quote: bad argument list: ", obj);
- *tail_flag = 0;
- return CAR(obj);
+ if (!CONSP(arglist) || !NULLP(CDR(arglist)))
+ SigScm_ErrorObj("quote: bad argument list: ", arglist);
+ return CAR(arglist);
}
/*===========================================================================
R5RS : 4.1 Primitive expression types : 4.1.4 Procedures
===========================================================================*/
-ScmObj ScmExp_lambda(ScmObj exp, ScmObj *envp, int *tail_flag)
+ScmObj ScmExp_lambda(ScmObj exp, ScmObj env)
{
- ScmObj env = *envp;
-
- /* set tail_flag */
- (*tail_flag) = 0;
-
if CHECK_2_ARGS(exp)
SigScm_ErrorObj("lambda : too few argument ", exp);
@@ -942,15 +910,12 @@
/*===========================================================================
R5RS : 4.1 Primitive expression types : 4.1.5 Conditionals
===========================================================================*/
-ScmObj ScmExp_if(ScmObj exp, ScmObj *envp, int *tail_flag)
+ScmObj ScmExp_if(ScmObj exp, ScmObj *envp)
{
ScmObj env = *envp;
ScmObj pred = SCM_NULL;
ScmObj false_exp = SCM_NULL;
- /* set tail_flag */
- (*tail_flag) = 1;
-
/* sanity check */
if (NULLP(exp) || NULLP(CDR(exp)))
SigScm_ErrorObj("if : syntax error : ", exp);
@@ -976,17 +941,13 @@
/*===========================================================================
R5RS : 4.1 Primitive expression types : 4.1.6 Assignment
===========================================================================*/
-ScmObj ScmExp_set(ScmObj arg, ScmObj *envp, int *tail_flag)
+ScmObj ScmExp_set(ScmObj arg, ScmObj env)
{
- ScmObj env = *envp;
ScmObj sym = CAR(arg);
ScmObj val = CAR(CDR(arg));
ScmObj ret = SCM_NULL;
ScmObj tmp = SCM_NULL;
- /* set tail_flag */
- (*tail_flag) = 0;
-
ret = ScmOp_eval(val, env);
tmp = lookup_environment(sym, env);
if (NULLP(tmp)) {
@@ -1001,9 +962,6 @@
SET_CAR(tmp, ret);
}
- /* set new env */
- *envp = env;
-
return ret;
}
@@ -1014,7 +972,7 @@
/*===========================================================================
R5RS : 4.2 Derived expression types : 4.2.1 Conditionals
===========================================================================*/
-ScmObj ScmExp_cond(ScmObj arg, ScmObj *envp, int *tail_flag)
+ScmObj ScmExp_cond(ScmObj arg, ScmObj *envp)
{
/*
* (cond <clause1> <clause2> ...)
@@ -1031,9 +989,6 @@
ScmObj exps = SCM_NULL;
ScmObj proc = SCM_NULL;
- /* set tail_flag */
- (*tail_flag) = 0;
-
/* looping in each clause */
for (; !NULLP(arg); arg = CDR(arg)) {
clause = CAR(arg);
@@ -1071,14 +1026,14 @@
env);
}
- return ScmExp_begin(exps, &env, tail_flag);
+ return ScmExp_begin(exps, &env);
}
}
return SCM_UNDEF;
}
-ScmObj ScmExp_case(ScmObj arg, ScmObj *envp, int *tail_flag)
+ScmObj ScmExp_case(ScmObj arg, ScmObj *envp)
{
ScmObj env = *envp;
ScmObj key = ScmOp_eval(CAR(arg), env);
@@ -1096,12 +1051,12 @@
/* check "else" symbol */
if (NULLP(CDR(arg)) && !CONSP(datums) && NFALSEP(SCM_SYMBOL_VCELL(datums)))
- return ScmExp_begin(exps, &env, tail_flag);
+ return ScmExp_begin(exps, &env);
/* evaluate datums and compare to key by eqv? */
for (; !NULLP(datums); datums = CDR(datums)) {
if (NFALSEP(ScmOp_eqvp(CAR(datums), key))) {
- return ScmExp_begin(exps, &env, tail_flag);
+ return ScmExp_begin(exps, &env);
}
}
}
@@ -1184,7 +1139,7 @@
/*===========================================================================
R5RS : 4.2 Derived expression types : 4.2.2 Binding constructs
===========================================================================*/
-ScmObj ScmExp_let(ScmObj arg, ScmObj *envp, int *tail_flag)
+ScmObj ScmExp_let(ScmObj arg, ScmObj *envp)
{
ScmObj env = *envp;
ScmObj bindings = SCM_NULL;
@@ -1231,10 +1186,10 @@
env = extend_environment(vars, vals, env);
*envp = env;
- return ScmExp_begin(body, &env, tail_flag);
+ return ScmExp_begin(body, &env);
}
- return ScmExp_begin(body, &env, tail_flag);
+ return ScmExp_begin(body, &env);
named_let:
/*========================================================================
@@ -1258,16 +1213,13 @@
ScmExp_define(Scm_NewCons(Scm_NewCons(CAR(arg),
vars),
body),
- &env, tail_flag);
+ env);
- /* set tail_flag */
- (*tail_flag) = 1;
-
/* (func <init1> <init2> ...) */
return Scm_NewCons(CAR(arg), vals);
}
-ScmObj ScmExp_let_star(ScmObj arg, ScmObj *envp, int *tail_flag)
+ScmObj ScmExp_let_star(ScmObj arg, ScmObj *envp)
{
ScmObj env = *envp;
ScmObj bindings = SCM_NULL;
@@ -1311,7 +1263,7 @@
/* set new env */
*envp = env;
/* evaluate */
- return ScmExp_begin(body, &env, tail_flag);
+ return ScmExp_begin(body, &env);
} else if (NULLP(bindings)) {
/* extend null environment */
env = extend_environment(SCM_NULL,
@@ -1321,16 +1273,13 @@
/* set new env */
*envp = env;
/* evaluate */
- return ScmExp_begin(body, &env, tail_flag);
+ return ScmExp_begin(body, &env);
}
- /* set tail_flag */
- (*tail_flag) = 0;
-
return SCM_UNDEF;
}
-ScmObj ScmExp_letrec(ScmObj arg, ScmObj *envp, int *tail_flag)
+ScmObj ScmExp_letrec(ScmObj arg, ScmObj *envp)
{
ScmObj env = *envp;
ScmObj bindings = SCM_NULL;
@@ -1395,12 +1344,9 @@
}
/* evaluate body */
- return ScmExp_begin(body, &env, tail_flag);
+ return ScmExp_begin(body, &env);
}
- /* set tail_flag */
- (*tail_flag) = 0;
-
SigScm_Error("letrec : syntax error\n");
return SCM_UNDEF;
}
@@ -1409,14 +1355,11 @@
/*===========================================================================
R5RS : 4.2 Derived expression types : 4.2.3 Sequencing
===========================================================================*/
-ScmObj ScmExp_begin(ScmObj arg, ScmObj *envp, int *tail_flag)
+ScmObj ScmExp_begin(ScmObj arg, ScmObj *envp)
{
ScmObj env = *envp;
ScmObj exp = SCM_NULL;
- /* set tail_flag */
- (*tail_flag) = 1;
-
/* sanity check */
if (NULLP(arg))
return SCM_UNDEF;
@@ -1440,16 +1383,13 @@
*envp = env;
}
- /* set tail_flag */
- (*tail_flag) = 0;
-
return SCM_UNDEF;
}
/*===========================================================================
R5RS : 4.2 Derived expression types : 4.2.4 Iteration
===========================================================================*/
-ScmObj ScmExp_do(ScmObj arg, ScmObj *envp, int *tail_flag)
+ScmObj ScmExp_do(ScmObj arg, ScmObj *envp)
{
/*
* (do ((<variable1> <init1> <step1>)
@@ -1505,7 +1445,7 @@
/* now excution phase! */
while (FALSEP(ScmOp_eval(test, env))) {
/* execute commands */
- ScmOp_eval(ScmExp_begin(commands, &env, tail_flag), env);
+ ScmOp_eval(ScmExp_begin(commands, &env), env);
/*
* Notice
@@ -1534,19 +1474,14 @@
/* set new env */
*envp = env;
- return ScmExp_begin(expression, &env, tail_flag);
+ return ScmExp_begin(expression, &env);
}
/*===========================================================================
R5RS : 4.2 Derived expression types : 4.2.5 Delayed evaluation
===========================================================================*/
-ScmObj ScmOp_delay(ScmObj arg, ScmObj *envp, int *tail_flag)
+ScmObj ScmOp_delay(ScmObj arg, ScmObj env)
{
- ScmObj env = *envp;
-
- /* set tail_flag */
- (*tail_flag) = 0;
-
if (SCM_INT_VALUE(ScmOp_length(arg)) != 1)
SigScm_Error("delay : Wrong number of arguments\n");
@@ -1557,21 +1492,20 @@
/*===========================================================================
R5RS : 4.2 Derived expression types : 4.2.6 Quasiquotation
===========================================================================*/
-ScmObj ScmOp_quasiquote(ScmObj obj, ScmObj *envp, int *tail_flag)
+ScmObj ScmOp_quasiquote(ScmObj obj, ScmObj env)
{
ScmObj ret;
if (!IS_LIST_LEN_1(obj))
SigScm_ErrorObj("quasiquote: bad argument list: ", obj);
obj = CAR(obj);
- ret = qquote_internal(obj, *envp, 1);
+ ret = qquote_internal(obj, env, 1);
- *tail_flag = 0;
if (QQUOTE_IS_VERBATIM(ret))
return obj;
return ret;
}
-ScmObj ScmOp_unquote(ScmObj obj, ScmObj *envp, int *tail_flag)
+ScmObj ScmOp_unquote(ScmObj obj, ScmObj env)
{
if (!CONSP(obj) || !NULLP(CDR(obj)))
SigScm_ErrorObj("unquote: bad argument list: ", obj);
@@ -1579,7 +1513,7 @@
return SCM_NULL;
}
-ScmObj ScmOp_unquote_splicing(ScmObj obj, ScmObj *envp, int *tail_flag)
+ScmObj ScmOp_unquote_splicing(ScmObj obj, ScmObj env)
{
if (!CONSP(obj) || !NULLP(CDR(obj)))
SigScm_ErrorObj("unquote-splicing: bad argument list: ", obj);
@@ -1591,17 +1525,13 @@
/*=======================================
R5RS : 5.2 Definitions
=======================================*/
-ScmObj ScmExp_define(ScmObj arg, ScmObj *envp, int *tail_flag)
+ScmObj ScmExp_define(ScmObj arg, ScmObj env)
{
- ScmObj env = *envp;
ScmObj var = CAR(arg);
ScmObj body = CAR(CDR(arg));
ScmObj val = SCM_NULL;
ScmObj formals = SCM_NULL;
- /* set tail_flag */
- (*tail_flag) = 0;
-
/* sanity check */
if (NULLP(var))
SigScm_ErrorObj("define : syntax error ", arg);
@@ -1618,9 +1548,6 @@
env = add_environment(var, ScmOp_eval(body, env), env);
}
- /* set new env */
- *envp = env;
-
return var;
}
@@ -1643,9 +1570,9 @@
/* (val (lambda formals body)) */
arg = SCM_LIST_2(val,
- ScmExp_lambda(Scm_NewCons(formals, body), &env, tail_flag));
+ ScmExp_lambda(Scm_NewCons(formals, body), env));
- return ScmExp_define(arg, &env, tail_flag);
+ return ScmExp_define(arg, env);
}
SigScm_ErrorObj("define : syntax error ", arg);
Modified: branches/r5rs/sigscheme/operations-srfi8.c
===================================================================
--- branches/r5rs/sigscheme/operations-srfi8.c 2005-08-28 08:27:33 UTC (rev 1343)
+++ branches/r5rs/sigscheme/operations-srfi8.c 2005-08-28 15:00:30 UTC (rev 1344)
@@ -63,7 +63,7 @@
/*=============================================================================
SRFI8 : Receive
=============================================================================*/
-ScmObj ScmOp_SRFI8_receive(ScmObj args, ScmObj *envp, int *tail_flag)
+ScmObj ScmOp_SRFI8_receive(ScmObj args, ScmObj *envp)
{
/*
* (receive <formals> <expression> <body>)
@@ -79,9 +79,6 @@
if (CHECK_3_ARGS(args))
SigScm_ErrorObj("receive: bad argument list: ", args);
- /* set tail_flag */
- (*tail_flag) = 1;
-
formals = SCM_CAR(args);
expr = SCM_CADR(args);
body = SCM_CDDR(args);
Modified: branches/r5rs/sigscheme/operations.c
===================================================================
--- branches/r5rs/sigscheme/operations.c 2005-08-28 08:27:33 UTC (rev 1343)
+++ branches/r5rs/sigscheme/operations.c 2005-08-28 15:00:30 UTC (rev 1344)
@@ -1993,12 +1993,11 @@
return Scm_NewValuePacket(argl);
}
-ScmObj ScmOp_call_with_values(ScmObj argl, ScmObj *envp, int *tail_flag)
+ScmObj ScmOp_call_with_values(ScmObj argl, ScmObj *envp)
{
ScmObj vals;
ScmObj cons_wrapper;
- /* This should go away when we reorganize function types. */
if (CHECK_2_ARGS(argl))
SigScm_ErrorObj("call-with-values: too few arguments: ", argl);
@@ -2014,8 +2013,6 @@
vals = SCM_VALUEPACKET_VALUES(vals);
}
- (*tail_flag) = 1;
-
/* cons_wrapper would have no chance of being referenced from
* anywhere else, so we'll reuse that object. */
SET_CAR(cons_wrapper, SCM_CADR(argl));
Modified: branches/r5rs/sigscheme/sigscheme.c
===================================================================
--- branches/r5rs/sigscheme/sigscheme.c 2005-08-28 08:27:33 UTC (rev 1343)
+++ branches/r5rs/sigscheme/sigscheme.c 2005-08-28 15:00:30 UTC (rev 1344)
@@ -56,7 +56,7 @@
/*=======================================
File Local Function Declarations
=======================================*/
-static void Scm_RegisterFunc(const char *name, enum ScmFuncArgType argnum, ScmFuncType func);
+static void Scm_RegisterFunc(const char *name, enum ScmFuncTypeCode type, ScmFuncType func);
ScmObj SigScm_null, SigScm_true, SigScm_false, SigScm_eof;
ScmObj SigScm_quote, SigScm_quasiquote, SigScm_unquote, SigScm_unquote_splicing;
@@ -121,175 +121,176 @@
Export Scheme Functions
=======================================================================*/
/* eval.c */
- Scm_RegisterFunc2("eval" , ScmOp_eval);
- Scm_RegisterFuncL("apply" , ScmOp_apply);
- Scm_RegisterFuncR("quote" , ScmOp_quote);
- Scm_RegisterFuncR("lambda" , ScmExp_lambda);
- Scm_RegisterFuncR("if" , ScmExp_if);
- Scm_RegisterFuncR("set!" , ScmExp_set);
- Scm_RegisterFuncR("cond" , ScmExp_cond);
- Scm_RegisterFuncR("case" , ScmExp_case);
- Scm_RegisterFuncR("and" , ScmExp_and);
- Scm_RegisterFuncR("or" , ScmExp_or);
- Scm_RegisterFuncR("let" , ScmExp_let);
- Scm_RegisterFuncR("let*" , ScmExp_let_star);
- Scm_RegisterFuncR("letrec" , ScmExp_letrec);
- Scm_RegisterFuncR("begin" , ScmExp_begin);
- Scm_RegisterFuncR("do" , ScmExp_do);
- Scm_RegisterFuncR("delay" , ScmOp_delay);
- Scm_RegisterFuncR("quasiquote" , ScmOp_quasiquote);
- Scm_RegisterFuncR("unquote" , ScmOp_unquote);
- Scm_RegisterFuncR("unquote-splicing" , ScmOp_unquote_splicing);
- Scm_RegisterFuncR("define" , ScmExp_define);
+ 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_RegisterFunc1("scheme-report-environment", ScmOp_scheme_report_environment);
Scm_RegisterFunc1("null-environment" , ScmOp_null_environment);
/* operations.c */
- Scm_RegisterFunc2("eqv?" , ScmOp_eqvp);
- Scm_RegisterFunc2("eq?" , ScmOp_eqp);
- Scm_RegisterFunc2("equal?" , ScmOp_equalp);
- Scm_RegisterFunc1("number?" , ScmOp_numberp);
- Scm_RegisterFunc1("integer?" , ScmOp_numberp);
- Scm_RegisterFuncL("=" , ScmOp_equal);
- Scm_RegisterFuncL("<" , ScmOp_less);
- Scm_RegisterFuncL(">" , ScmOp_greater);
- Scm_RegisterFuncL("<=" , ScmOp_lessEq);
- Scm_RegisterFuncL(">=" , ScmOp_greaterEq);
- 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_RegisterFuncL("max" , ScmOp_max);
- Scm_RegisterFuncL("min" , ScmOp_min);
- Scm_RegisterFuncL("+" , ScmOp_plus);
- Scm_RegisterFuncL("*" , ScmOp_times);
- Scm_RegisterFuncL("-" , ScmOp_minus);
- Scm_RegisterFuncL("/" , ScmOp_divide);
- Scm_RegisterFunc1("abs" , ScmOp_abs);
- Scm_RegisterFunc2("quotient" , ScmOp_quotient);
- Scm_RegisterFunc2("modulo" , ScmOp_modulo);
- Scm_RegisterFunc2("remainder" , ScmOp_remainder);
- Scm_RegisterFuncL("number->string" , ScmOp_number2string);
- Scm_RegisterFunc1("string->number" , ScmOp_string2number);
- Scm_RegisterFunc1("not" , ScmOp_not);
- Scm_RegisterFunc1("boolean?" , ScmOp_booleanp);
- Scm_RegisterFunc1("pair?" , ScmOp_pairp);
- Scm_RegisterFunc2("cons" , ScmOp_cons);
- Scm_RegisterFunc1("car" , ScmOp_car);
- Scm_RegisterFunc1("cdr" , ScmOp_cdr);
- Scm_RegisterFunc2("set-car!" , ScmOp_setcar);
- Scm_RegisterFunc2("set-cdr!" , ScmOp_setcdr);
- Scm_RegisterFunc1("caar" , ScmOp_caar);
- Scm_RegisterFunc1("cadr" , ScmOp_cadr);
- Scm_RegisterFunc1("cdar" , ScmOp_cdar);
- Scm_RegisterFunc1("cddr" , ScmOp_cddr);
- Scm_RegisterFunc1("caaar" , ScmOp_caaar);
- Scm_RegisterFunc1("caadr" , ScmOp_caadr);
- Scm_RegisterFunc1("cadar" , ScmOp_cadar);
- Scm_RegisterFunc1("caddr" , ScmOp_caddr);
- Scm_RegisterFunc1("cdaar" , ScmOp_cdaar);
- Scm_RegisterFunc1("cdadr" , ScmOp_cdadr);
- Scm_RegisterFunc1("cddar" , ScmOp_cddar);
- Scm_RegisterFunc1("cdddr" , ScmOp_cdddr);
- Scm_RegisterFunc1("caaaar" , ScmOp_caaaar);
- Scm_RegisterFunc1("caaadr" , ScmOp_caaadr);
- Scm_RegisterFunc1("caadar" , ScmOp_caadar);
- Scm_RegisterFunc1("caaddr" , ScmOp_caaddr);
- Scm_RegisterFunc1("cadaar" , ScmOp_cadaar);
- Scm_RegisterFunc1("cadadr" , ScmOp_cadadr);
- Scm_RegisterFunc1("caddar" , ScmOp_caddar);
- Scm_RegisterFunc1("cadddr" , ScmOp_cadddr);
- Scm_RegisterFunc1("cdaaar" , ScmOp_cdaaar);
- Scm_RegisterFunc1("cdaadr" , ScmOp_cdaadr);
- Scm_RegisterFunc1("cdadar" , ScmOp_cdadar);
- Scm_RegisterFunc1("cdaddr" , ScmOp_cdaddr);
- Scm_RegisterFunc1("cddaar" , ScmOp_cddaar);
- Scm_RegisterFunc1("cddadr" , ScmOp_cddadr);
- Scm_RegisterFunc1("cdddar" , ScmOp_cdddar);
- Scm_RegisterFunc1("cddddr" , ScmOp_cddddr);
- Scm_RegisterFunc1("null?" , ScmOp_nullp);
- Scm_RegisterFunc1("list?" , ScmOp_listp);
- Scm_RegisterFuncL("list" , ScmOp_list);
- Scm_RegisterFunc1("length" , ScmOp_length);
- Scm_RegisterFuncL("append" , ScmOp_append);
- Scm_RegisterFunc1("reverse" , ScmOp_reverse);
- Scm_RegisterFunc2("list-tail" , ScmOp_list_tail);
- Scm_RegisterFunc2("list-ref" , ScmOp_list_ref);
- Scm_RegisterFunc2("memq" , ScmOp_memq);
- Scm_RegisterFunc2("memv" , ScmOp_memv);
- Scm_RegisterFunc2("member" , ScmOp_member);
- Scm_RegisterFunc2("assq" , ScmOp_assq);
- Scm_RegisterFunc2("assv" , ScmOp_assv);
- Scm_RegisterFunc2("assoc" , ScmOp_assoc);
- Scm_RegisterFunc1("symbol?" , ScmOp_symbolp);
- Scm_RegisterFunc1("symbol->string" , ScmOp_symbol2string);
- Scm_RegisterFunc1("string->symbol" , ScmOp_string2symbol);
- Scm_RegisterFunc1("char?" , ScmOp_charp);
- Scm_RegisterFunc2("char=?" , ScmOp_char_equal);
- Scm_RegisterFunc1("char-alphabetic?" , ScmOp_char_alphabeticp);
- Scm_RegisterFunc1("char-numeric?" , ScmOp_char_numericp);
- Scm_RegisterFunc1("char-whitespace?" , ScmOp_char_whitespacep);
- Scm_RegisterFunc1("char-upper-case?" , ScmOp_char_upper_casep);
- Scm_RegisterFunc1("char-lower-case?" , ScmOp_char_lower_casep);
- Scm_RegisterFunc1("char-upcase" , ScmOp_char_upcase);
- Scm_RegisterFunc1("char-downcase" , ScmOp_char_downcase);
- Scm_RegisterFunc1("string?" , ScmOp_stringp);
- Scm_RegisterFuncL("make-string" , ScmOp_make_string);
- Scm_RegisterFuncL("string" , ScmOp_string);
- Scm_RegisterFunc2("string-ref" , ScmOp_string_ref);
- Scm_RegisterFunc3("string-set!" , ScmOp_string_set);
- Scm_RegisterFunc1("string-length" , ScmOp_string_length);
- Scm_RegisterFunc2("string=?" , ScmOp_string_equal);
- Scm_RegisterFunc3("substring" , ScmOp_string_substring);
- Scm_RegisterFuncL("string-append" , ScmOp_string_append);
- Scm_RegisterFunc1("string->list" , ScmOp_string2list);
- Scm_RegisterFunc1("list->string" , ScmOp_list2string);
- Scm_RegisterFunc1("string-copy" , ScmOp_string_copy);
- Scm_RegisterFunc2("string-fill!" , ScmOp_string_fill);
- Scm_RegisterFunc1("vector?" , ScmOp_vectorp);
- Scm_RegisterFuncL("make-vector" , ScmOp_make_vector);
- Scm_RegisterFuncL("vector" , ScmOp_vector);
- Scm_RegisterFunc1("vector-length" , ScmOp_vector_length);
- Scm_RegisterFunc2("vector-ref" , ScmOp_vector_ref);
- Scm_RegisterFunc3("vector-set!" , ScmOp_vector_set);
- Scm_RegisterFunc1("vector->list" , ScmOp_vector2list);
- Scm_RegisterFunc1("list->vector" , ScmOp_list2vector);
- Scm_RegisterFunc2("vector-fill!" , ScmOp_vector_fill);
- Scm_RegisterFunc1("procedure?" , ScmOp_procedurep);
- Scm_RegisterFuncL("map" , ScmOp_map);
- Scm_RegisterFuncL("for-each" , ScmOp_for_each);
- Scm_RegisterFuncL("force" , ScmOp_force);
- Scm_RegisterFuncL("call-with-current-continuation", ScmOp_call_with_current_continuation);
- Scm_RegisterFuncL("values" , ScmOp_values);
- Scm_RegisterFuncR("call-with-values" , ScmOp_call_with_values);
+ Scm_RegisterFunc2("eqv?" , ScmOp_eqvp);
+ Scm_RegisterFunc2("eq?" , ScmOp_eqp);
+ Scm_RegisterFunc2("equal?" , ScmOp_equalp);
+ Scm_RegisterFunc1("number?" , ScmOp_numberp);
+ Scm_RegisterFunc1("integer?" , ScmOp_numberp);
+ Scm_RegisterFuncEvaledList("=" , ScmOp_equal);
+ Scm_RegisterFuncEvaledList("<" , ScmOp_less);
+ Scm_RegisterFuncEvaledList(">" , ScmOp_greater);
+ Scm_RegisterFuncEvaledList("<=" , ScmOp_lessEq);
+ Scm_RegisterFuncEvaledList(">=" , ScmOp_greaterEq);
+ 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_RegisterFuncEvaledList("max" , ScmOp_max);
+ Scm_RegisterFuncEvaledList("min" , ScmOp_min);
+ Scm_RegisterFuncEvaledList("+" , ScmOp_plus);
+ Scm_RegisterFuncEvaledList("*" , ScmOp_times);
+ Scm_RegisterFuncEvaledList("-" , ScmOp_minus);
+ Scm_RegisterFuncEvaledList("/" , ScmOp_divide);
+ Scm_RegisterFunc1("abs" , ScmOp_abs);
+ Scm_RegisterFunc2("quotient" , ScmOp_quotient);
+ Scm_RegisterFunc2("modulo" , ScmOp_modulo);
+ Scm_RegisterFunc2("remainder" , ScmOp_remainder);
+ Scm_RegisterFuncEvaledList("number->string" , ScmOp_number2string);
+ Scm_RegisterFunc1("string->number" , ScmOp_string2number);
+ Scm_RegisterFunc1("not" , ScmOp_not);
+ Scm_RegisterFunc1("boolean?" , ScmOp_booleanp);
+ Scm_RegisterFunc1("pair?" , ScmOp_pairp);
+ Scm_RegisterFunc2("cons" , ScmOp_cons);
+ Scm_RegisterFunc1("car" , ScmOp_car);
+ Scm_RegisterFunc1("cdr" , ScmOp_cdr);
+ Scm_RegisterFunc2("set-car!" , ScmOp_setcar);
+ Scm_RegisterFunc2("set-cdr!" , ScmOp_setcdr);
+ Scm_RegisterFunc1("caar" , ScmOp_caar);
+ Scm_RegisterFunc1("cadr" , ScmOp_cadr);
+ Scm_RegisterFunc1("cdar" , ScmOp_cdar);
+ Scm_RegisterFunc1("cddr" , ScmOp_cddr);
+ Scm_RegisterFunc1("caaar" , ScmOp_caaar);
+ Scm_RegisterFunc1("caadr" , ScmOp_caadr);
+ Scm_RegisterFunc1("cadar" , ScmOp_cadar);
+ Scm_RegisterFunc1("caddr" , ScmOp_caddr);
+ Scm_RegisterFunc1("cdaar" , ScmOp_cdaar);
+ Scm_RegisterFunc1("cdadr" , ScmOp_cdadr);
+ Scm_RegisterFunc1("cddar" , ScmOp_cddar);
+ Scm_RegisterFunc1("cdddr" , ScmOp_cdddr);
+ Scm_RegisterFunc1("caaaar" , ScmOp_caaaar);
+ Scm_RegisterFunc1("caaadr" , ScmOp_caaadr);
+ Scm_RegisterFunc1("caadar" , ScmOp_caadar);
+ Scm_RegisterFunc1("caaddr" , ScmOp_caaddr);
+ Scm_RegisterFunc1("cadaar" , ScmOp_cadaar);
+ Scm_RegisterFunc1("cadadr" , ScmOp_cadadr);
+ Scm_RegisterFunc1("caddar" , ScmOp_caddar);
+ Scm_RegisterFunc1("cadddr" , ScmOp_cadddr);
+ Scm_RegisterFunc1("cdaaar" , ScmOp_cdaaar);
+ Scm_RegisterFunc1("cdaadr" , ScmOp_cdaadr);
+ Scm_RegisterFunc1("cdadar" , ScmOp_cdadar);
+ Scm_RegisterFunc1("cdaddr" , ScmOp_cdaddr);
+ Scm_RegisterFunc1("cddaar" , ScmOp_cddaar);
+ Scm_RegisterFunc1("cddadr" , ScmOp_cddadr);
+ Scm_RegisterFunc1("cdddar" , ScmOp_cdddar);
+ Scm_RegisterFunc1("cddddr" , ScmOp_cddddr);
+ Scm_RegisterFunc1("null?" , ScmOp_nullp);
+ Scm_RegisterFunc1("list?" , ScmOp_listp);
+ Scm_RegisterFunc1("length" , ScmOp_length);
+ Scm_RegisterFuncEvaledList("list" , ScmOp_list);
+ Scm_RegisterFuncEvaledList("append" , ScmOp_append);
+ Scm_RegisterFunc1("reverse" , ScmOp_reverse);
+ Scm_RegisterFunc2("list-tail" , ScmOp_list_tail);
+ Scm_RegisterFunc2("list-ref" , ScmOp_list_ref);
+ Scm_RegisterFunc2("memq" , ScmOp_memq);
+ Scm_RegisterFunc2("memv" , ScmOp_memv);
+ Scm_RegisterFunc2("member" , ScmOp_member);
+ Scm_RegisterFunc2("assq" , ScmOp_assq);
+ Scm_RegisterFunc2("assv" , ScmOp_assv);
+ Scm_RegisterFunc2("assoc" , ScmOp_assoc);
+ Scm_RegisterFunc1("symbol?" , ScmOp_symbolp);
+ Scm_RegisterFunc1("symbol->string" , ScmOp_symbol2string);
+ Scm_RegisterFunc1("string->symbol" , ScmOp_string2symbol);
+ Scm_RegisterFunc1("char?" , ScmOp_charp);
+ Scm_RegisterFunc2("char=?" , ScmOp_char_equal);
+ Scm_RegisterFunc1("char-alphabetic?" , ScmOp_char_alphabeticp);
+ Scm_RegisterFunc1("char-numeric?" , ScmOp_char_numericp);
+ Scm_RegisterFunc1("char-whitespace?" , ScmOp_char_whitespacep);
+ Scm_RegisterFunc1("char-upper-case?" , ScmOp_char_upper_casep);
+ Scm_RegisterFunc1("char-lower-case?" , ScmOp_char_lower_casep);
+ Scm_RegisterFunc1("char-upcase" , ScmOp_char_upcase);
+ Scm_RegisterFunc1("char-downcase" , ScmOp_char_downcase);
+ Scm_RegisterFunc1("string?" , ScmOp_stringp);
+ Scm_RegisterFuncEvaledList("make-string" , ScmOp_make_string);
+ Scm_RegisterFuncEvaledList("string" , ScmOp_string);
+ Scm_RegisterFunc2("string-ref" , ScmOp_string_ref);
+ Scm_RegisterFunc3("string-set!" , ScmOp_string_set);
+ Scm_RegisterFunc1("string-length" , ScmOp_string_length);
+ Scm_RegisterFunc2("string=?" , ScmOp_string_equal);
+ Scm_RegisterFunc3("substring" , ScmOp_string_substring);
+ Scm_RegisterFuncEvaledList("string-append" , ScmOp_string_append);
+ Scm_RegisterFunc1("string->list" , ScmOp_string2list);
+ Scm_RegisterFunc1("list->string" , ScmOp_list2string);
+ Scm_RegisterFunc1("string-copy" , ScmOp_string_copy);
+ Scm_RegisterFunc2("string-fill!" , ScmOp_string_fill);
+ Scm_RegisterFunc1("vector?" , ScmOp_vectorp);
+ Scm_RegisterFuncEvaledList("make-vector" , ScmOp_make_vector);
+ Scm_RegisterFuncEvaledList("vector" , ScmOp_vector);
+ Scm_RegisterFunc1("vector-length" , ScmOp_vector_length);
+ Scm_RegisterFunc2("vector-ref" , ScmOp_vector_ref);
+ Scm_RegisterFunc3("vector-set!" , ScmOp_vector_set);
+ Scm_RegisterFunc1("vector->list" , ScmOp_vector2list);
+ Scm_RegisterFunc1("list->vector" , ScmOp_list2vector);
+ Scm_RegisterFunc2("vector-fill!" , ScmOp_vector_fill);
+ Scm_RegisterFunc1("procedure?" , ScmOp_procedurep);
+ Scm_RegisterFuncEvaledList("map" , ScmOp_map);
+ Scm_RegisterFuncEvaledList("for-each" , ScmOp_for_each);
+ 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);
/* io.c */
- Scm_RegisterFunc2("call-with-input-file" , ScmOp_call_with_input_file);
- Scm_RegisterFunc2("call-with-output-file", ScmOp_call_with_output_file);
- Scm_RegisterFunc1("input-port?" , ScmOp_input_portp);
- Scm_RegisterFunc1("output-port?" , ScmOp_output_portp);
- Scm_RegisterFunc0("current-input-port" , ScmOp_current_input_port);
- Scm_RegisterFunc0("current-output-port" , ScmOp_current_output_port);
- Scm_RegisterFunc2("with-input-from-file" , ScmOp_with_input_from_file);
- Scm_RegisterFunc2("with-output-to-file" , ScmOp_with_output_to_file);
- Scm_RegisterFunc1("open-input-file" , ScmOp_open_input_file);
- Scm_RegisterFunc1("open-output-file" , ScmOp_open_output_file);
- Scm_RegisterFunc1("close-input-port" , ScmOp_close_input_port);
- Scm_RegisterFunc1("close-output-port" , ScmOp_close_output_port);
- Scm_RegisterFuncL("read" , ScmOp_read);
- Scm_RegisterFuncL("read-char" , ScmOp_read_char);
- Scm_RegisterFunc1("eof-object?" , ScmOp_eof_objectp);
- Scm_RegisterFuncL("write" , ScmOp_write);
- Scm_RegisterFuncL("display" , ScmOp_display);
- Scm_RegisterFuncL("newline" , ScmOp_newline);
- Scm_RegisterFuncL("write-char" , ScmOp_write_char);
- Scm_RegisterFunc1("load" , ScmOp_load);
+ Scm_RegisterFunc2("call-with-input-file" , ScmOp_call_with_input_file);
+ Scm_RegisterFunc2("call-with-output-file" , ScmOp_call_with_output_file);
+ Scm_RegisterFunc1("input-port?" , ScmOp_input_portp);
+ Scm_RegisterFunc1("output-port?" , ScmOp_output_portp);
+ Scm_RegisterFunc0("current-input-port" , ScmOp_current_input_port);
+ Scm_RegisterFunc0("current-output-port" , ScmOp_current_output_port);
+ Scm_RegisterFunc2("with-input-from-file" , ScmOp_with_input_from_file);
+ Scm_RegisterFunc2("with-output-to-file" , ScmOp_with_output_to_file);
+ Scm_RegisterFunc1("open-input-file" , ScmOp_open_input_file);
+ Scm_RegisterFunc1("open-output-file" , ScmOp_open_output_file);
+ Scm_RegisterFunc1("close-input-port" , ScmOp_close_input_port);
+ Scm_RegisterFunc1("close-output-port" , ScmOp_close_output_port);
+ Scm_RegisterFunc1("eof-object?" , ScmOp_eof_objectp);
+ Scm_RegisterFuncEvaledList("read" , ScmOp_read);
+ Scm_RegisterFuncEvaledList("read-char" , ScmOp_read_char);
+ Scm_RegisterFuncEvaledList("write" , ScmOp_write);
+ Scm_RegisterFuncEvaledList("display" , ScmOp_display);
+ Scm_RegisterFuncEvaledList("newline" , ScmOp_newline);
+ Scm_RegisterFuncEvaledList("write-char" , ScmOp_write_char);
+ Scm_RegisterFunc1("load" , ScmOp_load);
#if SCM_USE_NONSTD_FEATURES
- Scm_RegisterFunc1("require" , ScmOp_require);
- Scm_RegisterFunc1("provide" , ScmOp_provide);
- Scm_RegisterFunc1("provided?" , ScmOp_providedp);
- Scm_RegisterFunc1("file-exists?" , ScmOp_file_existsp);
- Scm_RegisterFunc1("delete-file" , ScmOp_delete_file);
+ Scm_RegisterFunc1("require" , ScmOp_require);
+ Scm_RegisterFunc1("provide" , ScmOp_provide);
+ Scm_RegisterFunc1("provided?" , ScmOp_providedp);
+ Scm_RegisterFunc1("file-exists?" , ScmOp_file_existsp);
+ Scm_RegisterFunc1("delete-file" , ScmOp_delete_file);
#endif
+
/*=======================================================================
Current Input & Output Initialization
=======================================================================*/
@@ -304,19 +305,19 @@
/*=======================================================================
SRFI-1 Procedures
=======================================================================*/
+ Scm_RegisterFunc1("list-copy" , ScmOp_SRFI1_list_copy);
Scm_RegisterFunc2("xcons" , ScmOp_SRFI1_xcons);
- Scm_RegisterFuncL("cons*" , ScmOp_SRFI1_cons_star);
- Scm_RegisterFuncL("make-list" , ScmOp_SRFI1_make_list);
- Scm_RegisterFuncL("list-tabulate" , ScmOp_SRFI1_list_tabulate);
- Scm_RegisterFunc1("list-copy" , ScmOp_SRFI1_list_copy);
- Scm_RegisterFuncL("circular-list" , ScmOp_SRFI1_circular_list);
- Scm_RegisterFuncL("iota" , ScmOp_SRFI1_iota);
+ Scm_RegisterFuncEvaledList("circular-list" , ScmOp_SRFI1_circular_list);
+ Scm_RegisterFuncEvaledList("iota" , ScmOp_SRFI1_iota);
+ Scm_RegisterFuncEvaledList("cons*" , ScmOp_SRFI1_cons_star);
+ Scm_RegisterFuncEvaledList("make-list" , ScmOp_SRFI1_make_list);
+ Scm_RegisterFuncEvaledList("list-tabulate" , ScmOp_SRFI1_list_tabulate);
#endif
#if SCM_USE_SRFI8
/*=======================================================================
SRFI-8 Procedure
=======================================================================*/
- Scm_RegisterFuncR("receive" , ScmOp_SRFI8_receive);
+ Scm_RegisterFuncRawListTailRec("receive", ScmOp_SRFI8_receive);
#endif
#if SCM_COMPAT_SIOD
@@ -331,9 +332,9 @@
Scm_RegisterFunc2("bit-or" , ScmOp_bit_or);
Scm_RegisterFunc2("bit-xor" , ScmOp_bit_xor);
Scm_RegisterFunc1("bit-not" , ScmOp_bit_not);
- Scm_RegisterFuncL("the-environment" , ScmOp_the_environment);
+ Scm_RegisterFuncEvaledList("the-environment" , ScmOp_the_environment);
Scm_RegisterFunc1("%%closure-code" , ScmOp_closure_code);
- Scm_RegisterFuncL("verbose" , ScmOp_verbose);
+ Scm_RegisterFuncEvaledList("verbose" , ScmOp_verbose);
/* datas.c */
scm_return_value = SCM_NULL;
#endif
@@ -349,55 +350,60 @@
/*===========================================================================
Scheme Function Export Related Functions
===========================================================================*/
-static void Scm_RegisterFunc(const char *name, enum ScmFuncArgType argnum, ScmFuncType c_func)
+static void Scm_RegisterFunc(const char *name, enum ScmFuncTypeCode type, ScmFuncType c_func)
{
ScmObj sym = Scm_Intern(name);
- ScmObj func = Scm_NewFunc(argnum, c_func);
+ ScmObj func = Scm_NewFunc(type, c_func);
SCM_SYMBOL_VCELL(sym) = func;
}
-void Scm_RegisterFunc0(const char *name, ScmObj (*func) (void))
+void Scm_RegisterFunc0(const char *name, ScmFuncType0 func)
{
- Scm_RegisterFunc(name, FUNCTYPE_0, (ScmFuncType)func);
+ Scm_RegisterFunc(name, FUNCTYPE_0, func);
}
-void Scm_RegisterFunc1(const char *name, ScmObj (*func) (ScmObj))
+void Scm_RegisterFunc1(const char *name, ScmFuncType1 func)
{
- Scm_RegisterFunc(name, FUNCTYPE_1, (ScmFuncType)func);
+ Scm_RegisterFunc(name, FUNCTYPE_1, func);
}
-void Scm_RegisterFunc2(const char *name, ScmObj (*func) (ScmObj, ScmObj))
+void Scm_RegisterFunc2(const char *name, ScmFuncType2 func)
{
- Scm_RegisterFunc(name, FUNCTYPE_2, (ScmFuncType)func);
+ Scm_RegisterFunc(name, FUNCTYPE_2, func);
}
-void Scm_RegisterFunc3(const char *name, ScmObj (*func) (ScmObj, ScmObj, ScmObj))
+void Scm_RegisterFunc3(const char *name, ScmFuncType3 func)
{
- Scm_RegisterFunc(name, FUNCTYPE_3, (ScmFuncType)func);
+ Scm_RegisterFunc(name, FUNCTYPE_3, func);
}
-void Scm_RegisterFunc4(const char *name, ScmObj (*func) (ScmObj, ScmObj, ScmObj, ScmObj))
+void Scm_RegisterFunc4(const char *name, ScmFuncType4 func)
{
- Scm_RegisterFunc(name, FUNCTYPE_4, (ScmFuncType)func);
+ Scm_RegisterFunc(name, FUNCTYPE_4, func);
}
-void Scm_RegisterFunc5(const char *name, ScmObj (*func) (ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+void Scm_RegisterFunc5(const char *name, ScmFuncType5 func)
{
- Scm_RegisterFunc(name, FUNCTYPE_5, (ScmFuncType)func);
+ Scm_RegisterFunc(name, FUNCTYPE_5, func);
}
-void Scm_RegisterFuncL(const char *name, ScmObj (*func) (ScmObj, ScmObj))
+void Scm_RegisterFuncEvaledList(const char *name, ScmFuncTypeEvaledList func)
{
- Scm_RegisterFunc(name, FUNCTYPE_L, (ScmFuncType)func);
+ Scm_RegisterFunc(name, FUNCTYPE_EVALED_LIST, func);
}
-void Scm_RegisterFuncR(const char *name, ScmObj (*func) (ScmObj, ScmObj*, int *))
+void Scm_RegisterFuncRawList(const char *name, ScmFuncTypeRawList func)
{
- Scm_RegisterFunc(name, FUNCTYPE_R, (ScmFuncType)func);
+ Scm_RegisterFunc(name, FUNCTYPE_RAW_LIST, func);
}
-void Scm_RegisterFunc2N(const char *name, ScmObj (*func) (ScmObj, ScmObj))
+void Scm_RegisterFuncRawListTailRec(const char *name, ScmFuncTypeRawListTailRec func)
{
- Scm_RegisterFunc(name, FUNCTYPE_2N, (ScmFuncType)func);
+ Scm_RegisterFunc(name, FUNCTYPE_RAW_LIST_TAIL_REC, func);
}
+
+void Scm_RegisterFuncRawListWithTailFlag(const char *name, ScmFuncTypeRawListWithTailFlag func)
+{
+ Scm_RegisterFunc(name, FUNCTYPE_RAW_LIST_WITH_TAIL_FLAG, func);
+}
Modified: branches/r5rs/sigscheme/sigscheme.h
===================================================================
--- branches/r5rs/sigscheme/sigscheme.h 2005-08-28 08:27:33 UTC (rev 1343)
+++ branches/r5rs/sigscheme/sigscheme.h 2005-08-28 15:00:30 UTC (rev 1344)
@@ -84,15 +84,16 @@
/* sigscheme.c */
void SigScm_Initialize(void);
void SigScm_Finalize(void);
-void Scm_RegisterFunc0(const char *name, ScmObj (*func) (void));
-void Scm_RegisterFunc1(const char *name, ScmObj (*func) (ScmObj));
-void Scm_RegisterFunc2(const char *name, ScmObj (*func) (ScmObj, ScmObj));
-void Scm_RegisterFunc3(const char *name, ScmObj (*func) (ScmObj, ScmObj, ScmObj));
-void Scm_RegisterFunc4(const char *name, ScmObj (*func) (ScmObj, ScmObj, ScmObj, ScmObj));
-void Scm_RegisterFunc5(const char *name, ScmObj (*func) (ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
-void Scm_RegisterFuncL(const char *name, ScmObj (*func) (ScmObj, ScmObj env));
-void Scm_RegisterFunc2N(const char *name, ScmObj (*func) (ScmObj, ScmObj));
-void Scm_RegisterFuncR(const char *name, ScmObj (*func) (ScmObj, ScmObj *envp, int *tail_flag));
+void Scm_RegisterFunc0(const char *name, ScmFuncType0 func);
+void Scm_RegisterFunc1(const char *name, ScmFuncType1 func);
+void Scm_RegisterFunc2(const char *name, ScmFuncType2 func);
+void Scm_RegisterFunc3(const char *name, ScmFuncType3 func);
+void Scm_RegisterFunc4(const char *name, ScmFuncType4 func);
+void Scm_RegisterFunc5(const char *name, ScmFuncType5 func);
+void Scm_RegisterFuncEvaledList(const char *name, ScmFuncTypeEvaledList func);
+void Scm_RegisterFuncRawList(const char *name, ScmFuncTypeRawList func);
+void Scm_RegisterFuncRawListTailRec(const char *name, ScmFuncTypeRawListTailRec func);
+void Scm_RegisterFuncRawListWithTailFlag(const char *name, ScmFuncTypeRawListWithTailFlag func);
/* datas.c */
void SigScm_InitStorage(void);
@@ -107,7 +108,7 @@
ScmObj Scm_NewString(char *str);
ScmObj Scm_NewStringCopying(const char *str);
ScmObj Scm_NewString_With_StrLen(char *str, int len);
-ScmObj Scm_NewFunc(enum ScmFuncArgType num_arg, ScmFuncType func);
+ScmObj Scm_NewFunc(enum ScmFuncTypeCode type, ScmFuncType func);
ScmObj Scm_NewClosure(ScmObj exp, ScmObj env);
ScmObj Scm_NewVector(ScmObj *vec, int len);
ScmObj Scm_NewFilePort(FILE *file, const char *filename, enum ScmPortDirection pdireciton);
@@ -132,25 +133,25 @@
/* eval.c */
ScmObj ScmOp_eval(ScmObj obj, ScmObj env);
-ScmObj ScmOp_apply(ScmObj arg, ScmObj env);
-ScmObj ScmOp_quote(ScmObj exp, ScmObj *envp, int *tail_flag);
-ScmObj ScmExp_lambda(ScmObj exp, ScmObj *envp, int *tail_flag);
-ScmObj ScmExp_if(ScmObj exp, ScmObj *envp, int *tail_flag);
-ScmObj ScmExp_set(ScmObj arg, ScmObj *envp, int *tail_flag);
-ScmObj ScmExp_cond(ScmObj arg, ScmObj *envp, int *tail_flag);
-ScmObj ScmExp_case(ScmObj arg, ScmObj *envp, int *tail_flag);
+ScmObj ScmOp_apply(ScmObj args, ScmObj env);
+ScmObj ScmOp_quote(ScmObj arglist, ScmObj envp);
+ScmObj ScmExp_lambda(ScmObj exp, ScmObj env);
+ScmObj ScmExp_if(ScmObj exp, ScmObj *envp);
+ScmObj ScmExp_set(ScmObj arg, 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, int *tail_flag);
-ScmObj ScmExp_let_star(ScmObj arg, ScmObj *envp, int *tail_flag);
-ScmObj ScmExp_letrec(ScmObj arg, ScmObj *envp, int *tail_flag);
-ScmObj ScmExp_begin(ScmObj arg, ScmObj *envp, int *tail_flag);
-ScmObj ScmExp_do(ScmObj arg, ScmObj *envp, int *tail_flag);
-ScmObj ScmOp_delay(ScmObj arg, ScmObj *envp, int *tail_flag);
-ScmObj ScmOp_quasiquote(ScmObj obj, ScmObj *envp, int *tail_flag);
-ScmObj ScmOp_unquote(ScmObj obj, ScmObj *envp, int *tail_flag);
-ScmObj ScmOp_unquote_splicing(ScmObj obj, ScmObj *envp, int *tail_flag);
-ScmObj ScmExp_define(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 arg, 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 arg, ScmObj env);
ScmObj ScmOp_scheme_report_environment(ScmObj version);
ScmObj ScmOp_null_environment(ScmObj version);
@@ -158,35 +159,35 @@
ScmObj ScmOp_eqvp(ScmObj obj1, ScmObj obj2);
ScmObj ScmOp_eqp(ScmObj obj1, ScmObj obj2);
ScmObj ScmOp_equalp(ScmObj obj1, ScmObj obj2);
-ScmObj ScmOp_numberp(ScmObj obj);
-ScmObj ScmOp_equal(ScmObj list, ScmObj env);
-ScmObj ScmOp_less(ScmObj list, ScmObj env);
-ScmObj ScmOp_greater(ScmObj list, ScmObj env);
-ScmObj ScmOp_lessEq(ScmObj list, ScmObj env);
-ScmObj ScmOp_greaterEq(ScmObj list, ScmObj env);
-ScmObj ScmOp_zerop(ScmObj num);
-ScmObj ScmOp_positivep(ScmObj num);
-ScmObj ScmOp_negativep(ScmObj num);
-ScmObj ScmOp_oddp(ScmObj num);
-ScmObj ScmOp_evenp(ScmObj num);
-ScmObj ScmOp_max(ScmObj list, ScmObj env);
-ScmObj ScmOp_min(ScmObj list, ScmObj env);
ScmObj ScmOp_plus(ScmObj args, ScmObj env);
+ScmObj ScmOp_times(ScmObj args, ScmObj env);
ScmObj ScmOp_minus(ScmObj args, ScmObj env);
-ScmObj ScmOp_times(ScmObj args, ScmObj env);
ScmObj ScmOp_divide(ScmObj args, ScmObj env);
-ScmObj ScmOp_abs(ScmObj num);
-ScmObj ScmOp_quotient(ScmObj n1, ScmObj n2);
-ScmObj ScmOp_modulo(ScmObj n1, ScmObj n2);
-ScmObj ScmOp_remainder(ScmObj n1, ScmObj n2);
-ScmObj ScmOp_number2string(ScmObj args, ScmObj env);
+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_lessEq(ScmObj args, ScmObj env );
+ScmObj ScmOp_greaterEq(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_abs(ScmObj scm_num);
+ScmObj ScmOp_quotient(ScmObj scm_n1, ScmObj scm_n2);
+ScmObj ScmOp_modulo(ScmObj scm_n1, ScmObj scm_n2);
+ScmObj ScmOp_remainder(ScmObj scm_n1, ScmObj scm_n2);
+ScmObj ScmOp_number2string (ScmObj args, ScmObj env);
ScmObj ScmOp_string2number(ScmObj string);
ScmObj ScmOp_not(ScmObj obj);
ScmObj ScmOp_booleanp(ScmObj obj);
+ScmObj ScmOp_car(ScmObj obj);
+ScmObj ScmOp_cdr(ScmObj obj);
ScmObj ScmOp_pairp(ScmObj obj);
ScmObj ScmOp_cons(ScmObj car, ScmObj cdr);
-ScmObj ScmOp_car(ScmObj pair);
-ScmObj ScmOp_cdr(ScmObj pair);
ScmObj ScmOp_setcar(ScmObj pair, ScmObj car);
ScmObj ScmOp_setcdr(ScmObj pair, ScmObj cdr);
ScmObj ScmOp_caar(ScmObj pair);
@@ -217,14 +218,14 @@
ScmObj ScmOp_cddadr(ScmObj pair);
ScmObj ScmOp_cdddar(ScmObj pair);
ScmObj ScmOp_cddddr(ScmObj pair);
+ScmObj ScmOp_list(ScmObj obj, ScmObj env);
ScmObj ScmOp_nullp(ScmObj obj);
ScmObj ScmOp_listp(ScmObj obj);
-ScmObj ScmOp_list(ScmObj obj, ScmObj env);
ScmObj ScmOp_length(ScmObj obj);
-ScmObj ScmOp_append(ScmObj start, ScmObj item);
-ScmObj ScmOp_reverse(ScmObj obj);
-ScmObj ScmOp_list_tail(ScmObj list, ScmObj k);
-ScmObj ScmOp_list_ref(ScmObj list, ScmObj k);
+ScmObj ScmOp_append(ScmObj args, ScmObj env);
+ScmObj ScmOp_reverse(ScmObj list);
+ScmObj ScmOp_list_tail(ScmObj list, ScmObj scm_k);
+ScmObj ScmOp_list_ref(ScmObj list, ScmObj scm_k);
ScmObj ScmOp_memq(ScmObj obj, ScmObj list);
ScmObj ScmOp_memv(ScmObj obj, ScmObj list);
ScmObj ScmOp_member(ScmObj obj, ScmObj list);
@@ -260,23 +261,22 @@
ScmObj ScmOp_list2string(ScmObj list);
ScmObj ScmOp_string_copy(ScmObj string);
ScmObj ScmOp_string_fill(ScmObj string, ScmObj ch);
-
-ScmObj ScmOp_vectorp(ScmObj vector);
-ScmObj ScmOp_make_vector(ScmObj obj, ScmObj env);
-ScmObj ScmOp_vector(ScmObj obj, ScmObj env);
-ScmObj ScmOp_vector_length(ScmObj vector);
-ScmObj ScmOp_vector_ref(ScmObj vec, ScmObj k);
-ScmObj ScmOp_vector_set(ScmObj vec, ScmObj k, ScmObj obj);
+ScmObj ScmOp_vectorp(ScmObj obj);
+ScmObj ScmOp_make_vector(ScmObj arg, ScmObj env );
+ScmObj ScmOp_vector(ScmObj arg, ScmObj env );
+ScmObj ScmOp_vector_length(ScmObj vec);
+ScmObj ScmOp_vector_ref(ScmObj vec, ScmObj scm_k);
+ScmObj ScmOp_vector_set(ScmObj vec, ScmObj scm_k, ScmObj obj);
ScmObj ScmOp_vector2list(ScmObj vec);
ScmObj ScmOp_list2vector(ScmObj list);
ScmObj ScmOp_vector_fill(ScmObj vec, ScmObj fill);
ScmObj ScmOp_procedurep(ScmObj obj);
-ScmObj ScmOp_map(ScmObj arg, ScmObj env);
+ScmObj ScmOp_map(ScmObj map_arg, ScmObj env);
ScmObj ScmOp_for_each(ScmObj arg, ScmObj env);
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 args, ScmObj *envp, int *tail_flag);
+ScmObj ScmOp_call_with_values(ScmObj argl, ScmObj *envp);
/* io.c */
void SigScm_set_lib_path(const char *path);
@@ -345,7 +345,7 @@
#endif
#if SCM_USE_SRFI8
/* operations-srfi8.c */
-ScmObj ScmOp_SRFI8_receive(ScmObj args, ScmObj *envp, int *tail_flag);
+ScmObj ScmOp_SRFI8_receive(ScmObj args, ScmObj *envp);
#endif
#if SCM_COMPAT_SIOD
/* operations-siod.c */
Modified: branches/r5rs/sigscheme/sigschemetype.h
===================================================================
--- branches/r5rs/sigscheme/sigschemetype.h 2005-08-28 08:27:33 UTC (rev 1343)
+++ branches/r5rs/sigscheme/sigschemetype.h 2005-08-28 15:00:30 UTC (rev 1344)
@@ -45,6 +45,24 @@
=======================================*/
/*=======================================
+ Type Declarations
+=======================================*/
+typedef struct ScmObjInternal_ ScmObjInternal;
+typedef ScmObjInternal *ScmObj;
+typedef struct _ScmPortInfo ScmPortInfo;
+typedef ScmObj (*ScmFuncType)();
+typedef ScmObj (*ScmFuncType0)(void);
+typedef ScmObj (*ScmFuncType1)(ScmObj arg1);
+typedef ScmObj (*ScmFuncType2)(ScmObj arg1, ScmObj arg2);
+typedef ScmObj (*ScmFuncType3)(ScmObj arg1, ScmObj arg2, ScmObj arg3);
+typedef ScmObj (*ScmFuncType4)(ScmObj arg1, ScmObj arg2, ScmObj arg3, ScmObj arg4);
+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);
+
+/*=======================================
Struct Declarations
=======================================*/
/*
@@ -79,19 +97,6 @@
ScmCFuncPointer = 21
};
-/* Function Type by argnuments */
-enum ScmFuncArgType {
- FUNCTYPE_0 = 0, /* no arg */
- FUNCTYPE_1 = 1, /* require 1 arg */
- FUNCTYPE_2 = 2, /* require 2 args */
- FUNCTYPE_3 = 3, /* require 3 args */
- FUNCTYPE_4 = 4, /* require 4 args */
- FUNCTYPE_5 = 5, /* require 5 args */
- FUNCTYPE_L = 6, /* all args are already evaluated, and pass the arg-list to the func*/
- FUNCTYPE_R = 7, /* all args are "not" evaluated */
- FUNCTYPE_2N = 9 /* all args are evaluated with each 2 objs */
-};
-
/* ScmPort direction */
enum ScmPortDirection {
PORT_INPUT = 0,
@@ -105,7 +110,6 @@
};
/* ScmPort Info */
-typedef struct _ScmPortInfo ScmPortInfo;
struct _ScmPortInfo {
enum ScmPortType port_type; /* (PORT_FILE | PORT_STRING) */
@@ -130,10 +134,49 @@
jmp_buf jmp_env;
};
+/*
+ * 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.
+ */
+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] */
+};
/* Scheme Object */
-typedef struct ScmObjInternal_ ScmObjInternal;
-typedef ScmObjInternal *ScmObj;
struct ScmObjInternal_ {
enum ScmObjType type;
int gcmark;
@@ -163,38 +206,41 @@
} string;
struct {
+ enum ScmFuncTypeCode type;
union {
struct {
- ScmObj (*func) (void);
+ ScmFuncType0 func;
} subr0;
-
struct {
- ScmObj (*func) (ScmObj);
+ ScmFuncType1 func;
} subr1;
-
struct {
- ScmObj (*func) (ScmObj, ScmObj);
+ ScmFuncType2 func;
} subr2;
-
struct {
- ScmObj (*func) (ScmObj, ScmObj, ScmObj);
+ ScmFuncType3 func;
} subr3;
-
struct {
- ScmObj (*func) (ScmObj, ScmObj, ScmObj, ScmObj);
+ ScmFuncType4 func;
} subr4;
-
struct {
- ScmObj (*func) (ScmObj, ScmObj, ScmObj, ScmObj, ScmObj);
+ ScmFuncType5 func;
} subr5;
-
+ /* -- these two are identical to subr2
struct {
- ScmObj (*func) (ScmObj, ScmObj*, int*);
+ ScmFuncTypeEvaledList func;
+ } subr_evaled_list;
+ struct {
+ ScmFuncTypeRawList func;
+ } subr_raw_list;
+ */
+ struct {
+ ScmFuncTypeRawListTailRec func;
} subrr;
-
+ struct {
+ ScmFuncTypeRawListWithTailFlag func;
+ } subrf;
} subrs;
-
- enum ScmFuncArgType num_arg;
} func;
struct ScmClosure {
@@ -230,9 +276,6 @@
} obj;
};
-/* C Function */
-typedef ScmObj (*ScmFuncType) (void);
-
/*=======================================
Accessors For Scheme Objects
=======================================*/
@@ -283,8 +326,8 @@
#define SCM_FUNCP(a) (SCM_TYPE(a) == ScmFunc)
#define SCM_AS_FUNC(a) (sigassert(SCM_FUNCP(a)), (a))
#define SCM_ENTYPE_FUNC(a) (SCM_ENTYPE((a), ScmFunc))
-#define SCM_FUNC_NUMARG(a) (SCM_AS_FUNC(a)->obj.func.num_arg)
-#define SCM_FUNC_SET_NUMARG(a, numarg) (SCM_FUNC_NUMARG(a) = (numarg))
+#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_SET_CFUNC(a, func) (SCM_FUNC_CFUNC(a) = (ScmFuncType)(func))
@@ -295,8 +338,8 @@
#define SCM_FUNC_EXEC_SUBR4(a, arg1, arg2, arg3, arg4) ((*(a)->obj.func.subrs.subr4.func) ((arg1), (arg2), (arg3), (arg4)))
#define SCM_FUNC_EXEC_SUBR5(a, arg1, arg2, arg3, arg4, arg5) ((*(a)->obj.func.subrs.subr5.func) ((arg1), (arg2), (arg3), (arg4), (arg5)))
#define SCM_FUNC_EXEC_SUBRL(a, arg1, arg2) ((*(a)->obj.func.subrs.subr2.func) ((arg1), (arg2)))
-#define SCM_FUNC_EXEC_SUBRR(a, arg1, arg2, arg3) ((*(a)->obj.func.subrs.subrr.func) ((arg1), (arg2), (arg3)))
-#define SCM_FUNC_EXEC_SUBR2N(a, arg1, arg2) ((*(a)->obj.func.subrs.subr2.func) ((arg1), (arg2)))
+#define SCM_FUNC_EXEC_SUBRR(a, arg1, arg2) ((*(a)->obj.func.subrs.subrr.func) ((arg1), (arg2)))
+#define SCM_FUNC_EXEC_SUBRF(a, arg1, arg2, arg3) ((*(a)->obj.func.subrs.subrf.func) ((arg1), (arg2), (arg3)))
#define SCM_CLOSUREP(a) (SCM_TYPE(a) == ScmClosure)
#define SCM_AS_CLOSURE(a) (sigassert(SCM_CLOSUREP(a)), (a))
Modified: branches/r5rs/sigscheme/test/test-tail-rec.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-tail-rec.scm 2005-08-28 08:27:33 UTC (rev 1343)
+++ branches/r5rs/sigscheme/test/test-tail-rec.scm 2005-08-28 15:00:30 UTC (rev 1344)
@@ -952,7 +952,8 @@
;; <system dependent ulimit exceeded error message>
;; exploded
(total-report)
-(print "check intentional 'exploded' message printed below")
+(display "check intentional 'exploded' message printed below")
+(newline)
;; test whether the explosive-count is actually explosive
(assert-equal? "improper infinite tail recursion"
More information about the uim-commit
mailing list