[uim-commit] r1640 - branches/r5rs/sigscheme
kzk at freedesktop.org
kzk at freedesktop.org
Wed Sep 28 01:57:18 PDT 2005
Author: kzk
Date: 2005-09-28 01:57:16 -0700 (Wed, 28 Sep 2005)
New Revision: 1640
Modified:
branches/r5rs/sigscheme/eval.c
branches/r5rs/sigscheme/sigscheme.c
branches/r5rs/sigscheme/sigscheme.h
Log:
* change "let*", "letrec", "do" for new FUNCTYPE reorganization
* sigscheme/sigscheme.c
- export "let*" and "letrec" by Scm_RegisterSyntaxVariadicTailRec1
- export "do" by Scm_RegisterSyntaxVariadicTailRec2
* sigscheme/sigscheme.h
- (ScmExp_let_star, ScmExp_letrec, ScmExp_do): change args
* sigscheme/eval.c
- (ScmExp_let_star, ScmExp_letrec, ScmExp_do)
: change args and optimize with SCM_SHIFT* macro
Modified: branches/r5rs/sigscheme/eval.c
===================================================================
--- branches/r5rs/sigscheme/eval.c 2005-09-28 08:57:07 UTC (rev 1639)
+++ branches/r5rs/sigscheme/eval.c 2005-09-28 08:57:16 UTC (rev 1640)
@@ -1041,7 +1041,6 @@
/*===========================================================================
R5RS : 4.2 Derived expression types : 4.2.2 Binding constructs
===========================================================================*/
-/* TODO: Simplify and optimize with SCM_SHIFT_*() macro */
ScmObj ScmExp_let(ScmObj arg, ScmEvalState *eval_state)
{
ScmObj env = eval_state->env;
@@ -1049,6 +1048,8 @@
ScmObj body = SCM_NULL;
ScmObj vars = SCM_NULL;
ScmObj vals = SCM_NULL;
+ ScmObj var = SCM_NULL;
+ ScmObj val = SCM_NULL;
ScmObj binding = SCM_NULL;
/* sanity check */
@@ -1080,9 +1081,10 @@
if (NULLP(CDR(binding)))
SET_CDR(binding, CONS(SCM_NULL, SCM_NULL));
#endif
+ SCM_SHIFT_RAW_2(var, val, binding);
- vars = CONS(CAR(binding), vars);
- vals = CONS(EVAL(CADR(binding), env), vals);
+ vars = CONS(var, vars);
+ vals = CONS(EVAL(val, env), vals);
}
/* create new environment for */
@@ -1109,8 +1111,9 @@
body = CDDR(arg);
for (; !NULLP(bindings); bindings = CDR(bindings)) {
binding = CAR(bindings);
- vars = CONS(CAR(binding), vars);
- vals = CONS(CADR(binding), vals);
+ SCM_SHIFT_RAW_2(var, val, binding);
+ vars = CONS(var, vars);
+ vals = CONS(val, vals);
}
vars = ScmOp_reverse(vars);
@@ -1125,24 +1128,13 @@
return CONS(CAR(arg), vals);
}
-/* TODO: Simplify and optimize with SCM_SHIFT_*() macro */
-ScmObj ScmExp_let_star(ScmObj arg, ScmEvalState *eval_state)
+ScmObj ScmExp_let_star(ScmObj bindings, ScmObj body, ScmEvalState *eval_state)
{
- ScmObj env = eval_state->env;
- ScmObj bindings = SCM_NULL;
- ScmObj body = SCM_NULL;
- ScmObj vars = SCM_NULL;
- ScmObj vals = SCM_NULL;
- ScmObj binding = SCM_NULL;
+ ScmObj env = eval_state->env;
+ ScmObj var = SCM_NULL;
+ ScmObj val = SCM_NULL;
+ ScmObj binding = SCM_NULL;
- /* sanity check */
- if CHECK_2_ARGS(arg)
- SigScm_Error("let* : syntax error");
-
- /* get bindings and body */
- bindings = CAR(arg);
- body = CDR(arg);
-
/*========================================================================
(let* <bindings> <body>)
<bindings> == ((<variable1> <init1>)
@@ -1160,38 +1152,31 @@
if (NULLP(CDR(binding)))
SET_CDR(binding, CONS(SCM_NULL, SCM_NULL));
#endif
+ SCM_SHIFT_RAW_2(var, val, binding);
+ val = EVAL(val, env);
- vars = CONS(CAR(binding), SCM_NULL);
- vals = CONS(EVAL(CADR(binding), env), SCM_NULL);
-
/* add env to each time!*/
- env = extend_environment(vars, vals, env);
+ env = extend_environment(LIST_1(var), LIST_1(val), env);
}
- /* set new env */
- eval_state->env = env;
- /* evaluate */
- return ScmExp_begin(body, eval_state);
} else if (NULLP(bindings)) {
/* extend null environment */
env = extend_environment(SCM_NULL,
SCM_NULL,
env);
-
- /* set new env */
- eval_state->env = env;
- /* evaluate */
- return ScmExp_begin(body, eval_state);
+ } else {
+ SigScm_ErrorObj("let* : invalid binding form : ", bindings);
}
- return SCM_UNDEF;
+ /* set new env */
+ eval_state->env = env;
+ /* evaluate */
+ return ScmExp_begin(body, eval_state);
}
/* TODO: Simplify and optimize with SCM_SHIFT_*() macro */
-ScmObj ScmExp_letrec(ScmObj arg, ScmEvalState *eval_state)
+ScmObj ScmExp_letrec(ScmObj bindings, ScmObj body, ScmEvalState *eval_state)
{
ScmObj env = eval_state->env;
- ScmObj bindings = SCM_NULL;
- ScmObj body = SCM_NULL;
ScmObj vars = SCM_NULL;
ScmObj vals = SCM_NULL;
ScmObj binding = SCM_NULL;
@@ -1199,14 +1184,6 @@
ScmObj val = SCM_NULL;
ScmObj frame = SCM_NULL;
- /* sanity check */
- if (NULLP(arg) || NULLP(CDR(arg)))
- SigScm_Error("letrec : syntax error");
-
- /* get bindings and body */
- bindings = CAR(arg);
- body = CDR(arg);
-
/*========================================================================
(letrec <bindings> <body>)
<bindings> == ((<variable1> <init1>)
@@ -1224,10 +1201,8 @@
if (NULLP(CDR(binding)))
SET_CDR(binding, CONS(SCM_NULL, SCM_NULL));
#endif
+ SCM_SHIFT_RAW_2(var, val, binding);
- var = CAR(binding);
- val = CADR(binding);
-
/* construct vars and vals list */
vars = CONS(var, vars);
vals = CONS(val, vals);
@@ -1285,7 +1260,7 @@
/*===========================================================================
R5RS : 4.2 Derived expression types : 4.2.4 Iteration
===========================================================================*/
-ScmObj ScmExp_do(ScmObj arg, ScmEvalState *eval_state)
+ScmObj ScmExp_do(ScmObj bindings, ScmObj testframe, ScmObj commands, ScmEvalState *eval_state)
{
/*
* (do ((<variable1> <init1> <step1>)
@@ -1295,24 +1270,17 @@
* <command> ...)
*/
ScmObj env = eval_state->env;
- ScmObj bindings = CAR(arg);
ScmObj vars = SCM_NULL;
ScmObj vals = SCM_NULL;
ScmObj steps = SCM_NULL;
ScmObj binding = SCM_NULL;
ScmObj step = SCM_NULL;
- ScmObj testframe = SCM_NULL;
ScmObj test = SCM_NULL;
ScmObj expression = SCM_NULL;
- ScmObj commands = SCM_NULL;
ScmObj tmp_vars = SCM_NULL;
ScmObj tmp_steps = SCM_NULL;
ScmObj obj = SCM_NULL;
- /* sanity check */
- if (SCM_INT_VALUE(ScmOp_length(arg)) < 2)
- SigScm_Error("do : syntax error");
-
/* construct Environment and steps */
for (; !NULLP(bindings); bindings = CDR(bindings)) {
binding = CAR(bindings);
@@ -1331,13 +1299,9 @@
env = extend_environment(vars, vals, env);
/* construct test */
- testframe = CADR(arg);
test = CAR(testframe);
expression = CDR(testframe);
- /* construct commands */
- commands = CDDR(arg);
-
/* now execution phase! */
while (FALSEP(EVAL(test, env))) {
/* execute commands */
Modified: branches/r5rs/sigscheme/sigscheme.c
===================================================================
--- branches/r5rs/sigscheme/sigscheme.c 2005-09-28 08:57:07 UTC (rev 1639)
+++ branches/r5rs/sigscheme/sigscheme.c 2005-09-28 08:57:16 UTC (rev 1640)
@@ -169,10 +169,10 @@
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_RegisterSyntaxVariadicTailRec1("let*" , ScmExp_let_star);
+ Scm_RegisterSyntaxVariadicTailRec1("letrec" , ScmExp_letrec);
Scm_RegisterSyntaxVariadicTailRec0("begin" , ScmExp_begin);
- Scm_RegisterSyntaxVariadicTailRec0("do" , ScmExp_do); /* FIXME */
+ Scm_RegisterSyntaxVariadicTailRec2("do" , ScmExp_do);
Scm_RegisterSyntaxVariadicTailRec0("and" , ScmExp_and);
Scm_RegisterSyntaxVariadicTailRec0("or" , ScmExp_or);
Scm_RegisterFunc1("scheme-report-environment", ScmOp_scheme_report_environment);
Modified: branches/r5rs/sigscheme/sigscheme.h
===================================================================
--- branches/r5rs/sigscheme/sigscheme.h 2005-09-28 08:57:07 UTC (rev 1639)
+++ branches/r5rs/sigscheme/sigscheme.h 2005-09-28 08:57:16 UTC (rev 1640)
@@ -381,10 +381,10 @@
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_let_star(ScmObj bindings, ScmObj body, ScmEvalState *eval_state);
+ScmObj ScmExp_letrec(ScmObj bindings, ScmObj body, ScmEvalState *eval_state);
ScmObj ScmExp_begin(ScmObj arg, ScmEvalState *eval_state);
-ScmObj ScmExp_do(ScmObj arg, ScmEvalState *eval_state);
+ScmObj ScmExp_do(ScmObj bindings, ScmObj testframe, ScmObj commands, ScmEvalState *eval_state);
ScmObj ScmOp_delay(ScmObj expr, ScmObj env);
ScmObj ScmOp_quasiquote(ScmObj datum, ScmObj env);
ScmObj ScmOp_unquote(ScmObj dummy, ScmObj env);
More information about the uim-commit
mailing list