[uim-commit] r1425 - branches/r5rs/sigscheme
yamaken at freedesktop.org
yamaken at freedesktop.org
Mon Sep 5 04:29:04 PDT 2005
Author: yamaken
Date: 2005-09-05 04:28:59 -0700 (Mon, 05 Sep 2005)
New Revision: 1425
Modified:
branches/r5rs/sigscheme/eval.c
branches/r5rs/sigscheme/sigschemeinternal.h
Log:
* sigscheme/sigschemeinternal.h
- (SCM_SHIFT_RAW, SCM_SHIFT_RAW_1, SCM_SHIFT_RAW_2, SCM_SHIFT_RAW_3,
SCM_SHIFT_RAW_4, SCM_SHIFT_RAW_5, SCM_SHIFT_EVALED,
SCM_SHIFT_EVALED_1, SCM_SHIFT_EVALED_2, SCM_SHIFT_EVALED_3,
SCM_SHIFT_EVALED_4, SCM_SHIFT_EVALED_5): New macro
* sigscheme/eval.c
- (SCM_ERRMSG_WRONG_NR_ARG): New macro
- (ScmOp_eval):
* Simplify and optimize with SCM_SHIFT_EVALED_*() macros
* Add the precondition check for number of arguments. This has
fixed the SEGV caused by wrong arguments. Now (= 1), (set!) etc
causes an error properly
- (ScmOp_apply):
* Simplify and optimize with SCM_SHIFT_RAW_*() macros
* Add the precondition check for number of arguments. This has
fixed the SEGV caused by wrong arguments. Now (apply integer?
()), (apply integer? '(3 4)) etc causes an error properly
Modified: branches/r5rs/sigscheme/eval.c
===================================================================
--- branches/r5rs/sigscheme/eval.c 2005-09-05 06:12:12 UTC (rev 1424)
+++ branches/r5rs/sigscheme/eval.c 2005-09-05 11:28:59 UTC (rev 1425)
@@ -68,6 +68,8 @@
#define QQUOTE_SET_VERBATIM(x) ((x) = SCM_INVALID)
#define QQUOTE_IS_VERBATIM(x) (EQ((x), SCM_INVALID))
+#define SCM_ERRMSG_WRONG_NR_ARG " Wrong number of arguments "
+
/*=======================================
Variable Declarations
=======================================*/
@@ -223,9 +225,12 @@
===========================================================================*/
ScmObj ScmOp_eval(ScmObj obj, ScmObj env)
{
- ScmObj tmp = SCM_NULL;
- ScmObj arg = SCM_NULL;
- ScmObj ret = SCM_NULL;
+ ScmObj tmp = SCM_NULL;
+ ScmObj arg = SCM_NULL;
+ ScmObj arg0, arg1, arg2, arg3, arg4;
+ ScmObj rest = SCM_NULL;
+ ScmObj args = SCM_NULL;
+ ScmObj ret = SCM_NULL;
int tail_flag = 0;
/* for debugging */
@@ -332,48 +337,40 @@
goto eval_done;
case FUNCTYPE_1:
- ret = SCM_FUNC_EXEC_SUBR1(tmp, ScmOp_eval(CAR(CDR(obj)),env));
+ args = rest = CDR(obj);
+ if (!NULLP(SCM_SHIFT_EVALED_1(arg0, rest, env)))
+ SigScm_ErrorObj("func1 :" SCM_ERRMSG_WRONG_NR_ARG, args);
+ ret = SCM_FUNC_EXEC_SUBR1(tmp, arg0);
goto eval_done;
case FUNCTYPE_2:
- obj = CDR(obj);
- arg = ScmOp_eval(CAR(obj), env); /* 1st arg */
- ret = SCM_FUNC_EXEC_SUBR2(tmp,
- arg,
- ScmOp_eval(CAR(CDR(obj)), env)); /* 2nd arg */
+ args = rest = CDR(obj);
+ if (!NULLP(SCM_SHIFT_EVALED_2(arg0, arg1, rest, env)))
+ SigScm_ErrorObj("func2 :" SCM_ERRMSG_WRONG_NR_ARG, args);
+ ret = SCM_FUNC_EXEC_SUBR2(tmp, arg0, arg1);
goto eval_done;
case FUNCTYPE_3:
- obj = CDR(obj);
- arg = ScmOp_eval(CAR(obj), env); /* 1st arg */
- obj = CDR(obj);
- ret = SCM_FUNC_EXEC_SUBR3(tmp,
- arg,
- ScmOp_eval(CAR(obj), env), /* 2nd arg */
- ScmOp_eval(CAR(CDR(obj)), env)); /* 3rd arg */
+ args = rest = CDR(obj);
+ if (!NULLP(SCM_SHIFT_EVALED_3(arg0, arg1, arg2, rest, env)))
+ SigScm_ErrorObj("func3 :" SCM_ERRMSG_WRONG_NR_ARG, args);
+ ret = SCM_FUNC_EXEC_SUBR3(tmp, arg0, arg1, arg2);
goto eval_done;
case FUNCTYPE_4:
- obj = CDR(obj);
- arg = ScmOp_eval(CAR(obj), env); /* 1st arg */
- obj = CDR(obj);
- ret = SCM_FUNC_EXEC_SUBR4(tmp,
- arg,
- ScmOp_eval(CAR(obj), env), /* 2nd arg */
- ScmOp_eval(CAR(CDR(obj)), env), /* 3rd arg */
- ScmOp_eval(CAR(CDR(CDR(obj))), env)); /* 4th arg */
+ args = rest = CDR(obj);
+ if (!NULLP(SCM_SHIFT_EVALED_4(arg0, arg1, arg2, arg3,
+ rest, env)))
+ SigScm_ErrorObj("func4 :" SCM_ERRMSG_WRONG_NR_ARG, args);
+ ret = SCM_FUNC_EXEC_SUBR4(tmp, arg0, arg1, arg2, arg3);
goto eval_done;
case FUNCTYPE_5:
- obj = CDR(obj);
- arg = ScmOp_eval(CAR(obj), env); /* 1st arg */
- obj = CDR(obj);
- ret = SCM_FUNC_EXEC_SUBR5(tmp,
- arg,
- ScmOp_eval(CAR(obj), env), /* 2nd arg */
- ScmOp_eval(CAR(CDR(obj)), env), /* 3rd arg */
- ScmOp_eval(CAR(CDR(CDR(obj))), env), /* 4th arg */
- ScmOp_eval(CAR(CDR(CDR(CDR(obj)))), env)); /* 5th arg */
+ args = rest = CDR(obj);
+ if (!NULLP(SCM_SHIFT_EVALED_5(arg0, arg1, arg2, arg3, arg4,
+ rest, env)))
+ SigScm_ErrorObj("func5 :" SCM_ERRMSG_WRONG_NR_ARG, args);
+ ret = SCM_FUNC_EXEC_SUBR5(tmp, arg0, arg1, arg2, arg3, arg4);
goto eval_done;
default:
@@ -469,6 +466,8 @@
{
ScmObj proc = SCM_NULL;
ScmObj obj = SCM_NULL;
+ ScmObj rest = SCM_NULL;
+ ScmObj arg0, arg1, arg2, arg3, arg4;
int tail_flag = 0;
/* sanity check */
@@ -502,34 +501,34 @@
return SCM_FUNC_EXEC_SUBR0(proc);
case FUNCTYPE_1:
- return SCM_FUNC_EXEC_SUBR1(proc,
- CAR(obj));
+ rest = obj;
+ if (!NULLP(SCM_SHIFT_RAW_1(arg0, rest)))
+ SigScm_ErrorObj("apply func1 :" SCM_ERRMSG_WRONG_NR_ARG, obj);
+ return SCM_FUNC_EXEC_SUBR1(proc, arg0);
case FUNCTYPE_2:
- return SCM_FUNC_EXEC_SUBR2(proc,
- CAR(obj),
- CAR(CDR(obj)));
+ rest = obj;
+ if (!NULLP(SCM_SHIFT_RAW_2(arg0, arg1, rest)))
+ SigScm_ErrorObj("apply func2 :" SCM_ERRMSG_WRONG_NR_ARG, obj);
+ return SCM_FUNC_EXEC_SUBR2(proc, arg0, arg1);
case FUNCTYPE_3:
- return SCM_FUNC_EXEC_SUBR3(proc,
- CAR(obj),
- CAR(CDR(obj)),
- CAR(CDR(CDR(obj))));
+ rest = obj;
+ if (!NULLP(SCM_SHIFT_RAW_3(arg0, arg1, arg2, rest)))
+ SigScm_ErrorObj("apply func3 :" SCM_ERRMSG_WRONG_NR_ARG, obj);
+ return SCM_FUNC_EXEC_SUBR3(proc, arg0, arg1, arg2);
case FUNCTYPE_4:
- return SCM_FUNC_EXEC_SUBR4(proc,
- CAR(obj),
- CAR(CDR(obj)),
- CAR(CDR(CDR(obj))),
- CAR(CDR(CDR(CDR(obj)))));
+ rest = obj;
+ if (!NULLP(SCM_SHIFT_RAW_4(arg0, arg1, arg2, arg3, rest)))
+ SigScm_ErrorObj("apply func4 :" SCM_ERRMSG_WRONG_NR_ARG, obj);
+ return SCM_FUNC_EXEC_SUBR4(proc, arg0, arg1, arg2, arg3);
case FUNCTYPE_5:
- return SCM_FUNC_EXEC_SUBR5(proc,
- CAR(obj),
- CAR(CDR(obj)),
- CAR(CDR(CDR(obj))),
- CAR(CDR(CDR(CDR(obj)))),
- CAR(CDR(CDR(CDR(CDR(obj))))));
+ rest = obj;
+ if (!NULLP(SCM_SHIFT_RAW_5(arg0, arg1, arg2, arg3, arg4, rest)))
+ SigScm_ErrorObj("apply func5 :" SCM_ERRMSG_WRONG_NR_ARG, obj);
+ return SCM_FUNC_EXEC_SUBR5(proc, arg0, arg1, arg2, arg3, arg4);
case FUNCTYPE_RAW_LIST:
return SCM_FUNC_EXEC_SUBRL(proc,
Modified: branches/r5rs/sigscheme/sigschemeinternal.h
===================================================================
--- branches/r5rs/sigscheme/sigschemeinternal.h 2005-09-05 06:12:12 UTC (rev 1424)
+++ branches/r5rs/sigscheme/sigschemeinternal.h 2005-09-05 11:28:59 UTC (rev 1425)
@@ -158,6 +158,77 @@
#define CHECK_5_ARGS(arg) (CHECK_4_ARGS(arg) || NULLP(CDDR(CDDR(arg))))
/*
+ * Macros For List Element Extraction With Safety Check
+ *
+ * SCM_SHIFT_*() safely and efficiently extracts elements of a list into
+ * arbitrary storages (Suppose 'shift' function of scripting languages).
+ *
+ * The macro overwrites the argument variable 'lst' as list iterator, and
+ * returns rest list after requested number of elements have been
+ * extracted. Caller can test whether the list has been empty or not by
+ * applying NULLP to the result. If a shotage of the list has been occurred
+ * before extracting all elements, the iteration stops with false value, and
+ * the lst becomes to empty list. The macro itself does not have any error
+ * handlings. Caller must do it appropriately by referencing the result value.
+ */
+#define SCM_SHIFT_RAW(elm, lst) \
+ ((!NULLP(lst)) && ((elm) = CAR(lst), (lst) = CDR(lst), (lst)))
+
+#define SCM_SHIFT_RAW_1(elm0, lst) \
+ (SCM_SHIFT_RAW(elm0, lst) ? (lst) : 0)
+
+#define SCM_SHIFT_RAW_2(elm0, elm1, lst) \
+ ((SCM_SHIFT_RAW(elm0, lst) \
+ && SCM_SHIFT_RAW(elm1, lst)) ? (lst) : 0)
+
+#define SCM_SHIFT_RAW_3(elm0, elm1, elm2, lst) \
+ ((SCM_SHIFT_RAW(elm0, lst) \
+ && SCM_SHIFT_RAW(elm1, lst) \
+ && SCM_SHIFT_RAW(elm2, lst)) ? (lst) : 0)
+
+#define SCM_SHIFT_RAW_4(elm0, elm1, elm2, elm3, lst) \
+ ((SCM_SHIFT_RAW(elm0, lst) \
+ && SCM_SHIFT_RAW(elm1, lst) \
+ && SCM_SHIFT_RAW(elm2, lst) \
+ && SCM_SHIFT_RAW(elm3, lst)) ? (lst) : 0)
+
+#define SCM_SHIFT_RAW_5(elm0, elm1, elm2, elm3, elm4, lst) \
+ ((SCM_SHIFT_RAW(elm0, lst) \
+ && SCM_SHIFT_RAW(elm1, lst) \
+ && SCM_SHIFT_RAW(elm2, lst) \
+ && SCM_SHIFT_RAW(elm3, lst) \
+ && SCM_SHIFT_RAW(elm4, lst)) ? (lst) : 0)
+
+#define SCM_SHIFT_EVALED(elm, lst, env) \
+ ((!NULLP(lst)) \
+ && ((elm) = ScmOp_eval(CAR(lst), env), (lst) = CDR(lst), (lst)))
+
+#define SCM_SHIFT_EVALED_1(elm0, lst, env) \
+ (SCM_SHIFT_EVALED(elm0, lst, env) ? (lst) : 0)
+
+#define SCM_SHIFT_EVALED_2(elm0, elm1, lst, env) \
+ ((SCM_SHIFT_EVALED(elm0, lst, env) \
+ && SCM_SHIFT_EVALED(elm1, lst, env)) ? (lst) : 0)
+
+#define SCM_SHIFT_EVALED_3(elm0, elm1, elm2, lst, env) \
+ ((SCM_SHIFT_EVALED(elm0, lst, env) \
+ && SCM_SHIFT_EVALED(elm1, lst, env) \
+ && SCM_SHIFT_EVALED(elm2, lst, env)) ? (lst) : 0)
+
+#define SCM_SHIFT_EVALED_4(elm0, elm1, elm2, elm3, lst, env) \
+ ((SCM_SHIFT_EVALED(elm0, lst, env) \
+ && SCM_SHIFT_EVALED(elm1, lst, env) \
+ && SCM_SHIFT_EVALED(elm2, lst, env) \
+ && SCM_SHIFT_EVALED(elm3, lst, env)) ? (lst) : 0)
+
+#define SCM_SHIFT_EVALED_5(elm0, elm1, elm2, elm3, elm4, lst, env) \
+ ((SCM_SHIFT_EVALED(elm0, lst, env) \
+ && SCM_SHIFT_EVALED(elm1, lst, env) \
+ && SCM_SHIFT_EVALED(elm2, lst, env) \
+ && SCM_SHIFT_EVALED(elm3, lst, env) \
+ && SCM_SHIFT_EVALED(elm4, lst, env)) ? (lst) : 0)
+
+/*
* TODO: Simplify implementation of following functions with SCM_REDUCE and
* SCM_REDUCE_EXT. Anyone?
*
More information about the uim-commit
mailing list