[uim-commit] r1042 - branches/r5rs/sigscheme
kzk at freedesktop.org
kzk at freedesktop.org
Wed Jul 27 16:28:09 EST 2005
Author: kzk
Date: 2005-07-26 23:28:06 -0700 (Tue, 26 Jul 2005)
New Revision: 1042
Modified:
branches/r5rs/sigscheme/datas.c
branches/r5rs/sigscheme/eval.c
branches/r5rs/sigscheme/sigscheme.c
branches/r5rs/sigscheme/sigscheme.h
branches/r5rs/sigscheme/sigschemetype.h
Log:
* This commit implements tail-recursion optimization.
* sigscheme/sigscheme.h
- (Scm_InitSubR_NotEval,
Scm_InitSubR_Eval): new func
- (Scm_InitSubr0, Scm_InitSubr1,
Scm_InitSubr2, Scm_InitSubr3,
Scm_InitSubr4, Scm_InitSubr5,
Scm_InitSubrL, Scm_InitSubr2N): add const quolifier
- (ScmExp_lambda, ScmExp_if,
ScmExp_if, ScmExp_set,
ScmExp_cond, ScmExp_case,
ScmExp_cand, ScmExp_or,
ScmExp_let, ScmExp_let_star,
ScmExp_letrec, ScmExp_begin,
ScmExp_do, ScmExp_delay,
ScmExp_define): change args
* sigscheme/sigschemetype.h
- add ARGNUM_R_NotEval and ARGNUM_R_Eval type
* sigscheme/eval.c
- (ScmOp_eval): handle ARGNUM_R_Eval, and ARGNUM_R_NotEval.
the result of ARGNUM_R_Eval type func is evaluated once
again in the eval_loop. that of ARGNUM_R_NotEval is not
evaluated again.
- (ScmOp_apply): now broken. I'm goint to write apply properly.
- (ScmExp_lambda): change args
- (ScmExp_if): change args. not evaluate body.
- (ScmExp_begin): change args. now begin doesn't evaluate the
last expression. it returns the exp with un-evaluated condition
to the eval.
- (ScmExp_set): change args.
- (ScmExp_cond): change args
- (ScmExp_case): change args
- (ScmExp_and): change args
- (ScmExp_or): change args
- (ScmExp_let): change args
- (ScmExp_let_star): change args
- (ScmExp_letrec): change args
- (ScmExp_do): change args
- (ScmExp_define): change args
* sigscheme/datas.c
- update comment
Modified: branches/r5rs/sigscheme/datas.c
===================================================================
--- branches/r5rs/sigscheme/datas.c 2005-07-27 06:16:56 UTC (rev 1041)
+++ branches/r5rs/sigscheme/datas.c 2005-07-27 06:28:06 UTC (rev 1042)
@@ -38,10 +38,13 @@
* Our GC uses Mark-and-Sweep algorithm. So, we have MARK phase and SWEEP phase.
*
* [1] Mark phase : gc_mark()
+ * - gc_mark_locations()
+ * marking the Scheme object which are stored in the registers.
+ *
* - gc_mark_protected_obj()
- * marking protected Scheme object which are protected by calling SigScm_gc_protect().
+ * marking the protected Scheme object which are protected by calling SigScm_gc_protect().
*
- * - gc_mark_stack()
+ * - gc_mark_locations()
* marking the Scheme object which are pushed to the stack, so we need to
* traverse the stack for marking the objects.
*
Modified: branches/r5rs/sigscheme/eval.c
===================================================================
--- branches/r5rs/sigscheme/eval.c 2005-07-27 06:16:56 UTC (rev 1041)
+++ branches/r5rs/sigscheme/eval.c 2005-07-27 06:28:06 UTC (rev 1042)
@@ -200,6 +200,7 @@
ScmObj tmp = SCM_NIL;
ScmObj arg = SCM_NIL;
+eval_loop:
switch (SCM_GETTYPE(obj)) {
case ScmSymbol:
return symbol_value(obj, env);
@@ -228,8 +229,7 @@
/* QUOTE case */
break;
default:
- SigScm_Display(tmp);
- SigScm_Error("eval : invalid operation\n");
+ SigScm_ErrorObj("eval : invalid operation ", tmp);
break;
}
/*============================================================
@@ -244,12 +244,19 @@
map_eval(SCM_CDR(obj), env),
env);
}
- case ARGNUM_R:
+ case ARGNUM_R_NotEval:
{
return SCM_FUNC_EXEC_SUBRR(tmp,
SCM_CDR(obj),
- env);
+ &env);
}
+ case ARGNUM_R_Eval:
+ {
+ obj = SCM_FUNC_EXEC_SUBRR(tmp,
+ SCM_CDR(obj),
+ &env);
+ goto eval_loop;
+ }
case ARGNUM_2N:
{
obj = SCM_CDR(obj);
@@ -341,8 +348,9 @@
} else {
SigScm_ErrorObj("lambda : bad syntax with ", arg);
}
-
- return ScmExp_begin(SCM_CDR(SCM_CLOSURE_EXP(tmp)), env);
+
+ obj = ScmExp_begin(SCM_CDR(SCM_CLOSURE_EXP(tmp)), &env);
+ goto eval_loop;
}
case ScmContinuation:
{
@@ -365,9 +373,8 @@
}
return tmp;
default:
- SigScm_Display(tmp);
/* What? */
- SigScm_Error("eval : What type of function?\n");
+ SigScm_Error("eval : What type of function? ", tmp);
}
}
@@ -380,107 +387,11 @@
ScmObj ScmOp_apply(ScmObj args, ScmObj env)
{
- ScmObj proc = SCM_NIL;
- ScmObj obj = SCM_NIL;
-
- /* sanity check */
- if CHECK_2_ARGS(args)
- SigScm_Error("apply : Wrong number of arguments\n");
-
- /* 1st elem of list is proc */
- proc = SCM_CAR(args);
-
- /* apply proc */
- switch (SCM_GETTYPE(proc)) {
- case ScmFunc:
- switch (SCM_FUNC_NUMARG(proc)) {
- case ARGNUM_L:
- {
- return SCM_FUNC_EXEC_SUBRL(proc,
- map_eval(SCM_CAR(SCM_CDR(args)), env),
- env);
- }
- case ARGNUM_R:
- {
- return SCM_FUNC_EXEC_SUBRR(proc,
- SCM_CAR(SCM_CDR(args)),
- env);
- }
- case ARGNUM_2N:
- {
- args = SCM_CAR(SCM_CDR(args));
- obj = SCM_CAR(args);
- for (args = SCM_CDR(args); !SCM_NULLP(args); args = SCM_CDR(args)) {
- obj = SCM_FUNC_EXEC_SUBR2N(proc,
- obj,
- ScmOp_eval(SCM_CAR(args), env));
- }
- return obj;
- }
- case ARGNUM_0:
- {
- return SCM_FUNC_EXEC_SUBR0(proc);
- }
- case ARGNUM_1:
- {
- return SCM_FUNC_EXEC_SUBR1(proc,
- SCM_CAR(SCM_CDR(args)));
- }
- case ARGNUM_2:
- {
- return SCM_FUNC_EXEC_SUBR2(proc,
- SCM_CAR(SCM_CDR(args)),
- SCM_CAR(SCM_CDR(SCM_CDR(args))));
- }
- case ARGNUM_3:
- {
- return SCM_FUNC_EXEC_SUBR3(proc,
- SCM_CAR(SCM_CDR(args)),
- SCM_CAR(SCM_CDR(SCM_CDR(args))),
- SCM_CAR(SCM_CDR(SCM_CDR(SCM_CDR(args)))));
- }
- case ARGNUM_4:
- {
- return SCM_FUNC_EXEC_SUBR4(proc,
- SCM_CAR(SCM_CDR(args)),
- SCM_CAR(SCM_CDR(SCM_CDR(args))),
- SCM_CAR(SCM_CDR(SCM_CDR(SCM_CDR(args)))),
- SCM_CAR(SCM_CDR(SCM_CDR(SCM_CDR(SCM_CDR(args))))));
- }
- case ARGNUM_5:
- {
- return SCM_FUNC_EXEC_SUBR5(proc,
- SCM_CAR(SCM_CDR(args)),
- SCM_CAR(SCM_CDR(SCM_CDR(args))),
- SCM_CAR(SCM_CDR(SCM_CDR(SCM_CDR(args)))),
- SCM_CAR(SCM_CDR(SCM_CDR(SCM_CDR(SCM_CDR(args))))),
- SCM_CAR(SCM_CDR(SCM_CDR(SCM_CDR(SCM_CDR(SCM_CDR(args)))))));
- }
- }
- break;
- case ScmClosure:
- {
- env = extend_environment(SCM_CAR(SCM_CLOSURE_EXP(proc)),
- SCM_CAR(SCM_CDR(args)),
- SCM_CLOSURE_ENV(proc));
- return ScmExp_begin(SCM_CDR(SCM_CLOSURE_EXP(proc)), env);
- }
- case ScmEtc:
- if (EQ(proc, SCM_QUOTE)) {
- return SCM_CDR(args);
- }
- if (EQ(proc, SCM_QUASIQUOTE)) {
- return eval_unquote(SCM_CDR(args), env);
- }
- default:
- SigScm_Display(proc);
- SigScm_Error("apply : What type of function?\n");
- }
-
- /* never reaches here */
+ SigScm_Error("apply is now broken\n");
return SCM_NIL;
}
+
static ScmObj symbol_value(ScmObj var, ScmObj env)
{
ScmObj val = SCM_NIL;
@@ -611,8 +522,10 @@
/*===========================================================================
R5RS : 4.1 Primitive expression types : 4.1.4 Procedures
===========================================================================*/
-ScmObj ScmExp_lambda(ScmObj exp, ScmObj env)
+ScmObj ScmExp_lambda(ScmObj exp, ScmObj *envp)
{
+ ScmObj env = *envp;
+
if CHECK_2_ARGS(exp)
SigScm_Error("lambda : too few argument\n");
@@ -622,8 +535,9 @@
/*===========================================================================
R5RS : 4.1 Primitive expression types : 4.1.5 Conditionals
===========================================================================*/
-ScmObj ScmExp_if(ScmObj exp, ScmObj env)
+ScmObj ScmExp_if(ScmObj exp, ScmObj *envp)
{
+ ScmObj env = *envp;
ScmObj pred = SCM_NIL;
ScmObj false_exp = SCM_NIL;
@@ -636,21 +550,22 @@
/* if pred is SCM_TRUE */
if (EQ(pred, SCM_TRUE))
- return ScmOp_eval(SCM_CAR(SCM_CDR(exp)), env);
+ return SCM_CAR(SCM_CDR(exp));
/* if pred is SCM_FALSE */
false_exp = SCM_CDR(SCM_CDR(exp));
if (SCM_NULLP(false_exp))
return SCM_UNDEF;
- return ScmOp_eval(SCM_CAR(false_exp), env);
+ return SCM_CAR(false_exp);
}
/*===========================================================================
R5RS : 4.1 Primitive expression types : 4.1.6 Assignment
===========================================================================*/
-ScmObj ScmExp_set(ScmObj arg, ScmObj env)
+ScmObj ScmExp_set(ScmObj arg, ScmObj *envp)
{
+ ScmObj env = *envp;
ScmObj sym = SCM_CAR(arg);
ScmObj val = SCM_CAR(SCM_CDR(arg));
ScmObj ret = SCM_NIL;
@@ -685,8 +600,9 @@
/*===========================================================================
R5RS : 4.2 Derived expression types : 4.2.1 Conditionals
===========================================================================*/
-ScmObj ScmExp_cond(ScmObj arg, ScmObj env)
+ScmObj ScmExp_cond(ScmObj arg, ScmObj *envp)
{
+ ScmObj env = *envp;
ScmObj clause = SCM_NIL;
ScmObj test = SCM_NIL;
ScmObj exps = SCM_NIL;
@@ -700,7 +616,7 @@
/* evaluate test and check the result */
if (SCM_EQ(ScmOp_eval(test, env), SCM_TRUE)) {
- return ScmExp_begin(exps, env);
+ return ScmExp_begin(exps, &env);
}
}
@@ -708,8 +624,9 @@
return SCM_NIL;
}
-ScmObj ScmExp_case(ScmObj arg, ScmObj env)
+ScmObj ScmExp_case(ScmObj arg, ScmObj *envp)
{
+ ScmObj env = *envp;
ScmObj key = ScmOp_eval(SCM_CAR(arg), env);
ScmObj clause = SCM_NIL;
ScmObj datums = SCM_NIL;
@@ -725,12 +642,12 @@
/* check "else" symbol */
if (SCM_NULLP(SCM_CDR(arg)) && !SCM_CONSP(datums) && EQ(SCM_SYMBOL_VCELL(datums), SCM_TRUE))
- return ScmExp_begin(exps, env);
+ return ScmExp_begin(exps, &env);
/* evaluate datums and compare to key by eqv? */
for (; !SCM_NULLP(datums); datums = SCM_CDR(datums)) {
if (EQ(ScmOp_eqvp(ScmOp_eval(SCM_CAR(datums), env), key), SCM_TRUE)) {
- return ScmExp_begin(exps, env);
+ return ScmExp_begin(exps, &env);;
}
}
}
@@ -738,8 +655,9 @@
return SCM_UNSPECIFIED;
}
-ScmObj ScmExp_and(ScmObj arg, ScmObj env)
+ScmObj ScmExp_and(ScmObj arg, ScmObj *envp)
{
+ ScmObj env = *envp;
ScmObj obj = SCM_NIL;
ScmObj ret = SCM_NIL;
@@ -765,8 +683,9 @@
return SCM_NIL;
}
-ScmObj ScmExp_or(ScmObj arg, ScmObj env)
+ScmObj ScmExp_or(ScmObj arg, ScmObj *envp)
{
+ ScmObj env = *envp;
ScmObj obj = SCM_NIL;
ScmObj ret = SCM_NIL;
@@ -795,8 +714,9 @@
/*===========================================================================
R5RS : 4.2 Derived expression types : 4.2.2 Binding constructs
===========================================================================*/
-ScmObj ScmExp_let(ScmObj arg, ScmObj env)
+ScmObj ScmExp_let(ScmObj arg, ScmObj *envp)
{
+ ScmObj env = *envp;
ScmObj bindings = SCM_NIL;
ScmObj body = SCM_NIL;
ScmObj vars = SCM_NIL;
@@ -826,15 +746,17 @@
/* create new environment for */
env = extend_environment(vars, vals, env);
+ *envp = env;
- return ScmExp_begin(body, env);
+ return ScmExp_begin(body, &env);
}
return SCM_UNDEF;
}
-ScmObj ScmExp_let_star(ScmObj arg, ScmObj env)
+ScmObj ScmExp_let_star(ScmObj arg, ScmObj *envp)
{
+ ScmObj env = *envp;
ScmObj bindings = SCM_NIL;
ScmObj body = SCM_NIL;
ScmObj vars = SCM_NIL;
@@ -865,14 +787,18 @@
env = extend_environment(vars, vals, env);
}
- return ScmExp_begin(body, env);
+ /* set new env */
+ *envp = env;
+
+ return ScmExp_begin(body, &env);;
}
return SCM_UNDEF;
}
-ScmObj ScmExp_letrec(ScmObj arg, ScmObj env)
+ScmObj ScmExp_letrec(ScmObj arg, ScmObj *envp)
{
+ ScmObj env = *envp;
ScmObj bindings = SCM_NIL;
ScmObj body = SCM_NIL;
ScmObj vars = SCM_NIL;
@@ -905,10 +831,13 @@
/* then, evaluate <init> val and (set! var val) */
ScmExp_set(Scm_NewCons(SCM_CAR(binding),
Scm_NewCons(ScmOp_eval(SCM_CAR(SCM_CDR(binding)), env), SCM_NIL)),
- env);
+ &env);
}
- return ScmExp_begin(body, env);
+ /* set new env */
+ *envp = env;
+
+ return ScmExp_begin(body, &env);
}
return SCM_UNDEF;
@@ -918,10 +847,10 @@
/*===========================================================================
R5RS : 4.2 Derived expression types : 4.2.3 Sequencing
===========================================================================*/
-ScmObj ScmExp_begin(ScmObj arg, ScmObj env)
+ScmObj ScmExp_begin(ScmObj arg, ScmObj *envp)
{
+ ScmObj env = *envp;
ScmObj exp = SCM_NIL;
- ScmObj ret = SCM_NIL;
/* sanity check */
if (SCM_NULLP(arg))
@@ -932,12 +861,14 @@
/* eval recursively */
for (; !SCM_NULLP(arg); arg = SCM_CDR(arg)) {
exp = SCM_CAR(arg);
- ret = ScmOp_eval(exp, env);
/* return last expression's result */
if (EQ(SCM_CDR(arg), SCM_NIL)) {
- return ret;
+ *envp = env;
+ return exp;
}
+
+ ScmOp_eval(exp, env);
}
return SCM_UNDEF;
@@ -946,7 +877,7 @@
/*===========================================================================
R5RS : 4.2 Derived expression types : 4.2.4 Iteration
===========================================================================*/
-ScmObj ScmExp_do(ScmObj arg, ScmObj env)
+ScmObj ScmExp_do(ScmObj arg, ScmObj *envp)
{
/*
* (do ((<variable1> <init1> <step1>)
@@ -955,7 +886,7 @@
* (<test> <expression> ...)
* <command> ...)
*/
-
+ ScmObj env = *envp;
ScmObj bindings = SCM_CAR(arg);
ScmObj vars = SCM_NIL;
ScmObj vals = SCM_NIL;
@@ -1002,22 +933,27 @@
/* now excution phase! */
while (!SCM_EQ(ScmOp_eval(test, env), SCM_TRUE)) {
- ScmExp_begin(commands, env);
+ ScmOp_eval(ScmExp_begin(commands, &env), env);
tmp_steps = steps;
for (; !SCM_NULLP(tmp_steps); tmp_steps = SCM_CDR(tmp_steps)) {
- ScmExp_set(SCM_CAR(tmp_steps), env);
+ ScmExp_set(SCM_CAR(tmp_steps), &env);
}
}
- return ScmExp_begin(expression, env);
+ /* set new env */
+ *envp = env;
+
+ return ScmExp_begin(expression, &env);
}
/*===========================================================================
R5RS : 4.2 Derived expression types : 4.2.5 Delayed evaluation
===========================================================================*/
-ScmObj ScmOp_delay(ScmObj arg, ScmObj env)
+ScmObj ScmOp_delay(ScmObj arg, ScmObj *envp)
{
+ ScmObj env = *envp;
+
if (SCM_INT_VALUE(ScmOp_length(arg)) != 1)
SigScm_Error("delay : Wrong number of arguments\n");
@@ -1047,8 +983,9 @@
/*=======================================
R5RS : 5.2 Definitions
=======================================*/
-ScmObj ScmExp_define(ScmObj arg, ScmObj env)
+ScmObj ScmExp_define(ScmObj arg, ScmObj *envp)
{
+ ScmObj env = *envp;
ScmObj var = SCM_CAR(arg);
ScmObj body = SCM_CAR(SCM_CDR(arg));
ScmObj val = SCM_NIL;
@@ -1078,6 +1015,9 @@
}
}
+ /* set new env */
+ *envp = env;
+
return var;
}
@@ -1099,10 +1039,10 @@
body = SCM_CDR(arg);
/* (val (lambda formals body)) */
- arg = Scm_NewCons(val, Scm_NewCons(ScmExp_lambda(Scm_NewCons(formals, body), env),
+ arg = Scm_NewCons(val, Scm_NewCons(ScmExp_lambda(Scm_NewCons(formals, body), &env),
SCM_NIL));
- return ScmExp_define(arg, env);
+ return ScmExp_define(arg, &env);
}
SigScm_Error("define : syntax error\n");
Modified: branches/r5rs/sigscheme/sigscheme.c
===================================================================
--- branches/r5rs/sigscheme/sigscheme.c 2005-07-27 06:16:56 UTC (rev 1041)
+++ branches/r5rs/sigscheme/sigscheme.c 2005-07-27 06:28:06 UTC (rev 1042)
@@ -55,7 +55,7 @@
/*=======================================
File Local Function Declarations
=======================================*/
-static void Scm_InitSubr(char *name, enum ScmFuncArgNum argnum, ScmFuncType func);
+static void Scm_InitSubr(const char *name, enum ScmFuncArgNum argnum, ScmFuncType func);
ScmObj SigScm_nil, SigScm_true, SigScm_false, SigScm_eof;
ScmObj SigScm_quote, SigScm_quasiquote, SigScm_unquote, SigScm_unquote_splicing;
@@ -103,20 +103,20 @@
/* eval.c */
Scm_InitSubr2("eval" , ScmOp_eval);
Scm_InitSubrL("apply" , ScmOp_apply);
- Scm_InitSubrR("lambda" , ScmExp_lambda);
- Scm_InitSubrR("if" , ScmExp_if);
- Scm_InitSubrR("set!" , ScmExp_set);
- Scm_InitSubrR("cond" , ScmExp_cond);
- Scm_InitSubrR("case" , ScmExp_case);
- Scm_InitSubrR("and" , ScmExp_and);
- Scm_InitSubrR("or" , ScmExp_or);
- Scm_InitSubrR("let" , ScmExp_let);
- Scm_InitSubrR("let*" , ScmExp_let_star);
- Scm_InitSubrR("letrec" , ScmExp_letrec);
- Scm_InitSubrR("begin" , ScmExp_begin);
- Scm_InitSubrR("do" , ScmExp_do);
- Scm_InitSubrR("delay" , ScmOp_delay);
- Scm_InitSubrR("define" , ScmExp_define);
+ Scm_InitSubrR_NotEval("lambda" , ScmExp_lambda);
+ Scm_InitSubrR_Eval ("if" , ScmExp_if);
+ Scm_InitSubrR_NotEval("set!" , ScmExp_set);
+ Scm_InitSubrR_Eval ("cond" , ScmExp_cond);
+ Scm_InitSubrR_Eval ("case" , ScmExp_case);
+ Scm_InitSubrR_NotEval("and" , ScmExp_and);
+ Scm_InitSubrR_NotEval("or" , ScmExp_or);
+ Scm_InitSubrR_Eval ("let" , ScmExp_let);
+ Scm_InitSubrR_Eval ("let*" , ScmExp_let_star);
+ Scm_InitSubrR_Eval ("letrec" , ScmExp_letrec);
+ Scm_InitSubrR_Eval ("begin" , ScmExp_begin);
+ Scm_InitSubrR_Eval ("do" , ScmExp_do);
+ Scm_InitSubrR_NotEval("delay" , ScmOp_delay);
+ Scm_InitSubrR_NotEval("define" , ScmExp_define);
Scm_InitSubr1("scheme-report-environment", ScmOp_scheme_report_environment);
Scm_InitSubr1("null-environment" , ScmOp_null_environment);
/* operations.c */
@@ -288,7 +288,7 @@
/*===========================================================================
Scheme Function Export Related Functions
===========================================================================*/
-static void Scm_InitSubr(char *name, enum ScmFuncArgNum argnum, ScmFuncType c_func)
+static void Scm_InitSubr(const char *name, enum ScmFuncArgNum argnum, ScmFuncType c_func)
{
ScmObj sym = Scm_Intern(name);
ScmObj func = Scm_NewFunc(argnum, c_func);
@@ -296,47 +296,52 @@
SCM_SYMBOL_VCELL(sym) = func;
}
-void Scm_InitSubr0(char *name, ScmObj (*func) (void))
+void Scm_InitSubr0(const char *name, ScmObj (*func) (void))
{
Scm_InitSubr(name, ARGNUM_0, (ScmFuncType)func);
}
-void Scm_InitSubr1(char *name, ScmObj (*func) (ScmObj))
+void Scm_InitSubr1(const char *name, ScmObj (*func) (ScmObj))
{
Scm_InitSubr(name, ARGNUM_1, (ScmFuncType)func);
}
-void Scm_InitSubr2(char *name, ScmObj (*func) (ScmObj, ScmObj))
+void Scm_InitSubr2(const char *name, ScmObj (*func) (ScmObj, ScmObj))
{
Scm_InitSubr(name, ARGNUM_2, (ScmFuncType)func);
}
-void Scm_InitSubr3(char *name, ScmObj (*func) (ScmObj, ScmObj, ScmObj))
+void Scm_InitSubr3(const char *name, ScmObj (*func) (ScmObj, ScmObj, ScmObj))
{
Scm_InitSubr(name, ARGNUM_3, (ScmFuncType)func);
}
-void Scm_InitSubr4(char *name, ScmObj (*func) (ScmObj, ScmObj, ScmObj, ScmObj))
+void Scm_InitSubr4(const char *name, ScmObj (*func) (ScmObj, ScmObj, ScmObj, ScmObj))
{
Scm_InitSubr(name, ARGNUM_4, (ScmFuncType)func);
}
-void Scm_InitSubr5(char *name, ScmObj (*func) (ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+void Scm_InitSubr5(const char *name, ScmObj (*func) (ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
{
Scm_InitSubr(name, ARGNUM_5, (ScmFuncType)func);
}
-void Scm_InitSubrL(char *name, ScmObj (*func) (ScmObj, ScmObj))
+void Scm_InitSubrL(const char *name, ScmObj (*func) (ScmObj, ScmObj))
{
Scm_InitSubr(name, ARGNUM_L, (ScmFuncType)func);
}
-void Scm_InitSubrR(char *name, ScmObj (*func) (ScmObj, ScmObj))
+void Scm_InitSubrR_NotEval(const char *name, ScmObj (*func) (ScmObj, ScmObj*))
{
- Scm_InitSubr(name, ARGNUM_R, (ScmFuncType)func);
+ Scm_InitSubr(name, ARGNUM_R_NotEval, (ScmFuncType)func);
}
-void Scm_InitSubr2N(char *name, ScmObj (*func) (ScmObj, ScmObj))
+void Scm_InitSubrR_Eval(const char *name, ScmObj (*func) (ScmObj, ScmObj*))
{
+ Scm_InitSubr(name, ARGNUM_R_Eval, (ScmFuncType)func);
+}
+
+void Scm_InitSubr2N(const char *name, ScmObj (*func) (ScmObj, ScmObj))
+{
Scm_InitSubr(name, ARGNUM_2N, (ScmFuncType)func);
}
Modified: branches/r5rs/sigscheme/sigscheme.h
===================================================================
--- branches/r5rs/sigscheme/sigscheme.h 2005-07-27 06:16:56 UTC (rev 1041)
+++ branches/r5rs/sigscheme/sigscheme.h 2005-07-27 06:28:06 UTC (rev 1042)
@@ -100,15 +100,16 @@
/* sigscheme.c */
void SigScm_Initialize(void);
void SigScm_Finalize(void);
-void Scm_InitSubr0(char *name, ScmObj (*func) (void));
-void Scm_InitSubr1(char *name, ScmObj (*func) (ScmObj));
-void Scm_InitSubr2(char *name, ScmObj (*func) (ScmObj, ScmObj));
-void Scm_InitSubr3(char *name, ScmObj (*func) (ScmObj, ScmObj, ScmObj));
-void Scm_InitSubr4(char *name, ScmObj (*func) (ScmObj, ScmObj, ScmObj, ScmObj));
-void Scm_InitSubr5(char *name, ScmObj (*func) (ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
-void Scm_InitSubrL(char *name, ScmObj (*func) (ScmObj, ScmObj env));
-void Scm_InitSubrR(char *name, ScmObj (*func) (ScmObj, ScmObj env));
-void Scm_InitSubr2N(char *name, ScmObj (*func) (ScmObj, ScmObj));
+void Scm_InitSubr0(const char *name, ScmObj (*func) (void));
+void Scm_InitSubr1(const char *name, ScmObj (*func) (ScmObj));
+void Scm_InitSubr2(const char *name, ScmObj (*func) (ScmObj, ScmObj));
+void Scm_InitSubr3(const char *name, ScmObj (*func) (ScmObj, ScmObj, ScmObj));
+void Scm_InitSubr4(const char *name, ScmObj (*func) (ScmObj, ScmObj, ScmObj, ScmObj));
+void Scm_InitSubr5(const char *name, ScmObj (*func) (ScmObj, ScmObj, ScmObj, ScmObj, ScmObj));
+void Scm_InitSubrL(const char *name, ScmObj (*func) (ScmObj, ScmObj env));
+void Scm_InitSubrR_NotEval(const char *name, ScmObj (*func) (ScmObj, ScmObj *envp));
+void Scm_InitSubrR_Eval(const char *name, ScmObj (*func) (ScmObj, ScmObj *envp));
+void Scm_InitSubr2N(const char *name, ScmObj (*func) (ScmObj, ScmObj));
/* datas.c */
void SigScm_InitStorage(void);
@@ -142,23 +143,23 @@
ScmObj ScmOp_eval(ScmObj obj, ScmObj env);
ScmObj ScmOp_apply(ScmObj arg, ScmObj env);
ScmObj ScmOp_quote(ScmObj obj);
-ScmObj ScmExp_lambda(ScmObj exp, ScmObj env);
-ScmObj ScmExp_if(ScmObj exp, ScmObj env);
-ScmObj ScmExp_set(ScmObj arg, ScmObj env);
-ScmObj ScmExp_cond(ScmObj arg, ScmObj env);
-ScmObj ScmExp_case(ScmObj arg, ScmObj env);
-ScmObj ScmExp_and(ScmObj arg, ScmObj env);
-ScmObj ScmExp_or(ScmObj arg, ScmObj env);
-ScmObj ScmExp_let(ScmObj arg, ScmObj env);
-ScmObj ScmExp_let_star(ScmObj arg, ScmObj env);
-ScmObj ScmExp_letrec(ScmObj arg, ScmObj env);
-ScmObj ScmExp_begin(ScmObj arg, ScmObj env);
-ScmObj ScmExp_do(ScmObj arg, ScmObj env);
-ScmObj ScmOp_delay(ScmObj arg, ScmObj env);
+ScmObj ScmExp_lambda(ScmObj exp, ScmObj *envp);
+ScmObj ScmExp_if(ScmObj exp, ScmObj *envp);
+ScmObj ScmExp_set(ScmObj arg, ScmObj *envp);
+ScmObj ScmExp_cond(ScmObj arg, ScmObj *envp);
+ScmObj ScmExp_case(ScmObj arg, ScmObj *envp);
+ScmObj ScmExp_and(ScmObj arg, ScmObj *envp);
+ScmObj ScmExp_or(ScmObj arg, ScmObj *envp);
+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 *envp);
ScmObj ScmOp_quasiquote(ScmObj temp);
ScmObj ScmOp_unquote(ScmObj exp);
ScmObj ScmOp_unquote_splicint(ScmObj exp);
-ScmObj ScmExp_define(ScmObj arg, ScmObj env);
+ScmObj ScmExp_define(ScmObj arg, ScmObj *envp);
ScmObj ScmOp_scheme_report_environment(ScmObj version);
ScmObj ScmOp_null_environment(ScmObj version);
Modified: branches/r5rs/sigscheme/sigschemetype.h
===================================================================
--- branches/r5rs/sigscheme/sigschemetype.h 2005-07-27 06:16:56 UTC (rev 1041)
+++ branches/r5rs/sigscheme/sigschemetype.h 2005-07-27 06:28:06 UTC (rev 1042)
@@ -68,15 +68,16 @@
/* Function Type by argnuments */
enum ScmFuncArgNum {
- ARGNUM_0 = 0,
- ARGNUM_1 = 1,
- ARGNUM_2 = 2,
- ARGNUM_3 = 3,
- ARGNUM_4 = 4,
- ARGNUM_5 = 5,
- ARGNUM_L = 6, /* all args are already evaluated */
- ARGNUM_R = 7, /* all args are "not" evaluated yet */
- ARGNUM_2N = 8 /* all args are evaluated each 2 objs */
+ ARGNUM_0 = 0, /* no arg */
+ ARGNUM_1 = 1, /* require 1 arg */
+ ARGNUM_2 = 2, /* require 2 args */
+ ARGNUM_3 = 3, /* require 3 args */
+ ARGNUM_4 = 4, /* require 4 args */
+ ARGNUM_5 = 5, /* require 5 args */
+ ARGNUM_L = 6, /* all args are already evaluated, and pass the arg-list to the func*/
+ ARGNUM_R_NotEval = 7, /* all args are "not" evaluated yet, and return obj is not evaluated */
+ ARGNUM_R_Eval = 8, /* all args are "not" evaluated yet, and return obj is evaluated */
+ ARGNUM_2N = 9 /* all args are evaluated with each 2 objs */
};
/* GC Mark Flag */
@@ -177,6 +178,11 @@
struct {
ScmObj (*func) (ScmObj, ScmObj, ScmObj, ScmObj, ScmObj);
} subr5;
+
+ struct {
+ ScmObj (*func) (ScmObj, ScmObj*);
+ } subrm;
+
} subrs;
enum ScmFuncArgNum num_arg;
@@ -283,7 +289,7 @@
#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) ((*a->obj.func.subrs.subr2.func) (arg1, arg2))
+#define SCM_FUNC_EXEC_SUBRR(a, arg1, arg2) ((*a->obj.func.subrs.subrm.func) (arg1, arg2))
#define SCM_FUNC_EXEC_SUBR2N(a, arg1, arg2) ((*a->obj.func.subrs.subr2.func) (arg1, arg2))
#define SCM_CLOSUREP(a) (SCM_GETTYPE(a) == ScmClosure)
More information about the uim-commit
mailing list