[uim-commit] r1347 - branches/r5rs/sigscheme
kzk at freedesktop.org
kzk at freedesktop.org
Sun Aug 28 22:23:27 PDT 2005
Author: kzk
Date: 2005-08-28 22:23:24 -0700 (Sun, 28 Aug 2005)
New Revision: 1347
Modified:
branches/r5rs/sigscheme/eval.c
branches/r5rs/sigscheme/operations.c
branches/r5rs/sigscheme/sigscheme.c
Log:
* optimize "max","min","+","*","-" and "/"
If we use FUNCTYPE_EVALED_LIST, map_eval creates new cons cell
for argument. So, change functype to FUNCTYPE_RAW_LIST to evaluate
value directly.
* now can apply FUNCTYPE_RAW_LIST
* sigscheme/eval.c
- (ScmOp_apply): change to be able to handle FUNCTYPE_RAW_LIST
* sigscheme/sigscheme.c
- (SigScm_Initialize): change func type of "max","min","+","*","-"
and "/"
* sigscheme/eval.c
- (ScmOp_max, ScmOp_min, ScmOp_plus, ScmOp_times, ScmOp_minus,
ScmOp_divide): change func type to FUNCTYPE_RAW_LIST. so need
to evaluate args. This doesn't produce excessive cons cell.
* sigscheme/test/test-num.scm
- add testcase for "max" and "min"
Modified: branches/r5rs/sigscheme/eval.c
===================================================================
--- branches/r5rs/sigscheme/eval.c 2005-08-28 16:10:22 UTC (rev 1346)
+++ branches/r5rs/sigscheme/eval.c 2005-08-29 05:23:24 UTC (rev 1347)
@@ -532,6 +532,10 @@
CAR(CDR(CDR(CDR(CDR(obj))))));
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);
Modified: branches/r5rs/sigscheme/operations.c
===================================================================
--- branches/r5rs/sigscheme/operations.c 2005-08-28 16:10:22 UTC (rev 1346)
+++ branches/r5rs/sigscheme/operations.c 2005-08-29 05:23:24 UTC (rev 1347)
@@ -257,11 +257,10 @@
ScmObj ScmOp_plus(ScmObj args, ScmObj env)
{
int result = 0;
- ScmObj ls;
- ScmObj operand;
+ ScmObj operand = SCM_NULL;
- for (ls = args; !NULLP(ls); ls = CDR(ls)) {
- operand = CAR(ls);
+ for (; !NULLP(args); args = CDR(args)) {
+ operand = ScmOp_eval(CAR(args), env);
if (!INTP(operand))
SigScm_ErrorObj("+ : integer required but got ", operand);
result += SCM_INT_VALUE(operand);
@@ -273,11 +272,10 @@
ScmObj ScmOp_times(ScmObj args, ScmObj env)
{
int result = 1;
- ScmObj operand;
- ScmObj ls;
+ ScmObj operand = SCM_NULL;
- for (ls=args; !NULLP(ls); ls = CDR(ls)) {
- operand = CAR(ls);
+ for (; !NULLP(args); args = CDR(args)) {
+ operand = ScmOp_eval(CAR(args), env);
if (!INTP(operand))
SigScm_ErrorObj("* : integer required but got ", operand);
result *= SCM_INT_VALUE(operand);
@@ -288,23 +286,21 @@
ScmObj ScmOp_minus(ScmObj args, ScmObj env)
{
- int result;
- ScmObj operand;
- ScmObj ls;
+ int result = 0;
+ ScmObj operand = SCM_NULL;
- ls = args;
- if (NULLP(ls))
- SigScm_Error("- : at least 1 argument required");
+ if (NULLP(args))
+ SigScm_Error("- : at least 1 argument required\n");
- result = SCM_INT_VALUE(CAR(ls));
- ls = CDR(ls);
+ result = SCM_INT_VALUE(ScmOp_eval(CAR(args), env));
+ args = CDR(args);
/* single arg */
- if (NULLP(ls))
+ if (NULLP(args))
return Scm_NewInt(-result);
- for (; !NULLP(ls); ls = CDR(ls)) {
- operand = CAR(ls);
+ for (; !NULLP(args); args = CDR(args)) {
+ operand = ScmOp_eval(CAR(args), env);
if (!INTP(operand))
SigScm_ErrorObj("- : integer required but got ", operand);
result -= SCM_INT_VALUE(operand);
@@ -315,22 +311,21 @@
ScmObj ScmOp_divide(ScmObj args, ScmObj env)
{
- int result;
- ScmObj operand;
- ScmObj ls;
+ int result = 0;
+ ScmObj operand = SCM_NULL;
if (NULLP(args))
- SigScm_Error("/ : at least 1 argument required");
+ SigScm_Error("/ : at least 1 argument required\n");
- result = SCM_INT_VALUE(CAR(args));
- ls = CDR(args);
+ result = SCM_INT_VALUE(ScmOp_eval(CAR(args), env));
+ args = CDR(args);
/* single arg */
- if (NULLP(ls))
+ if (NULLP(args))
return Scm_NewInt(1 / result);
- for (; !NULLP(ls); ls = CDR(ls)) {
- operand = CAR(ls);
+ for (; !NULLP(args); args = CDR(args)) {
+ operand = ScmOp_eval(CAR(args), env);
if (!INTP(operand))
SigScm_ErrorObj("/ : integer required but got ", operand);
@@ -556,24 +551,21 @@
ScmObj ScmOp_max(ScmObj args, ScmObj env )
{
- int max = 0;
- int car_val = 0;
- ScmObj car = SCM_NULL;
- ScmObj maxobj = SCM_NULL;
+ int max = 0;
+ int val = 0;
+ ScmObj scm_num = SCM_NULL;
if (NULLP(args))
SigScm_Error("max : at least 1 number required\n");
for (; !NULLP(args); args = CDR(args)) {
- car = CAR(args);
- if (FALSEP(ScmOp_numberp(car)))
- SigScm_ErrorObj("max : number required but got ", car);
+ scm_num = ScmOp_eval(CAR(args), env);
+ if (FALSEP(ScmOp_numberp(scm_num)))
+ SigScm_ErrorObj("max : number required but got ", scm_num);
- car_val = SCM_INT_VALUE(car);
- if (max < car_val) {
- max = car_val;
- maxobj = car;
- }
+ val = SCM_INT_VALUE(scm_num);
+ if (max < val)
+ max = val;
}
return Scm_NewInt(max);
@@ -581,27 +573,24 @@
ScmObj ScmOp_min(ScmObj args, ScmObj env )
{
- int min = 0;
- int car_val = 0;
- ScmObj car = SCM_NULL;
- ScmObj minobj = SCM_NULL;
+ int min = 0;
+ int val = 0;
+ ScmObj scm_num = SCM_NULL;
if (NULLP(args))
SigScm_Error("min : at least 1 number required\n");
for (; !NULLP(args); args = CDR(args)) {
- car = CAR(args);
- if (FALSEP(ScmOp_numberp(car)))
- SigScm_ErrorObj("min : number required but got ", car);
+ scm_num = CAR(args);
+ if (FALSEP(ScmOp_numberp(scm_num)))
+ SigScm_ErrorObj("min : number required but got ", scm_num);
- car_val = SCM_INT_VALUE(car);
- if (car_val < min) {
- min = car_val;
- minobj = car;
- }
+ val = SCM_INT_VALUE(scm_num);
+ if (val < min)
+ min = val;
}
- return minobj;
+ return Scm_NewInt(min);
}
Modified: branches/r5rs/sigscheme/sigscheme.c
===================================================================
--- branches/r5rs/sigscheme/sigscheme.c 2005-08-28 16:10:22 UTC (rev 1346)
+++ branches/r5rs/sigscheme/sigscheme.c 2005-08-29 05:23:24 UTC (rev 1347)
@@ -159,12 +159,12 @@
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_RegisterFuncRawList("max" , ScmOp_max);
+ Scm_RegisterFuncRawList("min" , ScmOp_min);
+ Scm_RegisterFuncRawList("+" , ScmOp_plus);
+ Scm_RegisterFuncRawList("*" , ScmOp_times);
+ Scm_RegisterFuncRawList("-" , ScmOp_minus);
+ Scm_RegisterFuncRawList("/" , ScmOp_divide);
Scm_RegisterFunc1("abs" , ScmOp_abs);
Scm_RegisterFunc2("quotient" , ScmOp_quotient);
Scm_RegisterFunc2("modulo" , ScmOp_modulo);
More information about the uim-commit
mailing list