[uim-commit] r2796 - branches/r5rs/sigscheme
yamaken at freedesktop.org
yamaken at freedesktop.org
Wed Jan 4 19:34:25 PST 2006
Author: yamaken
Date: 2006-01-04 19:34:15 -0800 (Wed, 04 Jan 2006)
New Revision: 2796
Modified:
branches/r5rs/sigscheme/TODO
branches/r5rs/sigscheme/env.c
branches/r5rs/sigscheme/eval.c
branches/r5rs/sigscheme/io.c
branches/r5rs/sigscheme/operations-nonstd.c
branches/r5rs/sigscheme/operations-siod.c
branches/r5rs/sigscheme/operations-srfi6.c
branches/r5rs/sigscheme/operations.c
branches/r5rs/sigscheme/sigscheme.c
branches/r5rs/sigscheme/syntax.c
Log:
* This commit remove side-effective expression in macros
* sigscheme/env.c
- (scm_add_environment): Ditto
* sigscheme/eval.c
- (map_eval): Ditto
* sigscheme/syntax.c
- (scm_s_if, scm_s_do, define_internal): Ditto
* sigscheme/io.c
- (scm_make_shared_file_port, scm_p_open_input_file,
scm_p_open_output_file, scm_p_char_readyp): Ditto
* sigscheme/sigscheme.c
- (scm_eval_c_string_internal): Ditto
* sigscheme/operations.c
- (scm_p_string_length, map_single_arg, map_multiple_args): Ditto
* sigscheme/operations-nonstd.c
- (scm_p_symbol_boundp): Ditto
* sigscheme/operations-siod.c
- (scm_initialize_siod, scm_p_closure_code): Ditto
* sigscheme/operations-srfi6.c
- (scm_p_srfi6_open_input_string, scm_p_srfi6_open_output_string):
Ditto
* sigscheme/TODO
- Update
Modified: branches/r5rs/sigscheme/TODO
===================================================================
--- branches/r5rs/sigscheme/TODO 2006-01-05 01:47:07 UTC (rev 2795)
+++ branches/r5rs/sigscheme/TODO 2006-01-05 03:34:15 UTC (rev 2796)
@@ -9,22 +9,24 @@
- Generate and pack sigschemefunctable*.[hc] into distribution file by make
dist
-* Fix all destructive expression on macros
+* Fix all side-effective expression in macros
+ - All files except for operations-srfi1.c and test-compact.c are checked
+ - scm_s_do() and qquote_internal() still have such expression
-* Review and refactor all functions in syntax.c(listran, vectran,
- qquote_internal, scm_s_quasiquote, scm_s_do) and storage-fatty.h (other files
- had already been done except for the destructive exp on macros)
+* Review and refactor some functions in syntax.c(listran, vectran,
+ qquote_internal, scm_s_quasiquote, scm_s_do) (other files had already been
+ done except for the destructive exp on macros)
+* Fix scm_s_do()
+ - SEGV conditions by manual arg extraction
+ - expensive operations
+
* Investigate behavior of other Scheme implementations about constant vector
and list
- Implement if needed
* Make 64bit-safe (after compaction and stdint.h)
-* Fix scm_s_do()
- - SEGV conditions by manual arg extraction
- - expensive operations
-
* Add tests for proper tail recursion with 'apply' and 'guard' to
test-tail-rec.scm
@@ -66,14 +68,9 @@
==============================================================================
Logical simplifications:
-* Simplify argument extraction by DECLARE_FUNCTION, ASSERT_*P, POP_ARG and
- NO_MORE_ARG macros in all procedure and syntaxes
-
==============================================================================
Namings and Cosmetic things:
-* Elimnate initialization for variables and aggregate by type
-
* Rename "Macro Declarations" of all C files, "Macro Definitions" and move to
immediately after of "Local Include" section since other declarations and
definitions sometimes need macros
Modified: branches/r5rs/sigscheme/env.c
===================================================================
--- branches/r5rs/sigscheme/env.c 2006-01-05 01:47:07 UTC (rev 2795)
+++ branches/r5rs/sigscheme/env.c 2006-01-05 03:34:15 UTC (rev 2796)
@@ -130,8 +130,9 @@
newest_frame = CAR(env);
new_vars = CONS(var, CAR(newest_frame));
new_vals = CONS(val, CDR(newest_frame));
+ newest_frame = CONS(new_vars, new_vals);
- SET_CAR(env, CONS(new_vars, new_vals));
+ SET_CAR(env, newest_frame);
} else {
ERR_OBJ("broken environent", env);
}
Modified: branches/r5rs/sigscheme/eval.c
===================================================================
--- branches/r5rs/sigscheme/eval.c 2006-01-05 01:47:07 UTC (rev 2795)
+++ branches/r5rs/sigscheme/eval.c 2006-01-05 03:34:15 UTC (rev 2796)
@@ -435,8 +435,10 @@
SCM_QUEUE_ADD(q, elm);
}
/* dot list */
- if (!NULLP(args))
- SCM_QUEUE_SLOPPY_APPEND(q, EVAL(args, env));
+ if (!NULLP(args)) {
+ elm = EVAL(args, env);
+ SCM_QUEUE_SLOPPY_APPEND(q, elm);
+ }
return res;
}
Modified: branches/r5rs/sigscheme/io.c
===================================================================
--- branches/r5rs/sigscheme/io.c 2006-01-05 01:47:07 UTC (rev 2795)
+++ branches/r5rs/sigscheme/io.c 2006-01-05 03:34:15 UTC (rev 2796)
@@ -122,14 +122,17 @@
#endif
}
-ScmObj scm_make_shared_file_port(FILE *file, const char *aux_info,
- enum ScmPortFlag flag)
+ScmObj
+scm_make_shared_file_port(FILE *file, const char *aux_info,
+ enum ScmPortFlag flag)
{
ScmBytePort *bport;
+ ScmCharPort *cport;
/* GC safe */
bport = ScmFilePort_new_shared(file, aux_info);
- return MAKE_PORT(scm_make_char_port(bport), flag);
+ cport = scm_make_char_port(bport);
+ return MAKE_PORT(cport, flag);
}
int
@@ -359,6 +362,7 @@
scm_p_open_input_file(ScmObj filepath)
{
ScmBytePort *bport;
+ ScmCharPort *cport;
DECLARE_FUNCTION("open-input-file", procedure_fixed_1);
ENSURE_STRING(filepath);
@@ -366,14 +370,16 @@
bport = ScmFilePort_open_input_file(SCM_STRING_STR(filepath));
if (!bport)
ERR_OBJ("cannot open file ", filepath);
+ cport = scm_make_char_port(bport);
- return MAKE_PORT(scm_make_char_port(bport), SCM_PORTFLAG_INPUT);
+ return MAKE_PORT(cport, SCM_PORTFLAG_INPUT);
}
ScmObj
scm_p_open_output_file(ScmObj filepath)
{
ScmBytePort *bport;
+ ScmCharPort *cport;
DECLARE_FUNCTION("open-output-file", procedure_fixed_1);
ENSURE_STRING(filepath);
@@ -381,8 +387,9 @@
bport = ScmFilePort_open_output_file(SCM_STRING_STR(filepath));
if (!bport)
ERR_OBJ("cannot open file ", filepath);
+ cport = scm_make_char_port(bport);
- return MAKE_PORT(scm_make_char_port(bport), SCM_PORTFLAG_OUTPUT);
+ return MAKE_PORT(cport, SCM_PORTFLAG_OUTPUT);
}
ScmObj
@@ -474,11 +481,13 @@
scm_p_char_readyp(ScmObj args)
{
ScmObj port;
+ scm_bool res;
DECLARE_FUNCTION("char-ready?", procedure_variadic_0);
PREPARE_PORT(port, args, scm_in);
+ res = scm_port_char_readyp(port);
- return MAKE_BOOL(scm_port_char_readyp(port));
+ return MAKE_BOOL(res);
}
/*===========================================================================
Modified: branches/r5rs/sigscheme/operations-nonstd.c
===================================================================
--- branches/r5rs/sigscheme/operations-nonstd.c 2006-01-05 01:47:07 UTC (rev 2795)
+++ branches/r5rs/sigscheme/operations-nonstd.c 2006-01-05 03:34:15 UTC (rev 2796)
@@ -88,6 +88,7 @@
scm_p_symbol_boundp(ScmObj sym, ScmObj rest)
{
ScmObj env;
+ ScmRef ref;
DECLARE_FUNCTION("symbol-bound?", procedure_variadic_1);
ENSURE_SYMBOL(sym);
@@ -97,9 +98,9 @@
ENSURE_ENV(env);
else
env = SCM_INTERACTION_ENV;
+ ref = scm_lookup_environment(sym, env);
- return MAKE_BOOL(scm_lookup_environment(sym, env) != SCM_INVALID_REF
- || SCM_SYMBOL_BOUNDP(sym));
+ return MAKE_BOOL(ref != SCM_INVALID_REF || SCM_SYMBOL_BOUNDP(sym));
}
/* SIOD compatible */
Modified: branches/r5rs/sigscheme/operations-siod.c
===================================================================
--- branches/r5rs/sigscheme/operations-siod.c 2006-01-05 01:47:07 UTC (rev 2795)
+++ branches/r5rs/sigscheme/operations-siod.c 2006-01-05 03:34:15 UTC (rev 2796)
@@ -97,6 +97,7 @@
void
scm_initialize_siod(void)
{
+ ScmCharPort *cport;
REGISTER_FUNC_TABLE(siod_func_info_table);
scm_use("srfi-60");
@@ -110,8 +111,8 @@
scm_gc_protect_with_init(&saved_error_port, SCM_FALSE);
scm_nullport_init();
- null_port = MAKE_PORT(scm_make_char_port(ScmNullPort_new()),
- SCM_PORTFLAG_INPUT | SCM_PORTFLAG_OUTPUT);
+ cport = scm_make_char_port(ScmNullPort_new());
+ null_port = MAKE_PORT(cport, SCM_PORTFLAG_INPUT | SCM_PORTFLAG_OUTPUT);
scm_set_verbose_level(2);
}
@@ -179,16 +180,18 @@
ScmObj
scm_p_closure_code(ScmObj closure)
{
- ScmObj exp, body;
+ ScmObj exp, body, sym_begin;
DECLARE_FUNCTION("%%closure-code", procedure_fixed_1);
ENSURE_CLOSURE(closure);
exp = SCM_CLOSURE_EXP(closure);
- if (NULLP(CDDR(exp)))
+ if (NULLP(CDDR(exp))) {
body = CADR(exp);
- else
- body = CONS(scm_intern("begin"), CDR(exp));
+ } else {
+ sym_begin = scm_intern("begin");
+ body = CONS(sym_begin, CDR(exp));
+ }
return CONS(CAR(exp), body);
}
Modified: branches/r5rs/sigscheme/operations-srfi6.c
===================================================================
--- branches/r5rs/sigscheme/operations-srfi6.c 2006-01-05 01:47:07 UTC (rev 2795)
+++ branches/r5rs/sigscheme/operations-srfi6.c 2006-01-05 03:34:15 UTC (rev 2796)
@@ -83,6 +83,7 @@
{
ScmObj *hold_str;
ScmBytePort *bport;
+ ScmCharPort *cport;
DECLARE_FUNCTION("open-input-string", procedure_fixed_1);
ENSURE_STRING(str);
@@ -90,17 +91,20 @@
bport = ScmInputStrPort_new_const(SCM_STRING_STR(str), istrport_finalize);
hold_str = (ScmObj *)ScmInputStrPort_ref_opaque(bport);
scm_gc_protect_with_init(hold_str, str);
- return MAKE_PORT(scm_make_char_port(bport), SCM_PORTFLAG_INPUT);
+ cport = scm_make_char_port(bport);
+ return MAKE_PORT(cport, SCM_PORTFLAG_INPUT);
}
ScmObj
scm_p_srfi6_open_output_string(void)
{
ScmBytePort *bport;
+ ScmCharPort *cport;
DECLARE_FUNCTION("open-output-string", procedure_fixed_0);
bport = ScmOutputStrPort_new(NULL);
- return MAKE_PORT(scm_make_char_port(bport), SCM_PORTFLAG_OUTPUT);
+ cport = scm_make_char_port(bport);
+ return MAKE_PORT(cport, SCM_PORTFLAG_OUTPUT);
}
ScmObj
Modified: branches/r5rs/sigscheme/operations.c
===================================================================
--- branches/r5rs/sigscheme/operations.c 2006-01-05 01:47:07 UTC (rev 2795)
+++ branches/r5rs/sigscheme/operations.c 2006-01-05 03:34:15 UTC (rev 2796)
@@ -1240,11 +1240,14 @@
ScmObj
scm_p_string_length(ScmObj str)
{
+ int len;
DECLARE_FUNCTION("string-length", procedure_fixed_1);
ENSURE_STRING(str);
- return MAKE_INT(scm_mb_bare_c_strlen(SCM_STRING_STR(str)));
+ len = scm_mb_bare_c_strlen(SCM_STRING_STR(str));
+
+ return MAKE_INT(len);
}
ScmObj
@@ -1717,7 +1720,8 @@
SCM_QUEUE_POINT_TO(q, res);
while (!NO_MORE_ARG(lst)) {
elm = POP_ARG(lst);
- SCM_QUEUE_ADD(q, scm_call(proc, LIST_1(elm)));
+ elm = scm_call(proc, LIST_1(elm));
+ SCM_QUEUE_ADD(q, elm);
}
return res;
@@ -1727,7 +1731,7 @@
map_multiple_args(ScmObj proc, ScmObj args)
{
ScmQueue resq, argq;
- ScmObj res, map_args, rest_args, arg;
+ ScmObj res, elm, map_args, rest_args, arg;
DECLARE_INTERNAL_FUNCTION("map");
res = SCM_NULL;
@@ -1749,7 +1753,8 @@
}
ENSURE_PROPER_LIST_TERMINATION(rest_args, args);
- SCM_QUEUE_ADD(resq, scm_call(proc, map_args));
+ elm = scm_call(proc, map_args);
+ SCM_QUEUE_ADD(resq, elm);
}
}
Modified: branches/r5rs/sigscheme/sigscheme.c
===================================================================
--- branches/r5rs/sigscheme/sigscheme.c 2006-01-05 01:47:07 UTC (rev 2795)
+++ branches/r5rs/sigscheme/sigscheme.c 2006-01-05 03:34:15 UTC (rev 2796)
@@ -313,9 +313,11 @@
{
ScmObj str_port, ret;
ScmBytePort *bport;
+ ScmCharPort *cport;
bport = ScmInputStrPort_new_const(exp, NULL);
- str_port = MAKE_PORT(scm_make_char_port(bport), SCM_PORTFLAG_INPUT);
+ cport = scm_make_char_port(bport);
+ str_port = MAKE_PORT(cport, SCM_PORTFLAG_INPUT);
ret = scm_read(str_port);
ret = EVAL(ret, SCM_INTERACTION_ENV);
Modified: branches/r5rs/sigscheme/syntax.c
===================================================================
--- branches/r5rs/sigscheme/syntax.c 2006-01-05 01:47:07 UTC (rev 2795)
+++ branches/r5rs/sigscheme/syntax.c 2006-01-05 03:34:15 UTC (rev 2796)
@@ -385,7 +385,7 @@
(if <test> <consequent> <alternate>)
========================================================================*/
- if (NFALSEP(EVAL(test, env))) {
+ if (test = EVAL(test, env), NFALSEP(test)) {
#if SCM_STRICT_ARGCHECK
POP_ARG(rest);
ASSERT_NO_MORE_ARG(rest);
@@ -812,7 +812,11 @@
/*===========================================================================
R5RS : 4.2 Derived expression types : 4.2.4 Iteration
===========================================================================*/
-/* FIXME: SEGV conditions by manual arg extraction, and expensive operations */
+/* FIXME:
+ * - SEGV conditions by manual arg extraction
+ * - side-effective arg in macros such as EVAL, NFALSEP
+ * - expensive operations
+ */
ScmObj
scm_s_do(ScmObj bindings, ScmObj testframe, ScmObj commands, ScmEvalState *eval_state)
{
@@ -848,7 +852,8 @@
val = MUST_POP_ARG(binding);
vars = CONS(var, vars);
- vals = CONS(EVAL(val, env), vals);
+ val = EVAL(val, env);
+ vals = CONS(val, vals);
/* append <step> to steps */
if (NO_MORE_ARG(binding))
@@ -970,6 +975,7 @@
} else if (EQ(obj, SYM_UNQUOTE)) {
/* FORM == ,x */
if (--nest == 0) {
+ /* FIXME: side-effective EVAL in another macro */
TRL_SET_SUBLS(tr, EVAL(CADR(form), env));
my_result.obj = TRL_EXTRACT(tr);
my_result.insn = TR_MSG_REPLACE;
@@ -1061,9 +1067,12 @@
static void
define_internal(ScmObj var, ScmObj exp, ScmObj env)
{
+ ScmObj val;
+
if (NULLP(env)) {
/* given top-level environment */
- SCM_SYMBOL_SET_VCELL(var, EVAL(exp, env));
+ val = EVAL(exp, env);
+ SCM_SYMBOL_SET_VCELL(var, val);
} else {
/* add val to the environment */
env = scm_add_environment(var, EVAL(exp, env), env);
More information about the uim-commit
mailing list