mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-02 21:10:27 +02:00
Code Activity

* Removed unused object parameter from SCM_ASSYNT.

Browse source
This commit is contained in:
Dirk Herrmann 2001-03-15 09:50:20 +00:00
parent 80dee77b86
commit 160bb34a53
5 changed files with 76 additions and 72 deletions
Download patch file Download diff file Expand all files Collapse all files

16
libguile/ChangeLog
View file

@ -1,3 +1,19 @@
2001-03-15 Dirk Herrmann <D.Herrmann@tu-bs.de>
* macros.h (SCM_ASSYNT): Removed unused object argument from
signature.
* eval.c (scm_m_body, scm_m_quote, scm_m_begin, scm_m_if,
scm_m_set_x, scm_m_and, scm_m_or, scm_m_case, scm_m_cond,
scm_m_letstar, scm_m_do, scm_m_quasiquote, scm_m_delay,
scm_m_define, scm_m_letrec1, scm_m_letrec, scm_m_let, scm_m_apply,
scm_m_cont, scm_m_nil_cond, scm_m_nil_ify, scm_m_t_ify,
scm_m_0_cond, scm_m_0_ify, scm_m_1_ify, scm_m_atfop, scm_m_atbind,
scm_m_expand_body), evalext.c (scm_m_generalized_set_x,
scm_m_undefine), goops.c (scm_m_atslot_ref, scm_m_atslot_set_x,
scm_m_atdispatch): Removed unused object argument from call to
SCM_ASSYNT.
2001-03-15 Dirk Herrmann <D.Herrmann@tu-bs.de> 2001-03-15 Dirk Herrmann <D.Herrmann@tu-bs.de>
* gh.h/gh_data.c (gh_ints2scm): Changed the signature to use a * gh.h/gh_data.c (gh_ints2scm): Changed the signature to use a

114
libguile/eval.c
View file

