[uim-commit] r1805 - branches/r5rs/sigscheme
kzk at freedesktop.org
kzk at freedesktop.org
Tue Oct 4 10:21:53 PDT 2005
Author: kzk
Date: 2005-10-04 10:21:51 -0700 (Tue, 04 Oct 2005)
New Revision: 1805
Modified:
branches/r5rs/sigscheme/operations-siod.c
branches/r5rs/sigscheme/operations-srfi1.c
branches/r5rs/sigscheme/operations-srfi2.c
branches/r5rs/sigscheme/operations-srfi23.c
branches/r5rs/sigscheme/operations-srfi34.c
branches/r5rs/sigscheme/operations-srfi38.c
branches/r5rs/sigscheme/operations-srfi60.c
branches/r5rs/sigscheme/operations-srfi8.c
branches/r5rs/sigscheme/operations.c
branches/r5rs/sigscheme/read.c
Log:
* sigscheme/read.c
* sigscheme/operations.c
* sigscheme/operations-srfi34.c
* sigscheme/operations-srfi38.c
* sigscheme/operations-srfi1.c
* sigscheme/operations-srfi2.c
* sigscheme/operations-srfi8.c
* sigscheme/operations-siod.c
* sigscheme/operations-srfi23.c
* sigscheme/operations-srfi60.c
- insert DECLARE_FUNCTION macro to each function
- use ASSERT_*P macro
- use Scm_ErrorObj or ERR_OBJ instead of SigScm_ErrorObj
Modified: branches/r5rs/sigscheme/operations-siod.c
===================================================================
--- branches/r5rs/sigscheme/operations-siod.c 2005-10-04 15:54:35 UTC (rev 1804)
+++ branches/r5rs/sigscheme/operations-siod.c 2005-10-04 17:21:51 UTC (rev 1805)
@@ -117,9 +117,10 @@
*/
ScmObj ScmOp_symbol_value(ScmObj var)
{
- if (!SYMBOLP(var))
- SigScm_ErrorObj("symbol-value : symbol required but got ", var);
+ DECLARE_FUNCTION("symbol-value", ProcedureFixed1);
+ ASSERT_SYMBOLP(var);
+
return Scm_SymbolValue(var, SCM_NULL);
}
@@ -132,15 +133,17 @@
*/
ScmObj ScmOp_set_symbol_value(ScmObj var, ScmObj val)
{
- /* sanity check */
- if (!SYMBOLP(var))
- SigScm_ErrorObj("set-symbol-value! : symbol required but got ", var);
+ DECLARE_FUNCTION("set-symbol-value!", ProcedureFixed2);
+ ASSERT_SYMBOLP(var);
+
return SCM_SYMBOL_SET_VCELL(var, val);
}
ScmObj ScmOp_siod_eql(ScmObj obj1, ScmObj obj2)
{
+ DECLARE_FUNCTION("=", ProcedureFixed2);
+
if (EQ(obj1, obj2))
return SCM_TRUE;
else if (!INTP(obj1) || !INTP(obj2))
@@ -153,6 +156,8 @@
ScmObj ScmOp_the_environment(ScmEvalState *eval_state)
{
+ DECLARE_FUNCTION("the-environment", ProcedureFixedTailRec0);
+
eval_state->ret_type = SCM_RETTYPE_AS_IS;
return eval_state->env;
@@ -161,12 +166,11 @@
ScmObj ScmOp_closure_code(ScmObj closure)
{
ScmObj exp, body;
+ DECLARE_FUNCTION("%%closure-code", ProcedureFixed1);
- if (!CLOSUREP(closure))
- SigScm_ErrorObj("%%closure-code : closure required but got ", closure);
+ ASSERT_CLOSUREP(closure);
exp = SCM_CLOSURE_EXP(closure);
-
if (NULLP(CDDR(exp)))
body = CADR(exp);
else
@@ -177,9 +181,10 @@
ScmObj ScmOp_verbose(ScmObj args)
{
+ DECLARE_FUNCTION("verbose", ProcedureFixed1);
+
if (!NULLP(args)) {
- if (!INTP(CAR(args)))
- SigScm_ErrorObj("verbose : integer required but got ", args);
+ ASSERT_INTP(CAR(args));
SigScm_SetVerboseLevel(SCM_INT_VALUE(CAR(args)));
}
Modified: branches/r5rs/sigscheme/operations-srfi1.c
===================================================================
--- branches/r5rs/sigscheme/operations-srfi1.c 2005-10-04 15:54:35 UTC (rev 1804)
+++ branches/r5rs/sigscheme/operations-srfi1.c 2005-10-04 17:21:51 UTC (rev 1805)
@@ -107,13 +107,15 @@
==============================================================================*/
ScmObj ScmOp_SRFI1_xcons(ScmObj a, ScmObj b)
{
+ DECLARE_FUNCTION("xcons", ProcedureFixed2);
return CONS(b, a);
}
ScmObj ScmOp_SRFI1_cons_star(ScmObj args)
{
- ScmObj tail_cons = SCM_NULL;
+ ScmObj tail_cons = SCM_FALSE;
ScmObj prev_last = args;
+ DECLARE_FUNCTION("cons*", ProcedureVariadic0);
if (NULLP(CDR(args)))
return CAR(args);
@@ -136,10 +138,9 @@
ScmObj head = SCM_FALSE;
int len = 0;
int i = 0;
+ DECLARE_FUNCTION("make-list", ProcedureVariadic1);
- /* sanity check */
- if (FALSEP(ScmOp_numberp(length)))
- SigScm_ErrorObj("make-list : number required but got ", CAR(length));
+ ASSERT_INTP(length);
len = SCM_INT_VALUE(length);
@@ -164,10 +165,9 @@
ScmObj num = SCM_FALSE;
int n = 0;
int i = 0;
+ DECLARE_FUNCTION("list-tabulate", ProcedureVariadic1);
- /* sanity check */
- if (FALSEP(ScmOp_numberp(scm_n)))
- SigScm_ErrorObj("list-tabulate : number required but got ", scm_n);
+ ASSERT_INTP(scm_n);
/* get n */
n = SCM_INT_VALUE(scm_n);
@@ -191,12 +191,13 @@
ScmObj ScmOp_SRFI1_list_copy(ScmObj lst)
{
- ScmObj head = SCM_NULL;
- ScmObj tail = SCM_NULL;
- ScmObj obj = SCM_NULL;
+ ScmObj head = SCM_FALSE;
+ ScmObj tail = SCM_FALSE;
+ ScmObj obj = SCM_FALSE;
+ DECLARE_FUNCTION("list-copy", ProcedureFixed1);
if (FALSEP(ScmOp_listp(lst)))
- SigScm_ErrorObj("list-copy : list required but got ", lst);
+ ERR_OBJ("list required but got ", lst);
for (; !NULLP(lst); lst = CDR(lst)) {
obj = CAR(lst);
@@ -207,7 +208,7 @@
/* then create new cons */
obj = CONS(obj, SCM_NULL);
- if (!NULLP(tail)) {
+ if (!FALSEP(tail)) {
SET_CDR(tail, obj);
tail = obj;
} else {
@@ -221,26 +222,25 @@
ScmObj ScmOp_SRFI1_circular_list(ScmObj args)
{
- ScmObj lastcons = SCM_NULL;
+ DECLARE_FUNCTION("circular-list", ProcedureVariadic0);
if (FALSEP(ScmOp_listp(args)))
- SigScm_ErrorObj("circular-list : list required but got ", args);
+ ERR_OBJ("list required but got ", args);
- lastcons = ScmOp_SRFI1_last_pair(args);
- SET_CDR(lastcons, args);
-
+ SET_CDR(ScmOp_SRFI1_last_pair(args), args);
return args;
}
ScmObj ScmOp_SRFI1_iota(ScmObj scm_count, ScmObj args)
{
- ScmObj scm_start = SCM_NULL;
- ScmObj scm_step = SCM_NULL;
+ ScmObj scm_start = SCM_FALSE;
+ ScmObj scm_step = SCM_FALSE;
ScmObj head = SCM_NULL;
int count = 0;
int start = 0;
int step = 0;
int i = 0;
+ DECLARE_FUNCTION("iota", ProcedureVariadic1);
/* get params */
if (!NULLP(args))
@@ -250,15 +250,12 @@
scm_step = CAR(CDR(args));
/* param type check */
- if (FALSEP(ScmOp_numberp(scm_count)))
- SigScm_ErrorObj("iota : number required but got ", scm_count);
+ ASSERT_INTP(scm_count);
+ if (!NULLP(scm_start))
+ ASSERT_INTP(scm_start);
+ if (!NULLP(scm_step))
+ ASSERT_INTP(scm_step);
- if (!NULLP(scm_start) && FALSEP(ScmOp_numberp(scm_start)))
- SigScm_ErrorObj("iota : number required but got ", scm_start);
-
- if (!NULLP(scm_step) && FALSEP(ScmOp_numberp(scm_step)))
- SigScm_ErrorObj("iota : number required but got ", scm_step);
-
/* now create list */
count = SCM_INT_VALUE(scm_count);
start = NULLP(scm_start) ? 0 : SCM_INT_VALUE(scm_start);
@@ -275,6 +272,7 @@
==============================================================================*/
ScmObj ScmOp_SRFI1_proper_listp(ScmObj lst)
{
+ DECLARE_FUNCTION("proper-list?", ProcedureFixed1);
return ScmOp_listp(lst);
}
@@ -282,6 +280,7 @@
{
ScmObj slow = obj;
int len = 0;
+ DECLARE_FUNCTION("circular-list?", ProcedureFixed1);
for (;;) {
if (NULLP(obj)) break;
@@ -306,6 +305,7 @@
{
ScmObj slow = obj;
int len = 0;
+ DECLARE_FUNCTION("dotted-list?", ProcedureFixed1);
for (;;) {
if (NULLP(obj)) break;
@@ -328,11 +328,13 @@
ScmObj ScmOp_SRFI1_not_pairp(ScmObj pair)
{
+ DECLARE_FUNCTION("not-pari?", ProcedureFixed1);
return CONSP(pair) ? SCM_FALSE : SCM_TRUE;
}
ScmObj ScmOp_SRFI1_null_listp(ScmObj lst)
{
+ DECLARE_FUNCTION("null-list?", ProcedureFixed1);
/* TODO : check circular list */
return NULLP(lst) ? SCM_TRUE : SCM_FALSE;
}
@@ -340,6 +342,7 @@
ScmObj ScmOp_SRFI1_listequal(ScmObj eqproc, ScmObj args)
{
ScmObj first_lst = SCM_FALSE;
+ DECLARE_FUNCTION("list=", ProcedureVariadic1);
if (NULLP(args))
return SCM_TRUE;
@@ -386,76 +389,85 @@
ScmObj ScmOp_SRFI1_first(ScmObj lst)
{
+ DECLARE_FUNCTION("first", ProcedureFixed1);
return ScmOp_car(lst);
}
ScmObj ScmOp_SRFI1_second(ScmObj lst)
{
+ DECLARE_FUNCTION("second", ProcedureFixed1);
return ScmOp_cadr(lst);
}
ScmObj ScmOp_SRFI1_third(ScmObj lst)
{
+ DECLARE_FUNCTION("third", ProcedureFixed1);
return ScmOp_caddr(lst);
}
ScmObj ScmOp_SRFI1_fourth(ScmObj lst)
{
+ DECLARE_FUNCTION("fourth", ProcedureFixed1);
return ScmOp_cadddr(lst);
}
ScmObj ScmOp_SRFI1_fifth(ScmObj lst)
{
+ DECLARE_FUNCTION("fifth", ProcedureFixed1);
return ScmOp_car(ScmOp_cddddr(lst));
}
ScmObj ScmOp_SRFI1_sixth(ScmObj lst)
{
+ DECLARE_FUNCTION("sixth", ProcedureFixed1);
return ScmOp_cadr(ScmOp_cddddr(lst));
}
ScmObj ScmOp_SRFI1_seventh(ScmObj lst)
{
+ DECLARE_FUNCTION("seventh", ProcedureFixed1);
return ScmOp_caddr(ScmOp_cddddr(lst));
}
ScmObj ScmOp_SRFI1_eighth(ScmObj lst)
{
+ DECLARE_FUNCTION("eighth", ProcedureFixed1);
return ScmOp_cadddr(ScmOp_cddddr(lst));
}
ScmObj ScmOp_SRFI1_ninth(ScmObj lst)
{
+ DECLARE_FUNCTION("ninth", ProcedureFixed1);
return ScmOp_car(ScmOp_cddddr(ScmOp_cddddr(lst)));
}
ScmObj ScmOp_SRFI1_tenth(ScmObj lst)
{
+ DECLARE_FUNCTION("tenth", ProcedureFixed1);
return ScmOp_cadr(ScmOp_cddddr(ScmOp_cddddr(lst)));
}
ScmObj ScmOp_SRFI1_carpluscdr(ScmObj lst)
{
+ DECLARE_FUNCTION("car+cdr", ProcedureFixed1);
return ScmOp_values(LIST_2(CAR(lst), CDR(lst)));
}
ScmObj ScmOp_SRFI1_take(ScmObj lst, ScmObj scm_idx)
{
- ScmObj tmp = lst;
- ScmObj ret = SCM_NULL;
- ScmObj ret_tail = SCM_NULL;
+ ScmObj tmp = lst;
+ ScmObj ret = SCM_FALSE;
+ ScmObj ret_tail = SCM_FALSE;
int idx = 0;
int i;
+ DECLARE_FUNCTION("take", ProcedureFixed2);
- /* sanity check */
- if (!INTP(scm_idx))
- SigScm_ErrorObj("drop-right : number required but got ", scm_idx);
+ ASSERT_INTP(scm_idx);
idx = SCM_INT_VALUE(scm_idx);
-
for (i = 0; i < idx; i++) {
if (SCM_NULLP(tmp))
- SigScm_ErrorObj("take : illegal index is specified for ", lst);
+ ERR_OBJ("illegal index is specified for ", lst);
if (i != 0) {
SET_CDR(ret_tail, CONS(CAR(tmp), SCM_NULL));
@@ -474,16 +486,16 @@
ScmObj ScmOp_SRFI1_drop(ScmObj lst, ScmObj scm_idx)
{
ScmObj ret = lst;
- int idx = SCM_INT_VALUE(scm_idx);
+ int idx = 0;
int i;
+ DECLARE_FUNCTION("drop", ProcedureFixed2);
- /* sanity check */
- if (!INTP(scm_idx))
- SigScm_ErrorObj("drop-right : number required but got ", scm_idx);
+ ASSERT_INTP(scm_idx);
+ idx = SCM_INT_VALUE(scm_idx);
for (i = 0; i < idx; i++) {
if (!CONSP(ret))
- SigScm_ErrorObj("drop : illegal index is specified for ", lst);
+ ERR_OBJ("illegal index is specified for ", lst);
ret = CDR(ret);
}
@@ -495,10 +507,9 @@
{
ScmObj tmp = lst;
int len = 0;
+ DECLARE_FUNCTION("take-right", ProcedureFixed2);
- /* sanity check */
- if (!INTP(scm_elem))
- SigScm_ErrorObj("drop-right : number required but got ", scm_elem);
+ ASSERT_INTP(scm_elem);
for (; CONSP(tmp); tmp = CDR(tmp))
len++;
@@ -512,10 +523,9 @@
{
ScmObj tmp = lst;
int len = 0;
+ DECLARE_FUNCTION("drop-right", ProcedureFixed2);
- /* sanity check */
- if (!INTP(scm_elem))
- SigScm_ErrorObj("drop-right : number required but got ", scm_elem);
+ ASSERT_INTP(scm_elem);
for (; CONSP(tmp); tmp = CDR(tmp))
len++;
@@ -530,10 +540,9 @@
ScmObj tmp = lst;
int idx = 0;
int i;
+ DECLARE_FUNCTION("take!", ProcedureFixed2);
- /* sanity check */
- if (!INTP(scm_idx))
- SigScm_ErrorObj("take! : number required but got ", scm_idx);
+ ASSERT_INTP(scm_idx);
idx = SCM_INT_VALUE(scm_idx);
@@ -551,10 +560,9 @@
ScmObj tmp = lst;
int len = 0;
int i;
+ DECLARE_FUNCTION("drop-right!", ProcedureFixed2);
- /* sanity check */
- if (!INTP(scm_idx))
- SigScm_ErrorObj("drop-right! : number required but got ", scm_idx);
+ ASSERT_INTP(scm_idx);
for (; CONSP(tmp); tmp = CDR(tmp))
len++;
@@ -573,6 +581,8 @@
ScmObj ScmOp_SRFI1_split_at(ScmObj lst, ScmObj idx)
{
+ DECLARE_FUNCTION("split-at", ProcedureFixed2);
+
return ScmOp_values(LIST_2(ScmOp_SRFI1_take(lst, idx),
ScmOp_SRFI1_drop(lst, idx)));
}
@@ -580,6 +590,7 @@
ScmObj ScmOp_SRFI1_split_at_d(ScmObj lst, ScmObj idx)
{
ScmObj drop = ScmOp_SRFI1_drop(lst, idx);
+ DECLARE_FUNCTION("split-at!", ProcedureFixed2);
return ScmOp_values(LIST_2(ScmOp_SRFI1_take_d(lst, idx),
drop));
@@ -587,18 +598,22 @@
ScmObj ScmOp_SRFI1_last(ScmObj lst)
{
+ DECLARE_FUNCTION("last", ProcedureFixed1);
+
/* sanity check */
if (NULLP(lst))
- SigScm_ErrorObj("last : non-empty, proper list is required but got ", lst);
+ ERR_OBJ("non-empty, proper list is required but got ", lst);
return CAR(ScmOp_SRFI1_last_pair(lst));
}
ScmObj ScmOp_SRFI1_last_pair(ScmObj lst)
{
+ DECLARE_FUNCTION("last-pair", ProcedureFixed1);
+
/* sanity check */
if (NULLP(lst))
- SigScm_ErrorObj("last-pair : non-empty, proper list is required but got ", lst);
+ ERR_OBJ("non-empty, proper list is required but got ", lst);
for (; CONSP(CDR(lst)); lst = CDR(lst))
;
@@ -611,6 +626,8 @@
==============================================================================*/
ScmObj ScmOp_SRFI1_lengthplus(ScmObj lst)
{
+ DECLARE_FUNCTION("length+", ProcedureFixed0);
+
/* FIXME!: remove expensive circular_listp */
if (NFALSEP(ScmOp_SRFI1_circular_listp(lst)))
return SCM_FALSE;
@@ -621,10 +638,11 @@
ScmObj ScmOp_SRFI1_concatenate(ScmObj args)
{
ScmObj lsts_of_lst = CAR(args);
+ DECLARE_FUNCTION("concatenate", ProcedureFixed0);
#if SCM_STRICT_ARGCHECK
if (!NULLP(CDR(args)))
- SigScm_ErrorObj("concatenate : superfluous arguments: ", args);
+ ERR_OBJ("superfluous arguments: ", args);
#endif
return ScmOp_append(lsts_of_lst);
Modified: branches/r5rs/sigscheme/operations-srfi2.c
===================================================================
--- branches/r5rs/sigscheme/operations-srfi2.c 2005-10-04 15:54:35 UTC (rev 1804)
+++ branches/r5rs/sigscheme/operations-srfi2.c 2005-10-04 17:21:51 UTC (rev 1805)
@@ -76,6 +76,7 @@
ScmObj var = SCM_FALSE;
ScmObj val = SCM_FALSE;
ScmObj exp = SCM_FALSE;
+ DECLARE_FUNCTION("and-let*", SyntaxVariadicTailRec1);
/*========================================================================
(and-let* <claws> <body>)
@@ -121,7 +122,7 @@
return ScmExp_begin(body, eval_state);
err:
- SigScm_ErrorObj("and-let* : invalid claws form : ", claws);
+ ERR_OBJ("invalid claws form : ", claws);
/* NOTREACHED */
return SCM_FALSE;
}
Modified: branches/r5rs/sigscheme/operations-srfi23.c
===================================================================
--- branches/r5rs/sigscheme/operations-srfi23.c 2005-10-04 15:54:35 UTC (rev 1804)
+++ branches/r5rs/sigscheme/operations-srfi23.c 2005-10-04 17:21:51 UTC (rev 1805)
@@ -75,10 +75,9 @@
ScmObj ScmOp_SRFI23_error(ScmObj reason, ScmObj args)
{
ScmObj arg = SCM_FALSE;
+ DECLARE_FUNCTION("error", ProcedureVariadic1);
- if (!STRINGP(reason))
- SigScm_ErrorObj("error : first argument should be string but got ",
- reason);
+ ASSERT_STRINGP(reason);
if (SigScm_DebugCategories() & SCM_DBG_ERRMSG) {
SigScm_ShowErrorHeader();
Modified: branches/r5rs/sigscheme/operations-srfi34.c
===================================================================
--- branches/r5rs/sigscheme/operations-srfi34.c 2005-10-04 15:54:35 UTC (rev 1804)
+++ branches/r5rs/sigscheme/operations-srfi34.c 2005-10-04 17:21:51 UTC (rev 1805)
@@ -174,7 +174,7 @@
for (; !NULLP(clauses); clauses = CDR(clauses)) {
clause = CAR(clauses);
if (!CONSP(clause))
- SigScm_ErrorObj("guard : bad clause: ", clause);
+ Scm_ErrorObj("guard", "bad clause ", clause);
test = CAR(clause);
exps = CDR(clause);
@@ -200,7 +200,7 @@
if (EQ(Scm_Intern("=>"), CAR(exps))) {
proc = EVAL(CADR(exps), env);
if (FALSEP(ScmOp_procedurep(proc)))
- SigScm_ErrorObj("guard : the value of exp after => must be the procedure but got ", proc);
+ Scm_ErrorObj("guard", "the value of exp after => must be the procedure but got ", proc);
return Scm_call(proc, LIST_1(test));
}
Modified: branches/r5rs/sigscheme/operations-srfi38.c
===================================================================
--- branches/r5rs/sigscheme/operations-srfi38.c 2005-10-04 15:54:35 UTC (rev 1804)
+++ branches/r5rs/sigscheme/operations-srfi38.c 2005-10-04 17:21:51 UTC (rev 1805)
@@ -73,6 +73,7 @@
ScmObj ScmOp_SRFI38_write_with_shared_structure(ScmObj obj, ScmObj args)
{
ScmObj port = scm_current_output_port;
+ DECLARE_FUNCTION("write-with-shared-structure", ProcedureVariadic1);
/* get port */
port = scm_current_output_port;
Modified: branches/r5rs/sigscheme/operations-srfi60.c
===================================================================
--- branches/r5rs/sigscheme/operations-srfi60.c 2005-10-04 15:54:35 UTC (rev 1804)
+++ branches/r5rs/sigscheme/operations-srfi60.c 2005-10-04 17:21:51 UTC (rev 1805)
@@ -55,14 +55,12 @@
case SCM_REDUCE_0: \
break; \
case SCM_REDUCE_1: \
- if (!INTP(left)) \
- SigScm_ErrorObj(opstr " : integer required but got ", left); \
+ ASSERT_INTP(left); \
return right; \
case SCM_REDUCE_PARTWAY: \
case SCM_REDUCE_LAST: \
/* left is already ensured as int by previous loop */ \
- if (!INTP(right)) \
- SigScm_ErrorObj(opstr " : integer required but got ", right); \
+ ASSERT_INTP(right); \
result = (SCM_INT_VALUE(left) op SCM_INT_VALUE(right)); \
break; \
default: \
@@ -109,39 +107,41 @@
ScmObj ScmOp_SRFI60_logand(ScmObj left, ScmObj right,
enum ScmReductionState *state)
{
+ DECLARE_FUNCTION("logand", ReductionOperator);
BITWISE_OPERATION_BODY(&, "logand");
}
ScmObj ScmOp_SRFI60_logior(ScmObj left, ScmObj right,
enum ScmReductionState *state)
{
- BITWISE_OPERATION_BODY(|, "logand");
+ DECLARE_FUNCTION("logior", ReductionOperator);
+ BITWISE_OPERATION_BODY(|, "logior");
}
ScmObj ScmOp_SRFI60_logxor(ScmObj left, ScmObj right,
enum ScmReductionState *state)
{
- BITWISE_OPERATION_BODY(^, "logand");
+ DECLARE_FUNCTION("logexor", ReductionOperator);
+ BITWISE_OPERATION_BODY(^, "logxor");
}
ScmObj ScmOp_SRFI60_lognot(ScmObj n)
{
- if (!INTP(n))
- SigScm_ErrorObj("lognot : integer required but got ", n);
+ DECLARE_FUNCTION("lognot", ProcedureFixed1);
+ ASSERT_INTP(n);
+
return Scm_NewInt(~SCM_INT_VALUE(n));
}
ScmObj ScmOp_SRFI60_bitwise_if(ScmObj mask, ScmObj n0, ScmObj n1)
{
int result, c_mask;
+ DECLARE_FUNCTION("bitwise-if", ProcedureFixed3);
- if (!INTP(mask))
- SigScm_ErrorObj("bitwise-if : integer required but got ", mask);
- if (!INTP(n0))
- SigScm_ErrorObj("bitwise-if : integer required but got ", n0);
- if (!INTP(n1))
- SigScm_ErrorObj("bitwise-if : integer required but got ", n1);
+ ASSERT_INTP(mask);
+ ASSERT_INTP(n0);
+ ASSERT_INTP(n1);
c_mask = SCM_INT_VALUE(mask);
result = (c_mask & SCM_INT_VALUE(n0)) | (~c_mask & SCM_INT_VALUE(n1));
@@ -151,10 +151,10 @@
ScmObj ScmOp_SRFI60_logtest(ScmObj j, ScmObj k)
{
- if (!INTP(j))
- SigScm_ErrorObj("logtest : integer required but got ", j);
- if (!INTP(k))
- SigScm_ErrorObj("logtest : integer required but got ", k);
+ DECLARE_FUNCTION("logtest", ProcedureFixed2);
+ ASSERT_INTP(j);
+ ASSERT_INTP(k);
+
return (SCM_INT_VALUE(j) & SCM_INT_VALUE(k)) ? SCM_TRUE : SCM_FALSE;
}
Modified: branches/r5rs/sigscheme/operations-srfi8.c
===================================================================
--- branches/r5rs/sigscheme/operations-srfi8.c 2005-10-04 15:54:35 UTC (rev 1804)
+++ branches/r5rs/sigscheme/operations-srfi8.c 2005-10-04 17:21:51 UTC (rev 1805)
@@ -78,6 +78,7 @@
*/
ScmObj env = eval_state->env;
ScmObj actuals = SCM_FALSE;
+ DECLARE_FUNCTION("receive", SyntaxVariadicTailRec2);
/* FIXME: do we have to extend the environment first? The SRFI-8
* document contradicts itself on this part. */
Modified: branches/r5rs/sigscheme/operations.c
===================================================================
--- branches/r5rs/sigscheme/operations.c 2005-10-04 15:54:35 UTC (rev 1804)
+++ branches/r5rs/sigscheme/operations.c 2005-10-04 17:21:51 UTC (rev 1805)
@@ -868,9 +868,9 @@
{
ScmObj ret_lst = SCM_NULL;
ScmObj *ret_tail = &ret_lst;
-
ScmObj ls;
ScmObj obj = SCM_NULL;
+ DECLARE_FUNCTION("append", ProcedureVariadic0);
if (NULLP(args))
return SCM_NULL;
@@ -883,8 +883,7 @@
ret_tail = &CDR(*ret_tail);
}
if (!NULLP(ls))
- SigScm_ErrorObj("append: proper list required but got: ",
- CAR(args));
+ ERR_OBJ("proper list required but got: ", CAR(args));
}
/* append the last argument */
@@ -896,12 +895,13 @@
ScmObj ScmOp_reverse(ScmObj lst)
{
ScmObj ret_lst = SCM_NULL;
+ DECLARE_FUNCTION("reverse", ProcedureFixed1);
for (; CONSP(lst); lst = CDR(lst))
ret_lst = CONS(CAR(lst), ret_lst);
if (!NULLP(lst))
- SigScm_ErrorObj("reverse: got improper list: ", lst);
+ ERR_OBJ("got improper list: ", lst);
return ret_lst;
}
@@ -920,35 +920,43 @@
ScmObj ScmOp_list_tail(ScmObj lst, ScmObj scm_k)
{
ScmObj ret;
+ DECLARE_FUNCTION("list-tail", ProcedureFixed2);
- if (FALSEP(ScmOp_numberp(scm_k)))
- SigScm_ErrorObj("list-tail: number required but got ", scm_k);
+ ASSERT_INTP(scm_k);
ret = ScmOp_listtail_internal(lst, SCM_INT_VALUE(scm_k));
+ if (EQ(ret, SCM_INVALID))
+ ERR_OBJ("out of range or bad list, arglist is: ", CONS(lst, scm_k));
- if (EQ(ret, SCM_INVALID))
- SigScm_ErrorObj("list-tail: out of range or bad list, arglist is: ",
- CONS(lst, scm_k));
return ret;
}
ScmObj ScmOp_list_ref(ScmObj lst, ScmObj scm_k)
{
ScmObj tail = SCM_NULL;
+ DECLARE_FUNCTION("list-ref", ProcedureFixed2);
- if (FALSEP(ScmOp_numberp(scm_k)))
- SigScm_ErrorObj("list-ref : int required but got ", scm_k);
+ ASSERT_INTP(scm_k);
tail = ScmOp_listtail_internal(lst, SCM_INT_VALUE(scm_k));
if (EQ(tail, SCM_INVALID) || NULLP(tail))
- SigScm_ErrorObj("list-ref : out of range or bad list, arglist is: ",
- CONS(lst, scm_k));
-
+ ERR_OBJ("out of range or bad list, arglist is: ", CONS(lst, scm_k));
+
return CAR(tail);
}
+#define MEM_OPERATION_BODY(obj, lst, cmpop) \
+ do { \
+ for (; CONSP(lst); lst = CDR(lst)) \
+ if (cmpop(obj, CAR(lst))) \
+ return lst; \
+ return SCM_FALSE; \
+ } while (/* CONSTCOND */ 0)
+
ScmObj ScmOp_memq(ScmObj obj, ScmObj lst)
{
+ DECLARE_FUNCTION("memq", ProcedureFixed2);
+
for (; CONSP(lst); lst = CDR(lst))
if (EQ(obj, CAR(lst)))
return lst;
@@ -958,6 +966,8 @@
ScmObj ScmOp_memv(ScmObj obj, ScmObj lst)
{
+ DECLARE_FUNCTION("memv", ProcedureFixed2);
+
for (; CONSP(lst); lst = CDR(lst))
if (NFALSEP(ScmOp_eqvp(obj, CAR(lst))))
return lst;
@@ -967,6 +977,8 @@
ScmObj ScmOp_member(ScmObj obj, ScmObj lst)
{
+ DECLARE_FUNCTION("member", ProcedureFixed2);
+
for (; CONSP(lst); lst = CDR(lst))
if (NFALSEP(ScmOp_equalp(obj, CAR(lst))))
return lst;
@@ -979,13 +991,13 @@
ScmObj tmp_lst = SCM_NULL;
ScmObj tmpobj = SCM_NULL;
ScmObj car;
+ DECLARE_FUNCTION("assq", ProcedureFixed2);
for (tmp_lst = alist; CONSP(tmp_lst); tmp_lst = CDR(tmp_lst)) {
tmpobj = CAR(tmp_lst);
car = CAR(tmpobj);
#if SCM_STRICT_R5RS
- if (!CONSP(tmpobj))
- SigScm_ErrorObj("assq: invalid alist: ", alist);
+ ASSRERT_CONSP(tmpobj);
if (EQ(CAR(tmpobj), obj))
return tmpobj;
#else
@@ -1002,13 +1014,13 @@
ScmObj tmp_lst = SCM_NULL;
ScmObj tmpobj = SCM_NULL;
ScmObj car;
+ DECLARE_FUNCTION("assv", ProcedureFixed2);
for (tmp_lst = alist; CONSP(tmp_lst); tmp_lst = CDR(tmp_lst)) {
tmpobj = CAR(tmp_lst);
car = CAR(tmpobj);
#if SCM_STRICT_R5RS
- if (!CONSP(tmpobj))
- SigScm_ErrorObj("assv: invalid alist: ", alist);
+ ASSERT_CONSP(tmpobj);
if (NFALSEP(ScmOp_eqvp(car, obj)))
return tmpobj;
#else
@@ -1025,13 +1037,13 @@
ScmObj tmp_lst = SCM_NULL;
ScmObj tmpobj = SCM_NULL;
ScmObj car;
+ DECLARE_FUNCTION("assoc", ProcedureFixed2);
for (tmp_lst = alist; CONSP(tmp_lst); tmp_lst = CDR(tmp_lst)) {
tmpobj = CAR(tmp_lst);
car = CAR(tmpobj);
#if SCM_STRICT_R5RS
- if (!CONSP(tmpobj))
- SigScm_ErrorObj("assoc: invalid alist: ", alist);
+ ASSERT_CONSP(tmpobj);
if (NFALSEP(ScmOp_equalp(car, obj)))
return tmpobj;
#else
@@ -1385,8 +1397,7 @@
/* count total size of the new string */
for (strings = args; !NULLP(strings); strings = CDR(strings)) {
obj = CAR(strings);
- if (!STRINGP(obj))
- SigScm_ErrorObj("string-append : string required but got ", obj);
+ ASSERT_STRINGP(obj);
total_size += strlen(SCM_STRING_STR(obj));
total_len += SCM_STRING_LEN(obj);
@@ -1456,9 +1467,10 @@
char *new_str = NULL;
char *ch = NULL;
char *p = NULL;
+ DECLARE_FUNCTION("list->string", ProcedureFixed1);
if (FALSEP(ScmOp_listp(lst)))
- SigScm_ErrorObj("list->string : list required but got ", lst);
+ ERR_OBJ("list required but got ", lst);
if (NULLP(lst))
return Scm_NewStringCopying("");
@@ -1466,8 +1478,7 @@
/* count total size of the string */
for (chars = lst; !NULLP(chars); chars = CDR(chars)) {
obj = CAR(chars);
- if (!CHARP(obj))
- SigScm_ErrorObj("list->string : char required but got ", obj);
+ ASSERT_CHARP(obj);
total_size += strlen(SCM_CHAR_VALUE(obj));
}
@@ -1530,6 +1541,7 @@
==============================================================================*/
ScmObj ScmOp_vectorp(ScmObj obj)
{
+ DECLARE_FUNCTION("vector?", ProcedureFixed1);
return (VECTORP(obj)) ? SCM_TRUE : SCM_FALSE;
}
@@ -1539,9 +1551,9 @@
ScmObj filler = SCM_FALSE;
int len = 0;
int i = 0;
+ DECLARE_FUNCTION("make-vector", ProcedureVariadic1);
- if (!INTP(vector_len))
- SigScm_ErrorObj("make-vector : integer required but got ", vector_len);
+ ASSERT_INTP(vector_len);
/* allocate vector */
len = SCM_INT_VALUE(vector_len);
@@ -1563,6 +1575,7 @@
int len = SCM_INT_VALUE(ScmOp_length(args));
int i = 0;
ScmObj *vec = (ScmObj*)malloc(sizeof(ScmObj) * len); /* allocate vector */
+ DECLARE_FUNCTION("vector", ProcedureVariadic0);
/* set item */
for (i = 0; i < len; i++)
@@ -1638,10 +1651,11 @@
ScmObj *v = NULL;
int c_len = 0;
int i = 0;
+ DECLARE_FUNCTION("list->vector", ProcedureFixed1);
/* TOOD : canbe optimized. scanning list many times */
if (FALSEP(ScmOp_listp(lst)))
- SigScm_ErrorObj("list->vector : list required but got ", lst);
+ ERR_OBJ("list required but got ", lst);
scm_len = ScmOp_length(lst);
c_len = SCM_INT_VALUE(scm_len);
@@ -1782,9 +1796,9 @@
ScmObj ScmOp_force(ScmObj closure)
{
DECLARE_FUNCTION("force", ProcedureFixed1);
- if (!CLOSUREP(closure))
- SigScm_ErrorObj("force : not proper delayed object ", closure);
+ ASSERT_CLOSUREP(closure);
+
return Scm_call(closure, SCM_NULL);
}
Modified: branches/r5rs/sigscheme/read.c
===================================================================
--- branches/r5rs/sigscheme/read.c 2005-10-04 15:54:35 UTC (rev 1804)
+++ branches/r5rs/sigscheme/read.c 2005-10-04 17:21:51 UTC (rev 1805)
@@ -123,7 +123,7 @@
ScmObj sexp = SCM_FALSE;
if (!PORTP(port))
- SigScm_ErrorObj("SigScm_Read : port required but got ", port);
+ Scm_ErrorObj("SigScm_Read", "port required but got ", port);
sexp = read_sexpression(port);
#if SCM_DEBUG
@@ -139,7 +139,7 @@
ScmObj SigScm_Read_Char(ScmObj port)
{
if (!PORTP(port))
- SigScm_ErrorObj("SigScm_Read_Char : port required but got ", port);
+ Scm_ErrorObj("SigScm_Read_Char", "port required but got ", port);
return read_char(port);
}
More information about the uim-commit
mailing list