[uim-commit] r976 - branches/r5rs/sigscheme
kzk at freedesktop.org
kzk at freedesktop.org
Tue Jul 19 07:17:41 EST 2005
Author: kzk
Date: 2005-07-18 14:17:38 -0700 (Mon, 18 Jul 2005)
New Revision: 976
Modified:
branches/r5rs/sigscheme/debug.c
branches/r5rs/sigscheme/error.c
branches/r5rs/sigscheme/eval.c
branches/r5rs/sigscheme/io.c
branches/r5rs/sigscheme/operations.c
branches/r5rs/sigscheme/read.c
branches/r5rs/sigscheme/sigscheme.h
Log:
* This commit aims to print more efficient error message
for debugging.
* sigscheme/sigscheme.h
- (SigScm_ErrorObj): new func
* sigscheme/error.c
- (SigScm_ErrorObj): new func
* sigscheme/io.c
* sigscheme/read.c
* sigscheme/operations.c
* sigscheme/eval.c
* sigscheme/debug.c
- rewrite almost all the error message.
Modified: branches/r5rs/sigscheme/debug.c
===================================================================
--- branches/r5rs/sigscheme/debug.c 2005-07-18 19:48:58 UTC (rev 975)
+++ branches/r5rs/sigscheme/debug.c 2005-07-18 21:17:38 UTC (rev 976)
@@ -72,8 +72,6 @@
void SigScm_DisplayToPort(ScmObj port, ScmObj obj)
{
FILE *f = SCM_PORTINFO_FILE(port);
-
-
print_ScmObj_internal(f, obj);
}
Modified: branches/r5rs/sigscheme/error.c
===================================================================
--- branches/r5rs/sigscheme/error.c 2005-07-18 19:48:58 UTC (rev 975)
+++ branches/r5rs/sigscheme/error.c 2005-07-18 21:17:38 UTC (rev 976)
@@ -65,6 +65,17 @@
void SigScm_Error(const char *msg)
{
- fprintf(stderr, "%s\n", msg);
+ fprintf(SCM_PORTINFO_FILE(current_output_port), "%s\n", msg);
exit(-1);
}
+
+void SigScm_ErrorObj(const char *msg, ScmObj obj)
+{
+ /* print msg */
+ fprintf(SCM_PORTINFO_FILE(current_output_port), "%s", msg);
+
+ /* print obj */
+ SigScm_Display(obj);
+
+ exit(-1);
+}
Modified: branches/r5rs/sigscheme/eval.c
===================================================================
--- branches/r5rs/sigscheme/eval.c 2005-07-18 19:48:58 UTC (rev 975)
+++ branches/r5rs/sigscheme/eval.c 2005-07-18 21:17:38 UTC (rev 976)
@@ -176,8 +176,8 @@
SigScm_Error("Broken frame.\n");
/* lookup in frame */
+ vars = SCM_CAR(frame);
vals = SCM_CDR(frame);
- vars = SCM_CAR(frame);
for (; !SCM_NULLP(vars) && !SCM_NULLP(vals); vars = SCM_CDR(vars), vals = SCM_CDR(vals)) {
if (SCM_EQ(SCM_CAR(vars), var)) {
return vals;
@@ -211,11 +211,11 @@
switch (SCM_GETTYPE(tmp)) {
case ScmFunc:
break;
+ case ScmClosure:
+ break;
case ScmSymbol:
tmp = symbol_value(tmp, env);
break;
- case ScmClosure:
- break;
case ScmCons:
tmp = ScmOp_eval(tmp, env);
break;
@@ -369,7 +369,7 @@
obj = SCM_FUNC_EXEC_SUBR2N(proc,
obj,
ScmOp_eval(SCM_CAR(args), env));
- }
+ }
return obj;
}
case ARGNUM_0:
@@ -439,10 +439,10 @@
static ScmObj symbol_value(ScmObj var, ScmObj env)
{
ScmObj val = SCM_NIL;
-
+
/* sanity check */
if (!SCM_SYMBOLP(var))
- SigScm_Error("not symbol.\n");
+ SigScm_ErrorObj("symbol_value : not symbol : ", var);
/* First, lookup the Environment */
val = lookup_environment(var, env);
@@ -454,7 +454,7 @@
/* Next, look at the VCELL */
val = SCM_SYMBOL_VCELL(var);
if (EQ(val, SCM_UNBOUND)) {
- SigScm_Error("symbol_value : unbound variable.\n");
+ SigScm_ErrorObj("symbol_value : unbound variable ", var);
}
return val;
@@ -471,11 +471,11 @@
return SCM_NIL;
/* eval each element of args */
- result = Scm_NewCons( ScmOp_eval(SCM_CAR(args), env), SCM_NIL );
+ result = Scm_NewCons(ScmOp_eval(SCM_CAR(args), env), SCM_NIL);
tail = result;
newtail = SCM_NIL;
for (args = SCM_CDR(args); !SCM_NULLP(args); args = SCM_CDR(args)) {
- newtail = Scm_NewCons( ScmOp_eval(SCM_CAR(args), env), SCM_NIL );
+ newtail = Scm_NewCons(ScmOp_eval(SCM_CAR(args), env), SCM_NIL);
SCM_SETCDR(tail, newtail);
tail = newtail;
}
@@ -538,7 +538,7 @@
if (SCM_NULLP(list))
return SCM_NIL;
if (!SCM_CONSP(list))
- SigScm_Error("last_pair : require list\n");
+ SigScm_ErrorObj("last_pair : list required but got ", list);
while (1) {
if (!SCM_CONSP(list) || SCM_NULLP(SCM_CDR(list)))
@@ -569,7 +569,7 @@
ScmObj ScmExp_lambda(ScmObj exp, ScmObj env)
{
if CHECK_2_ARGS(exp)
- SigScm_Error("lambda : few argument\n");
+ SigScm_Error("lambda : too few argument\n");
return Scm_NewClosure(exp, env);
}
@@ -622,7 +622,7 @@
* if symbol is not bounded, error occurs
*/
if (EQ(ScmOp_boundp(sym), SCM_FALSE))
- SigScm_Error("set! : unbound variable\n");
+ SigScm_ErrorObj("set! : unbound variable ", sym);
SCM_SETSYMBOL_VCELL(sym, ret);
} else {
@@ -702,7 +702,7 @@
if (SCM_NULLP(arg))
return SCM_TRUE;
if (EQ(ScmOp_listp(arg), SCM_FALSE))
- SigScm_Error("and : cannot evaluate improper list\n");
+ SigScm_ErrorObj("and : list required but got ", arg);
/* check recursively */
for (; !SCM_NULLP(arg); arg = SCM_CDR(arg)) {
@@ -729,7 +729,7 @@
if (SCM_NULLP(arg))
return SCM_FALSE;
if (EQ(ScmOp_listp(arg), SCM_FALSE))
- SigScm_Error("or : cannot evaluate improper list\n");
+ SigScm_ErrorObj("or : list required but got ", arg);
/* check recursively */
for (; !SCM_NULLP(arg); arg = SCM_CDR(arg)) {
@@ -838,7 +838,7 @@
if (SCM_NULLP(arg))
return SCM_UNDEF;
if (EQ(ScmOp_listp(arg), SCM_FALSE))
- SigScm_Error("begin : improper list\n");
+ SigScm_ErrorObj("begin : list required but got ", arg);
/* eval recursively */
for (; !SCM_NULLP(arg); arg = SCM_CDR(arg)) {
@@ -914,7 +914,7 @@
/* now excution phase! */
while (!SCM_EQ(ScmOp_eval(test, env), SCM_TRUE)) {
ScmExp_begin(commands, env);
-
+
tmp_steps = steps;
for (; !SCM_NULLP(tmp_steps); tmp_steps = SCM_CDR(tmp_steps)) {
ScmExp_set(SCM_CAR(tmp_steps), env);
Modified: branches/r5rs/sigscheme/io.c
===================================================================
--- branches/r5rs/sigscheme/io.c 2005-07-18 19:48:58 UTC (rev 975)
+++ branches/r5rs/sigscheme/io.c 2005-07-18 21:17:38 UTC (rev 976)
@@ -74,9 +74,9 @@
ScmObj ret = SCM_NIL;
if (!SCM_STRINGP(filepath))
- SigScm_Error("call-with-input-file : string required\n");
+ SigScm_ErrorObj("call-with-input-file : string required but got", filepath);
if (!SCM_FUNCP(proc) && !SCM_CLOSUREP(proc))
- SigScm_Error("call-with-input-file : proc required\n");
+ SigScm_ErrorObj("call-with-input-file : proc required but got ", proc);
/* open port */
port = ScmOp_open_input_file(filepath);
@@ -96,9 +96,9 @@
ScmObj ret = SCM_NIL;
if (!SCM_STRINGP(filepath))
- SigScm_Error("call-with-output-file : string required\n");
+ SigScm_ErrorObj("call-with-output-file : string required but got ", filepath);
if (!SCM_FUNCP(proc) && !SCM_CLOSUREP(proc))
- SigScm_Error("call-with-output-file : proc required\n");
+ SigScm_ErrorObj("call-with-output-file : proc required but got ", proc);
/* open port */
port = ScmOp_open_output_file(filepath);
@@ -144,9 +144,9 @@
ScmObj ret = SCM_NIL;
if (!SCM_STRINGP(filepath))
- SigScm_Error("with-input-from-file : string required\n");
+ SigScm_ErrorObj("with-input-from-file : string required but got ", filepath);
if (!SCM_FUNCP(thunk) && !SCM_CLOSUREP(thunk))
- SigScm_Error("with-input-from-file : proc required\n");
+ SigScm_ErrorObj("with-input-from-file : proc required but got ", thunk);
/* set current_input_port */
tmp_port = current_input_port;
@@ -170,9 +170,9 @@
ScmObj ret = SCM_NIL;
if (!SCM_STRINGP(filepath))
- SigScm_Error("with-output-to-file : string required\n");
+ SigScm_ErrorObj("with-output-to-file : string required but got ", filepath);
if (!SCM_FUNCP(thunk) && !SCM_CLOSUREP(thunk))
- SigScm_Error("with-output-to-file : proc required\n");
+ SigScm_ErrorObj("with-output-to-file : proc required but got ", thunk);
/* set current_output_port */
tmp_port = current_output_port;
@@ -195,12 +195,12 @@
FILE *f = NULL;
if (!SCM_STRINGP(filepath))
- SigScm_Error("open-input-file : string requred\n");
+ SigScm_ErrorObj("open-input-file : string requred but got ", filepath);
/* Open File */
f = fopen(SCM_STRING_STR(filepath), "r");
if (!f)
- SigScm_Error("cannot open file.\n");
+ SigScm_ErrorObj("open-input-file : cannot open file ", filepath);
/* Allocate ScmPort */
return Scm_NewPort(f, PORT_INPUT);
@@ -211,13 +211,12 @@
FILE *f = NULL;
if (!SCM_STRINGP(filepath))
- SigScm_Error("open-output-file : string requred\n");
+ SigScm_ErrorObj("open-output-file : string requred but got ", filepath);
/* Open File */
f = fopen(SCM_STRING_STR(filepath), "w");
- if (!f) {
- SigScm_Error("cannot open file.\n");
- }
+ if (!f)
+ SigScm_ErrorObj("open-output-file : cannot open file ", filepath);
/* Return new ScmPort */
return Scm_NewPort(f, PORT_OUTPUT);
@@ -226,7 +225,7 @@
ScmObj ScmOp_close_input_port(ScmObj port)
{
if (!SCM_PORTP(port))
- SigScm_Error("close-input-port : port requred\n");
+ SigScm_ErrorObj("close-input-port : port requred but got ", port);
if (SCM_PORTINFO_FILE(port))
fclose(SCM_PORTINFO_FILE(port));
@@ -237,7 +236,7 @@
ScmObj ScmOp_close_output_port(ScmObj port)
{
if (!SCM_PORTP(port))
- SigScm_Error("close-output-port : port requred\n");
+ SigScm_ErrorObj("close-output-port : port requred but got ", port);
if (SCM_PORTINFO_FILE(port))
fclose(SCM_PORTINFO_FILE(port));
@@ -258,7 +257,7 @@
/* (read port) */
port = SCM_CAR(SCM_CDR(arg));
} else {
- SigScm_Error("read : invalid paramter\n");
+ SigScm_ErrorObj("read : invalid paramter", arg);
}
return SigScm_Read(port);
@@ -274,7 +273,7 @@
/* (read-char port) */
port = SCM_CAR(SCM_CDR(arg));
} else {
- SigScm_Error("read-char : invalid paramter\n");
+ SigScm_ErrorObj("read-char : invalid paramter", arg);
}
return SigScm_Read_Char(port);
@@ -326,7 +325,7 @@
/* (write obj port) */
port = SCM_CAR(SCM_CDR(arg));
} else {
- SigScm_Error("write : invalid paramter\n");
+ SigScm_ErrorObj("write : invalid paramter ", arg);
}
SigScm_DisplayToPort(port, obj);
@@ -357,7 +356,7 @@
/* (write obj port) */
port = SCM_CAR(SCM_CDR(arg));
} else {
- SigScm_Error("display : invalid paramter\n");
+ SigScm_ErrorObj("display : invalid paramter ", arg);
}
SigScm_DisplayToPort(port, obj);
@@ -375,7 +374,7 @@
/* (write obj port) */
port = SCM_CAR(SCM_CDR(arg));
} else {
- SigScm_Error("newline : invalid paramter\n");
+ SigScm_ErrorObj("newline : invalid paramter ", arg);
}
fprintf(SCM_PORTINFO_FILE(port), "\n");
@@ -394,7 +393,7 @@
obj = SCM_CAR(arg);
arg = SCM_CDR(arg);
if (!SCM_CHARP(obj))
- SigScm_Error("write-char : char required\n");
+ SigScm_ErrorObj("write-char : char required but got ", obj);
/* get port */
port = SCM_NIL;
@@ -405,7 +404,7 @@
/* (write obj port) */
port = SCM_CAR(SCM_CDR(arg));
} else {
- SigScm_Error("write : invalid paramter\n");
+ SigScm_ErrorObj("write : invalid paramter ", arg);
}
SigScm_DisplayToPort(port, obj);
Modified: branches/r5rs/sigscheme/operations.c
===================================================================
--- branches/r5rs/sigscheme/operations.c 2005-07-18 19:48:58 UTC (rev 975)
+++ branches/r5rs/sigscheme/operations.c 2005-07-18 21:17:38 UTC (rev 976)
@@ -244,33 +244,41 @@
==============================================================================*/
ScmObj ScmOp_plus2n(ScmObj obj1, ScmObj obj2)
{
- if (!SCM_INTP(obj1) || !SCM_INTP(obj2))
- SigScm_Error("+ : integer required\n");
-
+ if (!SCM_INTP(obj1))
+ SigScm_ErrorObj("+ : integer required but got ", obj1);
+ if (!SCM_INTP(obj2))
+ SigScm_ErrorObj("+ : integer required but got ", obj2);
+
return Scm_NewInt(SCM_INT_VALUE(obj1) + SCM_INT_VALUE(obj2));
}
ScmObj ScmOp_minus2n(ScmObj obj1, ScmObj obj2)
{
- if (!SCM_INTP(obj1) || !SCM_INTP(obj2))
- SigScm_Error("- : integer required\n");
+ if (!SCM_INTP(obj1))
+ SigScm_ErrorObj("- : integer required but got ", obj1);
+ if (!SCM_INTP(obj2))
+ SigScm_ErrorObj("- : integer required but got ", obj2);
+
return Scm_NewInt(SCM_INT_VALUE(obj1) - SCM_INT_VALUE(obj2));
}
ScmObj ScmOp_multi2n(ScmObj obj1, ScmObj obj2)
{
- if (!SCM_INTP(obj1) || !SCM_INTP(obj2))
- SigScm_Error("* : integer required\n");
+ if (!SCM_INTP(obj1))
+ SigScm_ErrorObj("* : integer required but got ", obj1);
+ if (!SCM_INTP(obj2))
+ SigScm_ErrorObj("* : integer required but got ", obj2);
return Scm_NewInt(SCM_INT_VALUE(obj1) * SCM_INT_VALUE(obj2));
}
ScmObj ScmOp_divide2n(ScmObj obj1, ScmObj obj2)
{
- if (!SCM_INTP(obj1) || !SCM_INTP(obj2))
- SigScm_Error("/ : integer required\n");
-
+ if (!SCM_INTP(obj1))
+ SigScm_ErrorObj("/ : integer required but got ", obj1);
+ if (!SCM_INTP(obj2))
+ SigScm_ErrorObj("/ : integer required but got ", obj2);
if (EQ(ScmOp_zerop(obj2), SCM_TRUE))
SigScm_Error("/ : divide by zero\n");
@@ -292,7 +300,7 @@
/* type check */
if (EQ(ScmOp_numberp(SCM_CAR(args)), SCM_FALSE))
- SigScm_Error("= : number required\n");
+ SigScm_ErrorObj("= : number required but got ", SCM_CAR(args));
/* arglen check */
if CHECK_2_ARGS(args)
@@ -305,7 +313,7 @@
for (args = SCM_CDR(args); !SCM_NULLP(args); args = SCM_CDR(args)) {
obj = SCM_CAR(args);
if (EQ(ScmOp_numberp(obj), SCM_FALSE))
- SigScm_Error("number required\n");
+ SigScm_ErrorObj("= : number required but got ", obj);
if (SCM_INT_VALUE(obj) != val)
{
@@ -327,7 +335,7 @@
/* type check */
if (EQ(ScmOp_numberp(SCM_CAR(args)), SCM_FALSE))
- SigScm_Error("number required\n");
+ SigScm_ErrorObj("< : number required but got ", SCM_CAR(args));
/* Get first value */
val = SCM_INT_VALUE(SCM_CAR(args));
@@ -336,7 +344,7 @@
for (args = SCM_CDR(args); !SCM_NULLP(args); args = SCM_CDR(args)) {
obj = SCM_CAR(args);
if (EQ(ScmOp_numberp(obj), SCM_FALSE))
- SigScm_Error("number required\n");
+ SigScm_ErrorObj("< : number required but got ", obj);
car_val = SCM_INT_VALUE(obj);
if (val < car_val)
@@ -356,7 +364,7 @@
/* type check */
if (EQ(ScmOp_numberp(SCM_CAR(args)), SCM_FALSE))
- SigScm_Error("number required\n");
+ SigScm_ErrorObj("> : number required but got ", SCM_CAR(args));
/* arglen check */
if CHECK_2_ARGS(args)
@@ -369,7 +377,7 @@
for (args = SCM_CDR(args); !SCM_NULLP(args); args = SCM_CDR(args)) {
obj = SCM_CAR(args);
if (EQ(ScmOp_numberp(obj), SCM_FALSE))
- SigScm_Error("number required\n");
+ SigScm_ErrorObj("> : number required but got ", obj);
car_val = SCM_INT_VALUE(obj);
if (val > car_val)
@@ -389,7 +397,7 @@
/* type check */
if (EQ(ScmOp_numberp(SCM_CAR(args)), SCM_FALSE))
- SigScm_Error("number required\n");
+ SigScm_ErrorObj("<= : number required but got ", SCM_CAR(args));
/* arglen check */
if CHECK_2_ARGS(args)
@@ -403,7 +411,7 @@
for (args = SCM_CDR(args); !SCM_NULLP(args); args = SCM_CDR(args)) {
obj = SCM_CAR(args);
if (EQ(ScmOp_numberp(obj), SCM_FALSE))
- SigScm_Error("number required\n");
+ SigScm_ErrorObj("<= : number required but got ", obj);
car_val = SCM_INT_VALUE(obj);
if (val <= car_val)
@@ -423,7 +431,7 @@
/* type check */
if (EQ(ScmOp_numberp(SCM_CAR(args)), SCM_FALSE))
- SigScm_Error("number required\n");
+ SigScm_ErrorObj(">= : number required but got ", SCM_CAR(args));
/* arglen check */
if CHECK_2_ARGS(args)
@@ -437,7 +445,7 @@
for (args = SCM_CDR(args); !SCM_NULLP(args); args = SCM_CDR(args)) {
obj = SCM_CAR(args);
if (EQ(ScmOp_numberp(obj), SCM_FALSE))
- SigScm_Error("number required\n");
+ SigScm_ErrorObj(">= : number required but got ", obj);
car_val = SCM_INT_VALUE(obj);
if (val >= car_val)
@@ -452,7 +460,7 @@
ScmObj ScmOp_zerop(ScmObj scm_num)
{
if (EQ(ScmOp_numberp(scm_num), SCM_FALSE))
- SigScm_Error("number required\n");
+ SigScm_ErrorObj("zero? : number required but got ", scm_num);
if (SCM_INT_VALUE(scm_num) == 0)
return SCM_TRUE;
@@ -463,7 +471,7 @@
ScmObj ScmOp_positivep(ScmObj scm_num)
{
if (EQ(ScmOp_numberp(scm_num), SCM_FALSE))
- SigScm_Error("number required\n");
+ SigScm_ErrorObj("positive? : number required but got", scm_num);
if (SCM_INT_VALUE(scm_num) > 0)
return SCM_TRUE;
@@ -474,7 +482,7 @@
ScmObj ScmOp_negativep(ScmObj scm_num)
{
if (EQ(ScmOp_numberp(scm_num), SCM_FALSE))
- SigScm_Error("number required\n");
+ SigScm_ErrorObj("negative? : number required but got ", scm_num);
if (SCM_INT_VALUE(scm_num) < 0)
return SCM_TRUE;
@@ -485,7 +493,7 @@
ScmObj ScmOp_oddp(ScmObj scm_num)
{
if (EQ(ScmOp_numberp(scm_num), SCM_FALSE))
- SigScm_Error("number required\n");
+ SigScm_ErrorObj("odd? : number required but got ", scm_num);
if (SCM_INT_VALUE(scm_num) % 2 == 1)
return SCM_TRUE;
@@ -496,7 +504,7 @@
ScmObj ScmOp_evenp(ScmObj scm_num)
{
if (EQ(ScmOp_numberp(scm_num), SCM_FALSE))
- SigScm_Error("number required\n");
+ SigScm_ErrorObj("even? : number required but got ", scm_num);
if (SCM_INT_VALUE(scm_num) % 2 == 0)
return SCM_TRUE;
@@ -510,12 +518,13 @@
int car_val = 0;
ScmObj car = SCM_NIL;
- if (SCM_NULLP(args)) SigScm_Error("number required\n");
+ if (SCM_NULLP(args))
+ SigScm_Error("max : at least 1 number required\n");
for (; !SCM_NULLP(args); args = SCM_CDR(args)) {
car = SCM_CAR(args);
if (EQ(ScmOp_numberp(car), SCM_FALSE))
- SigScm_Error("number required\n");
+ SigScm_ErrorObj("max : number required but got ", car);
car_val = SCM_INT_VALUE(SCM_CAR(args));
if (max < car_val)
@@ -531,12 +540,13 @@
int car_val = 0;
ScmObj car = SCM_NIL;
- if (SCM_NULLP(args)) SigScm_Error("number required\n");
+ if (SCM_NULLP(args))
+ SigScm_Error("min : at least 1 number required\n");
for (; !SCM_NULLP(args); args = SCM_CDR(args)) {
car = SCM_CAR(args);
if (EQ(ScmOp_numberp(car), SCM_FALSE))
- SigScm_Error("number required\n");
+ SigScm_ErrorObj("min : number required but got ", car);
car_val = SCM_INT_VALUE(SCM_CAR(args));
if (car_val < min)
@@ -552,7 +562,7 @@
int num = 0;
if (EQ(ScmOp_numberp(scm_num), SCM_FALSE))
- SigScm_Error("number required\n");
+ SigScm_ErrorObj("abs : number required but got ", scm_num);
num = SCM_INT_VALUE(scm_num);
if (0 < num)
@@ -566,12 +576,12 @@
int n1 = 0;
int n2 = 0;
- if (EQ(ScmOp_numberp(scm_n1), SCM_FALSE)
- || EQ(ScmOp_numberp(scm_n2), SCM_FALSE))
- SigScm_Error("number required\n");
-
+ if (EQ(ScmOp_numberp(scm_n1), SCM_FALSE))
+ SigScm_ErrorObj("quotient : number required but got ", scm_n1);
+ if (EQ(ScmOp_numberp(scm_n2), SCM_FALSE))
+ SigScm_ErrorObj("quotient : number required but got ", scm_n2);
if (EQ(ScmOp_zerop(scm_n2), SCM_TRUE))
- SigScm_Error("divide by zero\n");
+ SigScm_Error("quotient : divide by zero\n");
n1 = SCM_INT_VALUE(scm_n1);
n2 = SCM_INT_VALUE(scm_n2);
@@ -585,12 +595,12 @@
int n2 = 0;
int rem = 0;
- if (EQ(ScmOp_numberp(scm_n1), SCM_FALSE)
- || EQ(ScmOp_numberp(scm_n2), SCM_FALSE))
- SigScm_Error("number required\n");
-
+ if (EQ(ScmOp_numberp(scm_n1), SCM_FALSE))
+ SigScm_ErrorObj("modulo : number required but got ", scm_n1);
+ if (EQ(ScmOp_numberp(scm_n2), SCM_FALSE))
+ SigScm_ErrorObj("modulo : number required but got ", scm_n2);
if (EQ(ScmOp_zerop(scm_n2), SCM_TRUE))
- SigScm_Error("divide by zero\n");
+ SigScm_Error("modulo : divide by zero\n");
n1 = SCM_INT_VALUE(scm_n1);
n2 = SCM_INT_VALUE(scm_n2);
@@ -610,12 +620,12 @@
int n1 = 0;
int n2 = 0;
- if (EQ(ScmOp_numberp(scm_n1), SCM_FALSE)
- || EQ(ScmOp_numberp(scm_n2), SCM_FALSE))
- SigScm_Error("number required\n");
-
+ if (EQ(ScmOp_numberp(scm_n1), SCM_FALSE))
+ SigScm_ErrorObj("remainder : number required but got ", scm_n1);
+ if (EQ(ScmOp_numberp(scm_n2), SCM_FALSE))
+ SigScm_ErrorObj("remainder : number required but got ", scm_n2);
if (EQ(ScmOp_zerop(scm_n2), SCM_TRUE))
- SigScm_Error("divide by zero\n");
+ SigScm_Error("remainder : divide by zero\n");
n1 = SCM_INT_VALUE(scm_n1);
n2 = SCM_INT_VALUE(scm_n2);
@@ -651,9 +661,9 @@
ScmObj ScmOp_car(ScmObj obj)
{
if (SCM_NULLP(obj))
- SigScm_Error("car error : empty list\n");
+ SigScm_Error("car : empty list\n");
if (!SCM_CONSP(obj))
- SigScm_Error("car error : not list\n");
+ SigScm_ErrorObj("car : list required but got ", obj);
return SCM_CAR(obj);
}
@@ -661,9 +671,9 @@
ScmObj ScmOp_cdr(ScmObj obj)
{
if (SCM_NULLP(obj))
- SigScm_Error("car error : empty list");
+ SigScm_Error("car : empty list");
if (!SCM_CONSP(obj))
- SigScm_Error("car error : not list\n");
+ SigScm_ErrorObj("car : list required but got ", obj);
return SCM_CDR(obj);
}
@@ -683,22 +693,20 @@
ScmObj ScmOp_setcar(ScmObj pair, ScmObj car)
{
- if (SCM_CONSP(pair)) {
+ if (SCM_CONSP(pair))
SCM_SETCAR(pair, car);
- } else {
- SigScm_Error("setcar error\n");
- }
+ else
+ SigScm_ErrorObj("set-car! : pair required but got ", pair);
return SCM_UNSPECIFIED;
}
ScmObj ScmOp_setcdr(ScmObj pair, ScmObj cdr)
{
- if (SCM_CONSP(pair)) {
+ if (SCM_CONSP(pair))
SCM_SETCDR(pair, cdr);
- } else {
- SigScm_Error("setcdr error\n");
- }
+ else
+ SigScm_ErrorObj("set-cdr! : pair required but got ", pair);
return SCM_UNSPECIFIED;
}
@@ -862,7 +870,7 @@
for (; !SCM_NULLP(obj); obj = SCM_CDR(obj)) {
/* check if valid list */
if (!SCM_NULLP(obj) && !SCM_CONSP(obj))
- SigScm_Error("Bad List\n");
+ SigScm_ErrorObj("length : bad list. given obj contains ", obj);
length++;
}
@@ -879,7 +887,7 @@
return tail;
if (!SCM_CONSP(head))
- SigScm_Error("list required.\n");
+ SigScm_ErrorObj("append : list required but got ", head);
head_tail = list_gettail(head);
if (SCM_NULLP(head_tail)) {
@@ -887,7 +895,7 @@
} else if (SCM_CONSP(head_tail)) {
SCM_SETCDR(head_tail, tail);
} else {
- SigScm_Error("list required\n");
+ SigScm_ErrorObj("append : list required but got ", head_tail);
}
return head;
@@ -909,8 +917,9 @@
{
ScmObj ret_list = SCM_NIL;
+ /* TODO : canbe optimized not to use ScmOp_listp */
if (EQ(ScmOp_listp(list), SCM_FALSE))
- SigScm_Error("list required\n");
+ SigScm_ErrorObj("reverse : list required but got ", list);
for (; !SCM_NULLP(list); list = SCM_CDR(list)) {
ret_list = Scm_NewCons(SCM_CAR(list), ret_list);
@@ -919,7 +928,7 @@
return ret_list;
}
-/* TODO : not to use recursive call */
+/* TODO : not to use recursive call for avoiding stack overflow*/
ScmObj ScmOp_listtail_internal(ScmObj obj, int k)
{
if (k == 0) {
@@ -935,9 +944,9 @@
ScmObj ScmOp_listtail(ScmObj list, ScmObj scm_k)
{
if (EQ(ScmOp_listp(list), SCM_FALSE))
- SigScm_Error("list required\n");
+ SigScm_ErrorObj("list-tail : list required but got ", list);
if (SCM_INTP(scm_k))
- SigScm_Error("int required\n");
+ SigScm_ErrorObj("list-tail : number required but got ", scm_k);
return ScmOp_listtail_internal(list, SCM_INT_VALUE(scm_k));
}
@@ -947,13 +956,13 @@
ScmObj list_tail = SCM_NIL;
if (EQ(ScmOp_listp(list), SCM_FALSE))
- SigScm_Error("list required\n");
+ SigScm_ErrorObj("list-ref : list required but got ", list);
if (SCM_INTP(scm_k))
- SigScm_Error("int required\n");
+ SigScm_ErrorObj("list-ref : int required but got ", scm_k);
list_tail = ScmOp_listtail_internal(list, SCM_INT_VALUE(scm_k));
if (SCM_NULLP(list_tail)) {
- SigScm_Error("out of range\n");
+ SigScm_Error("list-ref : out of range\n");
}
return SCM_CAR(list_tail);
@@ -1076,8 +1085,10 @@
ScmObj ScmOp_char_equal(ScmObj ch1, ScmObj ch2)
{
- if (!SCM_CHARP(ch1) || !SCM_CHARP(ch2))
- SigScm_Error("char=? : char required\n");
+ if (!SCM_CHARP(ch1))
+ SigScm_ErrorObj("char=? : char required but got ", ch1);
+ if (!SCM_CHARP(ch2))
+ SigScm_ErrorObj("char=? : char required but got ", ch2);
if (strcmp(SCM_CHAR_CH(ch1), SCM_CHAR_CH(ch2)) == 0)
return SCM_TRUE;
@@ -1088,7 +1099,7 @@
ScmObj ScmOp_char_alphabeticp(ScmObj obj)
{
if (!SCM_CHARP(obj))
- SigScm_Error("char-alphabetic? : char required\n");
+ SigScm_ErrorObj("char-alphabetic? : char required but got ", obj);
/* check multibyte */
if (strlen(SCM_CHAR_CH(obj)) != 1)
@@ -1104,7 +1115,7 @@
ScmObj ScmOp_char_numericp(ScmObj obj)
{
if (!SCM_CHARP(obj))
- SigScm_Error("char-alphabetic? : char required\n");
+ SigScm_ErrorObj("char-alphabetic? : char required but got ", obj);
/* check multibyte */
if (strlen(SCM_CHAR_CH(obj)) != 1)
@@ -1120,7 +1131,7 @@
ScmObj ScmOp_char_whitespacep(ScmObj obj)
{
if (!SCM_CHARP(obj))
- SigScm_Error("char-alphabetic? : char required\n");
+ SigScm_ErrorObj("char-alphabetic? : char required but got ", obj);
/* check multibyte */
if (strlen(SCM_CHAR_CH(obj)) != 1)
@@ -1136,7 +1147,7 @@
ScmObj ScmOp_char_upper_casep(ScmObj obj)
{
if (!SCM_CHARP(obj))
- SigScm_Error("char-alphabetic? : char required\n");
+ SigScm_ErrorObj("char-alphabetic? : char required but got ", obj);
/* check multibyte */
if (strlen(SCM_CHAR_CH(obj)) != 1)
@@ -1152,7 +1163,7 @@
ScmObj ScmOp_char_lower_casep(ScmObj obj)
{
if (!SCM_CHARP(obj))
- SigScm_Error("char-alphabetic? : char required\n");
+ SigScm_ErrorObj("char-alphabetic? : char required but got ", obj);
/* check multibyte */
if (strlen(SCM_CHAR_CH(obj)) != 1)
@@ -1186,9 +1197,9 @@
if (argc != 1 && argc != 2)
SigScm_Error("make-string : invalid use\n");
if (!SCM_INTP(SCM_CAR(arg)))
- SigScm_Error("make-string : integer required\n");
+ SigScm_ErrorObj("make-string : integer required but got ", SCM_CAR(arg));
if (argc == 2 && !SCM_CHARP(SCM_CAR(SCM_CDR(arg))))
- SigScm_Error("make-string : character required\n");
+ SigScm_ErrorObj("make-string : character required but got ", SCM_CAR(SCM_CDR(arg)));
len = SCM_INT_VALUE(SCM_CAR(arg));
if (argc == 1) {
@@ -1210,7 +1221,7 @@
ScmObj ScmOp_string_length(ScmObj str)
{
if (!SCM_STRINGP(str))
- SigScm_Error("string-length : not string\n");
+ SigScm_ErrorObj("string-length : string required but got ", str);
return Scm_NewInt(SigScm_default_encoding_strlen(SCM_STRING_STR(str)));
}
@@ -1224,9 +1235,9 @@
const char *ch_end_ptr = NULL;
if (!SCM_STRINGP(str))
- SigScm_Error("string-ref : not string\n");
+ SigScm_ErrorObj("string-ref : string required but got ", str);
if (!SCM_INTP(k))
- SigScm_Error("string-ref : not integer\n");
+ SigScm_ErrorObj("string-ref : number required but got ", k);
/* get start_ptr and end_ptr */
c_index = SCM_INT_VALUE(k);
@@ -1255,11 +1266,11 @@
const char *ch_end_ptr = NULL;
if (!SCM_STRINGP(str))
- SigScm_Error("string-set! : not string\n");
+ SigScm_ErrorObj("string-set! : string required but got ", str);
if (!SCM_INTP(k))
- SigScm_Error("string-set! : not integer\n");
+ SigScm_ErrorObj("string-set! : number required but got ", k);
if (!SCM_CHARP(ch))
- SigScm_Error("string-set! : not character\n");
+ SigScm_ErrorObj("string-set! : character required but got ", ch);
/* get indexes */
c_start_index = SCM_INT_VALUE(k);
@@ -1307,9 +1318,11 @@
const char *ch_end_ptr = NULL;
if (!SCM_STRINGP(str))
- SigScm_Error("string-ref : not string\n");
- if (!SCM_INTP(start) || !SCM_INTP(end))
- SigScm_Error("string-ref : not integer\n");
+ SigScm_ErrorObj("string-ref : string required but got ", str);
+ if (!SCM_INTP(start))
+ SigScm_ErrorObj("string-ref : number required but got ", start);
+ if (!SCM_INTP(end))
+ SigScm_ErrorObj("string-ref : number required but got ", end);
/* get start_ptr and end_ptr */
c_start_index = SCM_INT_VALUE(start);
@@ -1339,7 +1352,7 @@
for (strings = arg; !SCM_NULLP(strings); strings = SCM_CDR(strings)) {
obj = SCM_CAR(strings);
if (!SCM_STRINGP(obj))
- SigScm_Error("string-append : list required\n");
+ SigScm_ErrorObj("string-append : list required but got ", obj);
total_size += strlen(SCM_STRING_STR(obj));
total_len += SCM_STRING_LEN(obj);
@@ -1373,7 +1386,7 @@
char *new_ch = NULL;
if (!SCM_STRINGP(string))
- SigScm_Error("string->list : string required\n");
+ SigScm_ErrorObj("string->list : string required but got ", string);
string_str = SCM_STRING_STR(string);
str_len = SCM_STRING_LEN(string);
@@ -1409,13 +1422,13 @@
char *p = NULL;
if (EQ(ScmOp_listp(list), SCM_FALSE))
- SigScm_Error("list->string : list required\n");
+ SigScm_ErrorObj("list->string : list required but got ", list);
/* count total size of the string */
for (chars = list; !SCM_NULLP(chars); chars = SCM_CDR(chars)) {
obj = SCM_CAR(chars);
if (!SCM_CHARP(obj))
- SigScm_Error("list->string : char required\n");
+ SigScm_ErrorObj("list->string : char required but got ", obj);
total_size += strlen(SCM_CHAR_CH(obj));
}
@@ -1441,7 +1454,7 @@
char *dest_str = NULL;
if (!SCM_STRINGP(string))
- SigScm_Error("string-copy : string required\n");
+ SigScm_ErrorObj("string-copy : string required but got ", string);
orig_str = SCM_STRING_STR(string);
dest_str = (char*)malloc(sizeof(char) * (strlen(orig_str) + 1));
@@ -1459,9 +1472,9 @@
int i = 0;
if (!SCM_STRINGP(string))
- SigScm_Error("string-fill! : string required\n");
+ SigScm_ErrorObj("string-fill! : string required but got ", string);
if (!SCM_CHARP(ch))
- SigScm_Error("string-fill! : character required\n");
+ SigScm_ErrorObj("string-fill! : character required but got ", ch);
/* create new str */
char_size = strlen(SCM_CHAR_CH(ch));
@@ -1499,7 +1512,7 @@
int i = 0;
if (!SCM_INTP(scm_k))
- SigScm_Error("make-vector : integer required\n");
+ SigScm_ErrorObj("make-vector : integer required but got ", scm_k);
/* allocate vector */
c_k = SCM_INT_VALUE(scm_k);
@@ -1536,7 +1549,7 @@
ScmObj ScmOp_vector_length(ScmObj vec)
{
if (!SCM_VECTORP(vec))
- SigScm_Error("vector-length : vector required\n");
+ SigScm_ErrorObj("vector-length : vector required but got ", vec);
return Scm_NewInt(SCM_VECTOR_LEN(vec));
}
@@ -1544,9 +1557,9 @@
ScmObj ScmOp_vector_ref(ScmObj vec, ScmObj scm_k)
{
if (!SCM_VECTORP(vec))
- SigScm_Error("vector-ref : vector required\n");
+ SigScm_ErrorObj("vector-ref : vector required but got ", vec);
if (!SCM_INTP(scm_k))
- SigScm_Error("vector-ref : int required\n");
+ SigScm_ErrorObj("vector-ref : number required but got ", scm_k);
return SCM_VECTOR_REF(vec, scm_k);
}
@@ -1554,9 +1567,9 @@
ScmObj ScmOp_vector_set(ScmObj vec, ScmObj scm_k, ScmObj obj)
{
if (!SCM_VECTORP(vec))
- SigScm_Error("vector-set! : vector required\n");
+ SigScm_ErrorObj("vector-set! : vector required but got ", vec);
if (!SCM_INTP(scm_k))
- SigScm_Error("vector-set! : int required\n");
+ SigScm_ErrorObj("vector-set! : number required but got ", scm_k);
SCM_SETVECTOR_REF(vec, scm_k, obj);
@@ -1573,7 +1586,7 @@
int i = 0;
if (!SCM_VECTORP(vec))
- SigScm_Error("vector->list : vector required\n");
+ SigScm_ErrorObj("vector->list : vector required but got ", vec);
v = SCM_VECTOR_VEC(vec);
c_len = SCM_VECTOR_LEN(vec);
@@ -1604,7 +1617,7 @@
/* TOOD : canbe optimized. scanning list many times */
if (EQ(ScmOp_listp(list), SCM_FALSE))
- SigScm_Error("list->vector : list required\n");
+ SigScm_ErrorObj("list->vector : list required but got ", list);
scm_len = ScmOp_length(list);
c_len = SCM_INT_VALUE(scm_len);
@@ -1623,7 +1636,7 @@
int i = 0;
if (!SCM_VECTORP(vec))
- SigScm_Error("vector->list : vector required\n");
+ SigScm_ErrorObj("vector->list : vector required but got ", vec);
c_len = SCM_VECTOR_LEN(vec);
for (i = 0; i < c_len; i++) {
Modified: branches/r5rs/sigscheme/read.c
===================================================================
--- branches/r5rs/sigscheme/read.c 2005-07-18 19:48:58 UTC (rev 975)
+++ branches/r5rs/sigscheme/read.c 2005-07-18 21:17:38 UTC (rev 976)
@@ -92,7 +92,7 @@
ScmObj SigScm_Read(ScmObj port)
{
if (!SCM_PORTP(port))
- SigScm_Error("invalid port\n");
+ SigScm_ErrorObj("SigScm_Read : port required but got ", port);
return read_sexpression(port);
}
@@ -100,7 +100,7 @@
ScmObj SigScm_Read_Char(ScmObj port)
{
if (!SCM_PORTP(port))
- SigScm_Error("invalid port\n");
+ SigScm_ErrorObj("SigScm_Read_Char : port required but got ", port);
return read_char(port);
}
@@ -163,7 +163,7 @@
{
SCM_PORT_GETC(port, c1);
if (c1 == EOF) {
- SigScm_Error("eof in unquote\n");
+ SigScm_Error("EOF in unquote\n");
} else if (c1 == '@') {
return read_quote(port, SCM_UNQUOTE_SPLICING);
} else {
Modified: branches/r5rs/sigscheme/sigscheme.h
===================================================================
--- branches/r5rs/sigscheme/sigscheme.h 2005-07-18 19:48:58 UTC (rev 975)
+++ branches/r5rs/sigscheme/sigscheme.h 2005-07-18 21:17:38 UTC (rev 976)
@@ -296,6 +296,7 @@
/* error.c */
void SigScm_Error(const char *msg);
+void SigScm_ErrorObj(const char *msg, ScmObj obj);
/* debug.c */
void SigScm_Display(ScmObj obj);
More information about the uim-commit
mailing list