@ -482,7 +482,7 @@ SCM_GLOBAL_SYMBOL (scm_sym_trace, "trace");
static SCM static SCM
scm_m_body (SCM op, SCM xorig, const char *what) scm_m_body (SCM op, SCM xorig, const char *what)
{ {
SCM_ASSYNT (scm_ilength (xorig) >= 1, xorig, scm_s_expression, what); SCM_ASSYNT (scm_ilength (xorig) >= 1, scm_s_expression, what);
/* Don't add another ISYM if one is present already. */ /* Don't add another ISYM if one is present already. */
if (SCM_ISYMP (SCM_CAR (xorig))) if (SCM_ISYMP (SCM_CAR (xorig)))
@ -508,8 +508,7 @@ scm_m_quote (SCM xorig, SCM env)
{ {
SCM x = scm_copy_tree (SCM_CDR (xorig)); SCM x = scm_copy_tree (SCM_CDR (xorig));
SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) == 1, SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) == 1, scm_s_expression, s_quote);
xorig, scm_s_expression, s_quote);
return scm_cons (SCM_IM_QUOTE, x); return scm_cons (SCM_IM_QUOTE, x);
} }
@ -521,8 +520,7 @@ SCM_GLOBAL_SYMBOL(scm_sym_begin, s_begin);
SCM SCM
scm_m_begin (SCM xorig, SCM env) scm_m_begin (SCM xorig, SCM env)
{ {
SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) >= 1, SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) >= 1, scm_s_expression, s_begin);
xorig, scm_s_expression, s_begin);
return scm_cons (SCM_IM_BEGIN, SCM_CDR (xorig)); return scm_cons (SCM_IM_BEGIN, SCM_CDR (xorig));
} }
@ -533,7 +531,7 @@ SCM
scm_m_if (SCM xorig, SCM env) scm_m_if (SCM xorig, SCM env)
{ {
int len = scm_ilength (SCM_CDR (xorig)); int len = scm_ilength (SCM_CDR (xorig));
SCM_ASSYNT (len >= 2 && len <= 3, xorig, scm_s_expression, "if"); SCM_ASSYNT (len >= 2 && len <= 3, scm_s_expression, "if");
return scm_cons (SCM_IM_IF, SCM_CDR (xorig)); return scm_cons (SCM_IM_IF, SCM_CDR (xorig));
} }
@ -547,9 +545,8 @@ SCM
scm_m_set_x (SCM xorig, SCM env) scm_m_set_x (SCM xorig, SCM env)
{ {
SCM x = SCM_CDR (xorig); SCM x = SCM_CDR (xorig);
SCM_ASSYNT (2 == scm_ilength (x), xorig, scm_s_expression, scm_s_set_x); SCM_ASSYNT (2 == scm_ilength (x), scm_s_expression, scm_s_set_x);
SCM_ASSYNT (SCM_SYMBOLP (SCM_CAR (x)), SCM_ASSYNT (SCM_SYMBOLP (SCM_CAR (x)), scm_s_variable, scm_s_set_x);
xorig, scm_s_variable, scm_s_set_x);
return scm_cons (SCM_IM_SET_X, x); return scm_cons (SCM_IM_SET_X, x);
} }
@ -561,7 +558,7 @@ SCM
scm_m_and (SCM xorig, SCM env) scm_m_and (SCM xorig, SCM env)
{ {
int len = scm_ilength (SCM_CDR (xorig)); int len = scm_ilength (SCM_CDR (xorig));
SCM_ASSYNT (len >= 0, xorig, scm_s_test, s_and); SCM_ASSYNT (len >= 0, scm_s_test, s_and);
if (len >= 1) if (len >= 1)
return scm_cons (SCM_IM_AND, SCM_CDR (xorig)); return scm_cons (SCM_IM_AND, SCM_CDR (xorig));
else else
@ -575,7 +572,7 @@ SCM
scm_m_or (SCM xorig, SCM env) scm_m_or (SCM xorig, SCM env)
{ {
int len = scm_ilength (SCM_CDR (xorig)); int len = scm_ilength (SCM_CDR (xorig));
SCM_ASSYNT (len >= 0, xorig, scm_s_test, s_or); SCM_ASSYNT (len >= 0, scm_s_test, s_or);
if (len >= 1) if (len >= 1)
return scm_cons (SCM_IM_OR, SCM_CDR (xorig)); return scm_cons (SCM_IM_OR, SCM_CDR (xorig));
else else
@ -590,15 +587,15 @@ SCM
scm_m_case (SCM xorig, SCM env) scm_m_case (SCM xorig, SCM env)
{ {
SCM proc, cdrx = scm_list_copy (SCM_CDR (xorig)), x = cdrx; SCM proc, cdrx = scm_list_copy (SCM_CDR (xorig)), x = cdrx;
SCM_ASSYNT (scm_ilength (x) >= 2, xorig, scm_s_clauses, s_case); SCM_ASSYNT (scm_ilength (x) >= 2, scm_s_clauses, s_case);
while (SCM_NIMP (x = SCM_CDR (x))) while (SCM_NIMP (x = SCM_CDR (x)))
{ {
proc = SCM_CAR (x); proc = SCM_CAR (x);
SCM_ASSYNT (scm_ilength (proc) >= 2, xorig, scm_s_clauses, s_case); SCM_ASSYNT (scm_ilength (proc) >= 2, scm_s_clauses, s_case);
SCM_ASSYNT (scm_ilength (SCM_CAR (proc)) >= 0 SCM_ASSYNT (scm_ilength (SCM_CAR (proc)) >= 0
|| (SCM_EQ_P (scm_sym_else, SCM_CAR (proc)) || (SCM_EQ_P (scm_sym_else, SCM_CAR (proc))
&& SCM_NULLP (SCM_CDR (x))), && SCM_NULLP (SCM_CDR (x))),
xorig, scm_s_clauses, s_case); scm_s_clauses, s_case);
} }
return scm_cons (SCM_IM_CASE, cdrx); return scm_cons (SCM_IM_CASE, cdrx);
} }
@ -613,21 +610,21 @@ scm_m_cond (SCM xorig, SCM env)
{ {
SCM arg1, cdrx = scm_list_copy (SCM_CDR (xorig)), x = cdrx; SCM arg1, cdrx = scm_list_copy (SCM_CDR (xorig)), x = cdrx;
int len = scm_ilength (x); int len = scm_ilength (x);
SCM_ASSYNT (len >= 1, xorig, scm_s_clauses, s_cond); SCM_ASSYNT (len >= 1, scm_s_clauses, s_cond);
while (SCM_NIMP (x)) while (SCM_NIMP (x))
{ {
arg1 = SCM_CAR (x); arg1 = SCM_CAR (x);
len = scm_ilength (arg1); len = scm_ilength (arg1);
SCM_ASSYNT (len >= 1, xorig, scm_s_clauses, s_cond); SCM_ASSYNT (len >= 1, scm_s_clauses, s_cond);
if (SCM_EQ_P (scm_sym_else, SCM_CAR (arg1))) if (SCM_EQ_P (scm_sym_else, SCM_CAR (arg1)))
{ {
SCM_ASSYNT (SCM_NULLP (SCM_CDR (x)) && len >= 2, SCM_ASSYNT (SCM_NULLP (SCM_CDR (x)) && len >= 2,
xorig, "bad ELSE clause", s_cond); "bad ELSE clause", s_cond);
SCM_SETCAR (arg1, SCM_BOOL_T); SCM_SETCAR (arg1, SCM_BOOL_T);
} }
if (len >= 2 && SCM_EQ_P (scm_sym_arrow, SCM_CAR (SCM_CDR (arg1)))) if (len >= 2 && SCM_EQ_P (scm_sym_arrow, SCM_CAR (SCM_CDR (arg1))))
SCM_ASSYNT (3 == len && SCM_NIMP (SCM_CAR (SCM_CDR (SCM_CDR (arg1)))), SCM_ASSYNT (3 == len && SCM_NIMP (SCM_CAR (SCM_CDR (SCM_CDR (arg1)))),
xorig, "bad recipient", s_cond); "bad recipient", s_cond);
x = SCM_CDR (x); x = SCM_CDR (x);
} }
return scm_cons (SCM_IM_COND, cdrx); return scm_cons (SCM_IM_COND, cdrx);
@ -703,14 +700,14 @@ scm_m_letstar (SCM xorig, SCM env)
{ {
SCM x = SCM_CDR (xorig), arg1, proc, vars = SCM_EOL, *varloc = &vars; SCM x = SCM_CDR (xorig), arg1, proc, vars = SCM_EOL, *varloc = &vars;
int len = scm_ilength (x); int len = scm_ilength (x);
SCM_ASSYNT (len >= 2, xorig, scm_s_body, s_letstar); SCM_ASSYNT (len >= 2, scm_s_body, s_letstar);
proc = SCM_CAR (x); proc = SCM_CAR (x);
SCM_ASSYNT (scm_ilength (proc) >= 0, xorig, scm_s_bindings, s_letstar); SCM_ASSYNT (scm_ilength (proc) >= 0, scm_s_bindings, s_letstar);
while (SCM_NIMP (proc)) while (SCM_NIMP (proc))
{ {
arg1 = SCM_CAR (proc); arg1 = SCM_CAR (proc);
SCM_ASSYNT (2 == scm_ilength (arg1), xorig, scm_s_bindings, s_letstar); SCM_ASSYNT (2 == scm_ilength (arg1), scm_s_bindings, s_letstar);
SCM_ASSYNT (SCM_SYMBOLP (SCM_CAR (arg1)), xorig, scm_s_variable, s_letstar); SCM_ASSYNT (SCM_SYMBOLP (SCM_CAR (arg1)), scm_s_variable, s_letstar);
*varloc = scm_cons2 (SCM_CAR (arg1), SCM_CAR (SCM_CDR (arg1)), SCM_EOL); *varloc = scm_cons2 (SCM_CAR (arg1), SCM_CAR (SCM_CDR (arg1)), SCM_EOL);
varloc = SCM_CDRLOC (SCM_CDR (*varloc)); varloc = SCM_CDRLOC (SCM_CDR (*varloc));
proc = SCM_CDR (proc); proc = SCM_CDR (proc);
@ -745,15 +742,15 @@ scm_m_do (SCM xorig, SCM env)
SCM vars = SCM_EOL, inits = SCM_EOL, steps = SCM_EOL; SCM vars = SCM_EOL, inits = SCM_EOL, steps = SCM_EOL;
SCM *initloc = &inits, *steploc = &steps; SCM *initloc = &inits, *steploc = &steps;
int len = scm_ilength (x); int len = scm_ilength (x);
SCM_ASSYNT (len >= 2, xorig, scm_s_test, "do"); SCM_ASSYNT (len >= 2, scm_s_test, "do");
proc = SCM_CAR (x); proc = SCM_CAR (x);
SCM_ASSYNT (scm_ilength (proc) >= 0, xorig, scm_s_bindings, "do"); SCM_ASSYNT (scm_ilength (proc) >= 0, scm_s_bindings, "do");
while (SCM_NIMP(proc)) while (SCM_NIMP(proc))
{ {
arg1 = SCM_CAR (proc); arg1 = SCM_CAR (proc);
len = scm_ilength (arg1); len = scm_ilength (arg1);
SCM_ASSYNT (2 == len || 3 == len, xorig, scm_s_bindings, "do"); SCM_ASSYNT (2 == len || 3 == len, scm_s_bindings, "do");
SCM_ASSYNT (SCM_SYMBOLP (SCM_CAR (arg1)), xorig, scm_s_variable, "do"); SCM_ASSYNT (SCM_SYMBOLP (SCM_CAR (arg1)), scm_s_variable, "do");
/* vars reversed here, inits and steps reversed at evaluation */ /* vars reversed here, inits and steps reversed at evaluation */
vars = scm_cons (SCM_CAR (arg1), vars); /* variable */ vars = scm_cons (SCM_CAR (arg1), vars); /* variable */
arg1 = SCM_CDR (arg1); arg1 = SCM_CDR (arg1);
@ -765,7 +762,7 @@ scm_m_do (SCM xorig, SCM env)
proc = SCM_CDR (proc); proc = SCM_CDR (proc);
} }
x = SCM_CDR (x); x = SCM_CDR (x);
SCM_ASSYNT (scm_ilength (SCM_CAR (x)) >= 1, xorig, scm_s_test, "do"); SCM_ASSYNT (scm_ilength (SCM_CAR (x)) >= 1, scm_s_test, "do");
x = scm_cons2 (SCM_CAR (x), SCM_CDR (x), steps); x = scm_cons2 (SCM_CAR (x), SCM_CDR (x), steps);
x = scm_cons2 (vars, inits, x); x = scm_cons2 (vars, inits, x);
return scm_cons (SCM_IM_DO, x); return scm_cons (SCM_IM_DO, x);
@ -786,7 +783,7 @@ SCM
scm_m_quasiquote (SCM xorig, SCM env) scm_m_quasiquote (SCM xorig, SCM env)
{ {
SCM x = SCM_CDR (xorig); SCM x = SCM_CDR (xorig);
SCM_ASSYNT (scm_ilength (x) == 1, xorig, scm_s_expression, s_quasiquote); SCM_ASSYNT (scm_ilength (x) == 1, scm_s_expression, s_quasiquote);
return iqq (SCM_CAR (x), env, 1); return iqq (SCM_CAR (x), env, 1);
} }
@ -843,7 +840,7 @@ SCM_GLOBAL_SYMBOL (scm_sym_delay, s_delay);
SCM SCM
scm_m_delay (SCM xorig, SCM env) scm_m_delay (SCM xorig, SCM env)
{ {
SCM_ASSYNT (scm_ilength (xorig) == 2, xorig, scm_s_expression, s_delay); SCM_ASSYNT (scm_ilength (xorig) == 2, scm_s_expression, s_delay);
return scm_cons2 (SCM_IM_DELAY, SCM_EOL, SCM_CDR (xorig)); return scm_cons2 (SCM_IM_DELAY, SCM_EOL, SCM_CDR (xorig));
} }
@ -856,7 +853,7 @@ scm_m_define (SCM x, SCM env)
{ {
SCM proc, arg1 = x; SCM proc, arg1 = x;
x = SCM_CDR (x); x = SCM_CDR (x);
SCM_ASSYNT (scm_ilength (x) >= 2, arg1, scm_s_expression, s_define); SCM_ASSYNT (scm_ilength (x) >= 2, scm_s_expression, s_define);
proc = SCM_CAR (x); proc = SCM_CAR (x);
x = SCM_CDR (x); x = SCM_CDR (x);
while (SCM_CONSP (proc)) while (SCM_CONSP (proc))
@ -864,9 +861,8 @@ scm_m_define (SCM x, SCM env)
x = scm_cons (scm_cons2 (scm_sym_lambda, SCM_CDR (proc), x), SCM_EOL); x = scm_cons (scm_cons2 (scm_sym_lambda, SCM_CDR (proc), x), SCM_EOL);
proc = SCM_CAR (proc); proc = SCM_CAR (proc);
} }
SCM_ASSYNT (SCM_SYMBOLP (proc), SCM_ASSYNT (SCM_SYMBOLP (proc), scm_s_variable, s_define);
arg1, scm_s_variable, s_define); SCM_ASSYNT (1 == scm_ilength (x), scm_s_expression, s_define);
SCM_ASSYNT (1 == scm_ilength (x), arg1, scm_s_expression, s_define);
if (SCM_TOP_LEVEL (env)) if (SCM_TOP_LEVEL (env))
{ {
x = evalcar (x, env); x = evalcar (x, env);
@ -909,13 +905,13 @@ scm_m_letrec1 (SCM op, SCM imm, SCM xorig, SCM env)
SCM vars = SCM_EOL, inits = SCM_EOL, *initloc = &inits; SCM vars = SCM_EOL, inits = SCM_EOL, *initloc = &inits;
proc = SCM_CAR (x); proc = SCM_CAR (x);
SCM_ASSYNT (scm_ilength (proc) >= 1, xorig, scm_s_bindings, what); SCM_ASSYNT (scm_ilength (proc) >= 1, scm_s_bindings, what);
do do
{ {
/* vars scm_list reversed here, inits reversed at evaluation */ /* vars scm_list reversed here, inits reversed at evaluation */
arg1 = SCM_CAR (proc); arg1 = SCM_CAR (proc);
SCM_ASSYNT (2 == scm_ilength (arg1), xorig, scm_s_bindings, what); SCM_ASSYNT (2 == scm_ilength (arg1), scm_s_bindings, what);
SCM_ASSYNT (SCM_SYMBOLP (SCM_CAR (arg1)), xorig, scm_s_variable, what); SCM_ASSYNT (SCM_SYMBOLP (SCM_CAR (arg1)), scm_s_variable, what);
if (scm_c_improper_memq (SCM_CAR (arg1), vars)) if (scm_c_improper_memq (SCM_CAR (arg1), vars))
scm_misc_error (what, scm_s_duplicate_bindings, SCM_EOL); scm_misc_error (what, scm_s_duplicate_bindings, SCM_EOL);
vars = scm_cons (SCM_CAR (arg1), vars); vars = scm_cons (SCM_CAR (arg1), vars);
@ -935,7 +931,7 @@ SCM
scm_m_letrec (SCM xorig, SCM env) scm_m_letrec (SCM xorig, SCM env)
{ {
SCM x = SCM_CDR (xorig); SCM x = SCM_CDR (xorig);
SCM_ASSYNT (scm_ilength (x) >= 2, xorig, scm_s_body, s_letrec); SCM_ASSYNT (scm_ilength (x) >= 2, scm_s_body, s_letrec);
if (SCM_NULLP (SCM_CAR (x))) /* null binding, let* faster */ if (SCM_NULLP (SCM_CAR (x))) /* null binding, let* faster */
return scm_m_letstar (scm_cons2 (SCM_CAR (xorig), SCM_EOL, return scm_m_letstar (scm_cons2 (SCM_CAR (xorig), SCM_EOL,
@ -957,7 +953,7 @@ scm_m_let (SCM xorig, SCM env)
SCM x = cdrx, proc, arg1, name; /* structure traversers */ SCM x = cdrx, proc, arg1, name; /* structure traversers */
SCM vars = SCM_EOL, inits = SCM_EOL, *varloc = &vars, *initloc = &inits; SCM vars = SCM_EOL, inits = SCM_EOL, *varloc = &vars, *initloc = &inits;
SCM_ASSYNT (scm_ilength (x) >= 2, xorig, scm_s_body, s_let); SCM_ASSYNT (scm_ilength (x) >= 2, scm_s_body, s_let);
proc = SCM_CAR (x); proc = SCM_CAR (x);
if (SCM_NULLP (proc) if (SCM_NULLP (proc)
|| (SCM_CONSP (proc) || (SCM_CONSP (proc)
@ -971,7 +967,7 @@ scm_m_let (SCM xorig, SCM env)
env); env);
} }
SCM_ASSYNT (SCM_NIMP (proc), xorig, scm_s_bindings, s_let); SCM_ASSYNT (SCM_NIMP (proc), scm_s_bindings, s_let);
if (SCM_CONSP (proc)) if (SCM_CONSP (proc))
{ {
/* plain let, proc is <bindings> */ /* plain let, proc is <bindings> */
@ -982,15 +978,14 @@ scm_m_let (SCM xorig, SCM env)
scm_misc_error (s_let, scm_s_bindings, SCM_EOL); /* bad let */ scm_misc_error (s_let, scm_s_bindings, SCM_EOL); /* bad let */
name = proc; /* named let, build equiv letrec */ name = proc; /* named let, build equiv letrec */
x = SCM_CDR (x); x = SCM_CDR (x);
SCM_ASSYNT (scm_ilength (x) >= 2, xorig, scm_s_body, s_let); SCM_ASSYNT (scm_ilength (x) >= 2, scm_s_body, s_let);
proc = SCM_CAR (x); /* bindings list */ proc = SCM_CAR (x); /* bindings list */
SCM_ASSYNT (scm_ilength (proc) >= 0, xorig, scm_s_bindings, s_let); SCM_ASSYNT (scm_ilength (proc) >= 0, scm_s_bindings, s_let);
while (SCM_NIMP (proc)) while (SCM_NIMP (proc))
{ /* vars and inits both in order */ { /* vars and inits both in order */
arg1 = SCM_CAR (proc); arg1 = SCM_CAR (proc);
SCM_ASSYNT (2 == scm_ilength (arg1), xorig, scm_s_bindings, s_let); SCM_ASSYNT (2 == scm_ilength (arg1), scm_s_bindings, s_let);
SCM_ASSYNT (SCM_SYMBOLP (SCM_CAR (arg1)), SCM_ASSYNT (SCM_SYMBOLP (SCM_CAR (arg1)), scm_s_variable, s_let);
xorig, scm_s_variable, s_let);
*varloc = scm_cons (SCM_CAR (arg1), SCM_EOL); *varloc = scm_cons (SCM_CAR (arg1), SCM_EOL);
varloc = SCM_CDRLOC (*varloc); varloc = SCM_CDRLOC (*varloc);
*initloc = scm_cons (SCM_CAR (SCM_CDR (arg1)), SCM_EOL); *initloc = scm_cons (SCM_CAR (SCM_CDR (arg1)), SCM_EOL);
@ -1014,8 +1009,7 @@ SCM_GLOBAL_SYMBOL (scm_sym_apply, s_atapply + 1);
SCM SCM
scm_m_apply (SCM xorig, SCM env) scm_m_apply (SCM xorig, SCM env)
{ {
SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) == 2, SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) == 2, scm_s_expression, s_atapply);
xorig, scm_s_expression, s_atapply);
return scm_cons (SCM_IM_APPLY, SCM_CDR (xorig)); return scm_cons (SCM_IM_APPLY, SCM_CDR (xorig));
} }
@ -1028,7 +1022,7 @@ SCM
scm_m_cont (SCM xorig, SCM env) scm_m_cont (SCM xorig, SCM env)
{ {
SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) == 1, SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) == 1,
xorig, scm_s_expression, s_atcall_cc); scm_s_expression, s_atcall_cc);
return scm_cons (SCM_IM_CONT, SCM_CDR (xorig)); return scm_cons (SCM_IM_CONT, SCM_CDR (xorig));
} }
@ -1043,8 +1037,7 @@ SCM
scm_m_nil_cond (SCM xorig, SCM env) scm_m_nil_cond (SCM xorig, SCM env)
{ {
int len = scm_ilength (SCM_CDR (xorig)); int len = scm_ilength (SCM_CDR (xorig));
SCM_ASSYNT (len >= 1 && (len & 1) == 1, xorig, SCM_ASSYNT (len >= 1 && (len & 1) == 1, scm_s_expression, "nil-cond");
scm_s_expression, "nil-cond");
return scm_cons (SCM_IM_NIL_COND, SCM_CDR (xorig)); return scm_cons (SCM_IM_NIL_COND, SCM_CDR (xorig));
} }
@ -1053,8 +1046,7 @@ SCM_SYNTAX (s_nil_ify, "nil-ify", scm_makmmacro, scm_m_nil_ify);
SCM SCM
scm_m_nil_ify (SCM xorig, SCM env) scm_m_nil_ify (SCM xorig, SCM env)
{ {
SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) == 1, SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) == 1, scm_s_expression, "nil-ify");
xorig, scm_s_expression, "nil-ify");
return scm_cons (SCM_IM_NIL_IFY, SCM_CDR (xorig)); return scm_cons (SCM_IM_NIL_IFY, SCM_CDR (xorig));
} }
@ -1063,8 +1055,7 @@ SCM_SYNTAX (s_t_ify, "t-ify", scm_makmmacro, scm_m_t_ify);
SCM SCM
scm_m_t_ify (SCM xorig, SCM env) scm_m_t_ify (SCM xorig, SCM env)
{ {
SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) == 1, SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) == 1, scm_s_expression, "t-ify");
xorig, scm_s_expression, "t-ify");
return scm_cons (SCM_IM_T_IFY, SCM_CDR (xorig)); return scm_cons (SCM_IM_T_IFY, SCM_CDR (xorig));
} }
@ -1074,8 +1065,7 @@ SCM
scm_m_0_cond (SCM xorig, SCM env) scm_m_0_cond (SCM xorig, SCM env)
{ {
int len = scm_ilength (SCM_CDR (xorig)); int len = scm_ilength (SCM_CDR (xorig));
SCM_ASSYNT (len >= 1 && (len & 1) == 1, xorig, SCM_ASSYNT (len >= 1 && (len & 1) == 1, scm_s_expression, "0-cond");
scm_s_expression, "0-cond");
return scm_cons (SCM_IM_0_COND, SCM_CDR (xorig)); return scm_cons (SCM_IM_0_COND, SCM_CDR (xorig));
} }
@ -1084,8 +1074,7 @@ SCM_SYNTAX (s_0_ify, "0-ify", scm_makmmacro, scm_m_0_ify);
SCM SCM
scm_m_0_ify (SCM xorig, SCM env) scm_m_0_ify (SCM xorig, SCM env)
{ {
SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) == 1, SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) == 1, scm_s_expression, "0-ify");
xorig, scm_s_expression, "0-ify");
return scm_cons (SCM_IM_0_IFY, SCM_CDR (xorig)); return scm_cons (SCM_IM_0_IFY, SCM_CDR (xorig));
} }
@ -1094,8 +1083,7 @@ SCM_SYNTAX (s_1_ify, "1-ify", scm_makmmacro, scm_m_1_ify);
SCM SCM
scm_m_1_ify (SCM xorig, SCM env) scm_m_1_ify (SCM xorig, SCM env)
{ {
SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) == 1, SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) == 1, scm_s_expression, "1-ify");
xorig, scm_s_expression, "1-ify");
return scm_cons (SCM_IM_1_IFY, SCM_CDR (xorig)); return scm_cons (SCM_IM_1_IFY, SCM_CDR (xorig));
} }
@ -1105,9 +1093,9 @@ SCM
scm_m_atfop (SCM xorig, SCM env) scm_m_atfop (SCM xorig, SCM env)
{ {
SCM x = SCM_CDR (xorig), vcell; SCM x = SCM_CDR (xorig), vcell;
SCM_ASSYNT (scm_ilength (x) >= 1, xorig, scm_s_expression, "@fop"); SCM_ASSYNT (scm_ilength (x) >= 1, scm_s_expression, "@fop");
vcell = scm_symbol_fref (SCM_CAR (x)); vcell = scm_symbol_fref (SCM_CAR (x));
SCM_ASSYNT (SCM_CONSP (vcell), x, SCM_ASSYNT (SCM_CONSP (vcell),
"Symbol's function definition is void", NULL); "Symbol's function definition is void", NULL);
SCM_SET_CELL_WORD_0 (x, SCM_UNPACK (vcell) + scm_tc3_cons_gloc); SCM_SET_CELL_WORD_0 (x, SCM_UNPACK (vcell) + scm_tc3_cons_gloc);
return x; return x;
@ -1119,7 +1107,7 @@ SCM
scm_m_atbind (SCM xorig, SCM env) scm_m_atbind (SCM xorig, SCM env)
{ {
SCM x = SCM_CDR (xorig); SCM x = SCM_CDR (xorig);
SCM_ASSYNT (scm_ilength (x) > 1, xorig, scm_s_expression, "@bind"); SCM_ASSYNT (scm_ilength (x) > 1, scm_s_expression, "@bind");
if (SCM_IMP (env)) if (SCM_IMP (env))
env = SCM_BOOL_F; env = SCM_BOOL_F;
@ -1182,7 +1170,7 @@ scm_m_expand_body (SCM xorig, SCM env)
} }
} }
SCM_ASSYNT (SCM_NIMP (x), SCM_CDR (xorig), scm_s_body, what); SCM_ASSYNT (SCM_NIMP (x), scm_s_body, what);
if (SCM_NIMP (defs)) if (SCM_NIMP (defs))
{ {
x = scm_cons (scm_m_letrec1 (SCM_IM_LETREC, x = scm_cons (scm_m_letrec1 (SCM_IM_LETREC,

10
libguile/evalext.c
View file

@ -59,7 +59,7 @@ SCM
scm_m_generalized_set_x (SCM xorig, SCM env) scm_m_generalized_set_x (SCM xorig, SCM env)
{ {
SCM x = SCM_CDR (xorig); SCM x = SCM_CDR (xorig);
SCM_ASSYNT (2 == scm_ilength (x), xorig, scm_s_expression, scm_s_set_x); SCM_ASSYNT (2 == scm_ilength (x), scm_s_expression, scm_s_set_x);
if (SCM_SYMBOLP (SCM_CAR (x))) if (SCM_SYMBOLP (SCM_CAR (x)))
return scm_cons (SCM_IM_SET_X, x); return scm_cons (SCM_IM_SET_X, x);
else if (SCM_CONSP (SCM_CAR (x))) else if (SCM_CONSP (SCM_CAR (x)))
@ -127,14 +127,14 @@ scm_m_undefine (SCM x, SCM env)
{ {
SCM arg1 = x; SCM arg1 = x;
x = SCM_CDR (x); x = SCM_CDR (x);
SCM_ASSYNT (SCM_TOP_LEVEL (env), arg1, "bad placement ", s_undefine); SCM_ASSYNT (SCM_TOP_LEVEL (env), "bad placement ", s_undefine);
SCM_ASSYNT (SCM_CONSP (x) && SCM_NULLP (SCM_CDR (x)), SCM_ASSYNT (SCM_CONSP (x) && SCM_NULLP (SCM_CDR (x)),
arg1, scm_s_expression, s_undefine); scm_s_expression, s_undefine);
x = SCM_CAR (x); x = SCM_CAR (x);
SCM_ASSYNT (SCM_SYMBOLP (x), arg1, scm_s_variable, s_undefine); SCM_ASSYNT (SCM_SYMBOLP (x), scm_s_variable, s_undefine);
arg1 = scm_sym2vcell (x, scm_env_top_level (env), SCM_BOOL_F); arg1 = scm_sym2vcell (x, scm_env_top_level (env), SCM_BOOL_F);
SCM_ASSYNT (SCM_NFALSEP (arg1) && !SCM_UNBNDP (SCM_CDR (arg1)), SCM_ASSYNT (SCM_NFALSEP (arg1) && !SCM_UNBNDP (SCM_CDR (arg1)),
x, "variable already unbound ", s_undefine); "variable already unbound ", s_undefine);
SCM_SETCDR (arg1, SCM_UNDEFINED); SCM_SETCDR (arg1, SCM_UNDEFINED);
#ifdef SICP #ifdef SICP
return SCM_CAR (arg1); return SCM_CAR (arg1);

6
libguile/goops.c
View file

@ -1869,7 +1869,7 @@ scm_m_atslot_ref (SCM xorig, SCM env)
#define FUNC_NAME s_atslot_ref #define FUNC_NAME s_atslot_ref
{ {
SCM x = SCM_CDR (xorig); SCM x = SCM_CDR (xorig);
SCM_ASSYNT (scm_ilength (x) == 2, xorig, scm_s_expression, FUNC_NAME); SCM_ASSYNT (scm_ilength (x) == 2, scm_s_expression, FUNC_NAME);
SCM_VALIDATE_INUM (SCM_ARG2, SCM_CADR (x)); SCM_VALIDATE_INUM (SCM_ARG2, SCM_CADR (x));
return scm_cons (SCM_IM_SLOT_REF, x); return scm_cons (SCM_IM_SLOT_REF, x);
} }
@ -1883,7 +1883,7 @@ scm_m_atslot_set_x (SCM xorig, SCM env)
#define FUNC_NAME s_atslot_set_x #define FUNC_NAME s_atslot_set_x
{ {
SCM x = SCM_CDR (xorig); SCM x = SCM_CDR (xorig);
SCM_ASSYNT (scm_ilength (x) == 3, xorig, scm_s_expression, FUNC_NAME); SCM_ASSYNT (scm_ilength (x) == 3, scm_s_expression, FUNC_NAME);
SCM_VALIDATE_INUM (SCM_ARG2, SCM_CADR (x)); SCM_VALIDATE_INUM (SCM_ARG2, SCM_CADR (x));
return scm_cons (SCM_IM_SLOT_SET_X, x); return scm_cons (SCM_IM_SLOT_SET_X, x);
} }
@ -1899,7 +1899,7 @@ scm_m_atdispatch (SCM xorig, SCM env)
#define FUNC_NAME s_atdispatch #define FUNC_NAME s_atdispatch
{ {
SCM args, n, v, gf, x = SCM_CDR (xorig); SCM args, n, v, gf, x = SCM_CDR (xorig);
SCM_ASSYNT (scm_ilength (x) == 4, xorig, scm_s_expression, FUNC_NAME); SCM_ASSYNT (scm_ilength (x) == 4, scm_s_expression, FUNC_NAME);
args = SCM_CAR (x); args = SCM_CAR (x);
if (!SCM_CONSP (args) && !SCM_SYMBOLP (args)) if (!SCM_CONSP (args) && !SCM_SYMBOLP (args))
SCM_WRONG_TYPE_ARG (SCM_ARG1, args); SCM_WRONG_TYPE_ARG (SCM_ARG1, args);

2
libguile/macros.h
View file

@ -48,7 +48,7 @@
#define SCM_ASSYNT(_cond, _arg, _msg, _subr) \ #define SCM_ASSYNT(_cond, _msg, _subr) \
if (!(_cond)) scm_misc_error (_subr, _msg, SCM_EOL); if (!(_cond)) scm_misc_error (_subr, _msg, SCM_EOL);
extern scm_bits_t scm_tc16_macro; extern scm_bits_t scm_tc16_macro;