mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-09 23:40:29 +02:00
Code Activity

* Minor changes.

Browse source
This commit is contained in:
Dirk Herrmann 2001-07-30 18:55:50 +00:00
parent 6cf695375f
commit 01f11e027e
2 changed files with 46 additions and 37 deletions
Download patch file Download diff file Expand all files Collapse all files

12
libguile/ChangeLog
View file

@ -1,3 +1,15 @@
2001-07-30 Dirk Herrmann <D.Herrmann@tu-bs.de>
* eval.c (scm_lookupcar, scm_m_body, scm_m_lambda, unmemocopy,
scm_unmemocopy, scm_badargsp, scm_eval_body, CHECK_EQVISH,
SCM_CEVAL, scm_nconc2last, SCM_APPLY, scm_copy_tree): Prefer
!SCM_<pred> over SCM_N<pred>.
(scm_eval_body): Remove side effecting code from macro call.
(SCM_CEVAL, SCM_APPLY): Remove goto statement and redundant
SCM_NIMP test.
2001-07-30 Dirk Herrmann <D.Herrmann@tu-bs.de> 2001-07-30 Dirk Herrmann <D.Herrmann@tu-bs.de>
* pairs.h (SCM_VALIDATE_PAIR): Use SCM_CONSP, not SCM_ECONSP. * pairs.h (SCM_VALIDATE_PAIR): Use SCM_CONSP, not SCM_ECONSP.

71
libguile/eval.c
View file

@ -278,7 +278,7 @@ scm_lookupcar (SCM vloc, SCM genv, int check)
al = SCM_CARLOC (env); al = SCM_CARLOC (env);
for (fl = SCM_CAR (*al); SCM_NIMP (fl); fl = SCM_CDR (fl)) for (fl = SCM_CAR (*al); SCM_NIMP (fl); fl = SCM_CDR (fl))
{ {
if (SCM_NCONSP (fl)) if (!SCM_CONSP (fl))
{ {
if (SCM_EQ_P (fl, var)) if (SCM_EQ_P (fl, var))
{ {
@ -336,7 +336,7 @@ scm_lookupcar (SCM vloc, SCM genv, int check)
goto errout; goto errout;
#ifndef SCM_RECKLESS #ifndef SCM_RECKLESS
if (SCM_NNULLP (env) || SCM_UNBNDP (SCM_VARIABLE_REF (real_var))) if (!SCM_NULLP (env) || SCM_UNBNDP (SCM_VARIABLE_REF (real_var)))
{ {
errout: errout:
/* scm_everr (vloc, genv,...) */ /* scm_everr (vloc, genv,...) */
@ -501,7 +501,7 @@ scm_m_body (SCM op, SCM xorig, const char *what)
/* Retain possible doc string. */ /* Retain possible doc string. */
if (!SCM_CONSP (SCM_CAR (xorig))) if (!SCM_CONSP (SCM_CAR (xorig)))
{ {
if (SCM_NNULLP (SCM_CDR(xorig))) if (!SCM_NULLP (SCM_CDR(xorig)))
return scm_cons (SCM_CAR (xorig), return scm_cons (SCM_CAR (xorig),
scm_m_body (op, SCM_CDR(xorig), what)); scm_m_body (op, SCM_CDR(xorig), what));
return xorig; return xorig;
@ -673,11 +673,11 @@ scm_m_lambda (SCM xorig, SCM env SCM_UNUSED)
goto badforms; goto badforms;
if (SCM_SYMBOLP (proc)) if (SCM_SYMBOLP (proc))
goto memlambda; goto memlambda;
if (SCM_NCONSP (proc)) if (!SCM_CONSP (proc))
goto badforms; goto badforms;
while (SCM_NIMP (proc)) while (SCM_NIMP (proc))
{ {
if (SCM_NCONSP (proc)) if (!SCM_CONSP (proc))
{ {
if (!SCM_SYMBOLP (proc)) if (!SCM_SYMBOLP (proc))
goto badforms; goto badforms;
@ -690,7 +690,7 @@ scm_m_lambda (SCM xorig, SCM env SCM_UNUSED)
scm_misc_error (s_lambda, scm_s_duplicate_formals, SCM_EOL); scm_misc_error (s_lambda, scm_s_duplicate_formals, SCM_EOL);
proc = SCM_CDR (proc); proc = SCM_CDR (proc);
} }
if (SCM_NNULLP (proc)) if (!SCM_NULLP (proc))
{ {
badforms: badforms:
scm_misc_error (s_lambda, scm_s_formals, SCM_EOL); scm_misc_error (s_lambda, scm_s_formals, SCM_EOL);
@ -1279,7 +1279,7 @@ unmemocopy (SCM x, SCM env)
#ifdef DEBUG_EXTENSIONS #ifdef DEBUG_EXTENSIONS
SCM p; SCM p;
#endif #endif
if (SCM_NCELLP (x) || SCM_NCONSP (x)) if (!SCM_CELLP (x) || !SCM_CONSP (x))
return x; return x;
#ifdef DEBUG_EXTENSIONS #ifdef DEBUG_EXTENSIONS
p = scm_whash_lookup (scm_source_whash, x); p = scm_whash_lookup (scm_source_whash, x);
@ -1414,7 +1414,7 @@ unmemocopy (SCM x, SCM env)
x = SCM_CDR (x); x = SCM_CDR (x);
ls = scm_cons (scm_sym_define, ls = scm_cons (scm_sym_define,
z = scm_cons (n = SCM_CAR (x), SCM_UNSPECIFIED)); z = scm_cons (n = SCM_CAR (x), SCM_UNSPECIFIED));
if (SCM_NNULLP (env)) if (!SCM_NULLP (env))
SCM_SETCAR (SCM_CAR (env), scm_cons (n, SCM_CAR (SCM_CAR (env)))); SCM_SETCAR (SCM_CAR (env), scm_cons (n, SCM_CAR (SCM_CAR (env))));
break; break;
} }
@ -1459,7 +1459,7 @@ loop:
} }
SCM_SETCDR (z, x); SCM_SETCDR (z, x);
#ifdef DEBUG_EXTENSIONS #ifdef DEBUG_EXTENSIONS
if (SCM_NFALSEP (p)) if (!SCM_FALSEP (p))
scm_whash_insert (scm_source_whash, ls, p); scm_whash_insert (scm_source_whash, ls, p);
#endif #endif
return ls; return ls;
@ -1469,7 +1469,7 @@ loop:
SCM SCM
scm_unmemocopy (SCM x, SCM env) scm_unmemocopy (SCM x, SCM env)
{ {
if (SCM_NNULLP (env)) if (!SCM_NULLP (env))
/* Make a copy of the lowest frame to protect it from /* Make a copy of the lowest frame to protect it from
modifications by SCM_IM_DEFINE */ modifications by SCM_IM_DEFINE */
return unmemocopy (x, scm_cons (SCM_CAR (env), SCM_CDR (env))); return unmemocopy (x, scm_cons (SCM_CAR (env), SCM_CDR (env)));
@ -1484,14 +1484,14 @@ scm_badargsp (SCM formals, SCM args)
{ {
while (SCM_NIMP (formals)) while (SCM_NIMP (formals))
{ {
if (SCM_NCONSP (formals)) if (!SCM_CONSP (formals))
return 0; return 0;
if (SCM_IMP(args)) if (SCM_IMP(args))
return 1; return 1;
formals = SCM_CDR (formals); formals = SCM_CDR (formals);
args = SCM_CDR (args); args = SCM_CDR (args);
} }
return SCM_NNULLP (args) ? 1 : 0; return !SCM_NULLP (args) ? 1 : 0;
} }
#endif #endif
@ -1536,8 +1536,8 @@ scm_eval_body (SCM code, SCM env)
{ {
SCM next; SCM next;
again: again:
next = code; next = SCM_CDR (code);
while (SCM_NNULLP (next = SCM_CDR (next))) while (!SCM_NULLP (next))
{ {
if (SCM_IMP (SCM_CAR (code))) if (SCM_IMP (SCM_CAR (code)))
{ {
@ -1550,6 +1550,7 @@ scm_eval_body (SCM code, SCM env)
else else
SCM_XEVAL (SCM_CAR (code), env); SCM_XEVAL (SCM_CAR (code), env);
code = next; code = next;
next = SCM_CDR (code);
} }
return SCM_XEVALCAR (code, env); return SCM_XEVALCAR (code, env);
} }
@ -1755,7 +1756,7 @@ scm_deval_args (SCM l, SCM env, SCM proc, SCM *lloc)
} while (0) } while (0)
#ifndef DEVAL #ifndef DEVAL
#define CHECK_EQVISH(A,B) (SCM_EQ_P ((A), (B)) || (SCM_NFALSEP (scm_eqv_p ((A), (B))))) #define CHECK_EQVISH(A,B) (SCM_EQ_P ((A), (B)) || (!SCM_FALSEP (scm_eqv_p ((A), (B)))))
#endif /* DEVAL */ #endif /* DEVAL */
#define BUILTIN_RPASUBR /* Handle rpsubrs and asubrs without calling apply */ #define BUILTIN_RPASUBR /* Handle rpsubrs and asubrs without calling apply */
@ -1893,7 +1894,7 @@ dispatch:
case SCM_BIT8(SCM_IM_AND): case SCM_BIT8(SCM_IM_AND):
x = SCM_CDR (x); x = SCM_CDR (x);
t.arg1 = x; t.arg1 = x;
while (SCM_NNULLP (t.arg1 = SCM_CDR (t.arg1))) while (!SCM_NULLP (t.arg1 = SCM_CDR (t.arg1)))
if (SCM_FALSEP (EVALCAR (x, env))) if (SCM_FALSEP (EVALCAR (x, env)))
{ {
RETURN (SCM_BOOL_F); RETURN (SCM_BOOL_F);
@ -2001,7 +2002,7 @@ dispatch:
{ {
proc = SCM_CAR (x); proc = SCM_CAR (x);
t.arg1 = EVALCAR (proc, env); t.arg1 = EVALCAR (proc, env);
if (SCM_NFALSEP (t.arg1)) if (!SCM_FALSEP (t.arg1))
{ {
x = SCM_CDR (proc); x = SCM_CDR (proc);
if (SCM_NULLP (x)) if (SCM_NULLP (x))
@ -2059,7 +2060,7 @@ dispatch:
case SCM_BIT8(SCM_IM_IF): case SCM_BIT8(SCM_IM_IF):
x = SCM_CDR (x); x = SCM_CDR (x);
if (SCM_NFALSEP (EVALCAR (x, env))) if (!SCM_FALSEP (EVALCAR (x, env)))
x = SCM_CDR (x); x = SCM_CDR (x);
else if (SCM_IMP (x = SCM_CDR (SCM_CDR (x)))) else if (SCM_IMP (x = SCM_CDR (SCM_CDR (x))))
{ {
@ -2246,7 +2247,7 @@ dispatch:
PREP_APPLY (SCM_UNDEFINED, SCM_EOL); PREP_APPLY (SCM_UNDEFINED, SCM_EOL);
if (SCM_IMP (proc)) if (SCM_IMP (proc))
arg2 = *scm_ilookup (proc, env); arg2 = *scm_ilookup (proc, env);
else if (SCM_NCONSP (proc)) else if (!SCM_CONSP (proc))
{ {
if (SCM_VARIABLEP (proc)) if (SCM_VARIABLEP (proc))
arg2 = SCM_VARIABLE_REF (proc); arg2 = SCM_VARIABLE_REF (proc);
@ -2377,7 +2378,7 @@ dispatch:
case (SCM_ISYMNUM (SCM_IM_T_IFY)): case (SCM_ISYMNUM (SCM_IM_T_IFY)):
x = SCM_CDR (x); x = SCM_CDR (x);
RETURN (SCM_NFALSEP (EVALCAR (x, env)) ? scm_lisp_t : scm_lisp_nil) RETURN (!SCM_FALSEP (EVALCAR (x, env)) ? scm_lisp_t : scm_lisp_nil)
case (SCM_ISYMNUM (SCM_IM_0_COND)): case (SCM_ISYMNUM (SCM_IM_0_COND)):
proc = SCM_CDR (x); proc = SCM_CDR (x);
@ -2405,7 +2406,7 @@ dispatch:
case (SCM_ISYMNUM (SCM_IM_1_IFY)): case (SCM_ISYMNUM (SCM_IM_1_IFY)):
x = SCM_CDR (x); x = SCM_CDR (x);
RETURN (SCM_NFALSEP (EVALCAR (x, env)) RETURN (!SCM_FALSEP (EVALCAR (x, env))
? SCM_MAKINUM (1) ? SCM_MAKINUM (1)
: SCM_INUM0) : SCM_INUM0)
@ -2426,7 +2427,7 @@ dispatch:
scm_dynwinds = scm_acons (t.arg1, SCM_CDAR (env), scm_dynwinds); scm_dynwinds = scm_acons (t.arg1, SCM_CDAR (env), scm_dynwinds);
arg2 = x = SCM_CDR (x); arg2 = x = SCM_CDR (x);
while (SCM_NNULLP (arg2 = SCM_CDR (arg2))) while (!SCM_NULLP (arg2 = SCM_CDR (arg2)))
{ {
SIDEVAL (SCM_CAR (x), env); SIDEVAL (SCM_CAR (x), env);
x = arg2; x = arg2;
@ -2733,18 +2734,16 @@ evapply:
{ {
RETURN (scm_make_real (SCM_DSUBRF (proc) ((double) SCM_INUM (t.arg1)))); RETURN (scm_make_real (SCM_DSUBRF (proc) ((double) SCM_INUM (t.arg1))));
} }
SCM_ASRTGO (SCM_NIMP (t.arg1), floerr); else if (SCM_REALP (t.arg1))
if (SCM_REALP (t.arg1))
{ {
RETURN (scm_make_real (SCM_DSUBRF (proc) (SCM_REAL_VALUE (t.arg1)))); RETURN (scm_make_real (SCM_DSUBRF (proc) (SCM_REAL_VALUE (t.arg1))));
} }
#ifdef SCM_BIGDIG #ifdef SCM_BIGDIG
if (SCM_BIGP (t.arg1)) else if (SCM_BIGP (t.arg1))
{ {
RETURN (scm_make_real (SCM_DSUBRF (proc) (scm_i_big2dbl (t.arg1)))); RETURN (scm_make_real (SCM_DSUBRF (proc) (scm_i_big2dbl (t.arg1))));
} }
#endif #endif
floerr:
SCM_WTA_DISPATCH_1 (*SCM_SUBR_GENERIC (proc), t.arg1, SCM_WTA_DISPATCH_1 (*SCM_SUBR_GENERIC (proc), t.arg1,
SCM_ARG1, SCM_SYMBOL_CHARS (SCM_SNAME (proc))); SCM_ARG1, SCM_SYMBOL_CHARS (SCM_SNAME (proc)));
} }
@ -2962,7 +2961,7 @@ evapply:
} }
} }
#ifdef SCM_CAUTIOUS #ifdef SCM_CAUTIOUS
if (SCM_IMP (x) || SCM_NCONSP (x)) if (SCM_IMP (x) || !SCM_CONSP (x))
goto wrongnumargs; goto wrongnumargs;
#endif #endif
#ifdef DEVAL #ifdef DEVAL
@ -3269,7 +3268,7 @@ SCM_DEFINE (scm_nconc2last, "apply:nconc2last", 1, 0, 0,
SCM *lloc; SCM *lloc;
SCM_VALIDATE_NONEMPTYLIST (1,lst); SCM_VALIDATE_NONEMPTYLIST (1,lst);
lloc = &lst; lloc = &lst;
while (SCM_NNULLP (SCM_CDR (*lloc))) while (!SCM_NULLP (SCM_CDR (*lloc)))
lloc = SCM_CDRLOC (*lloc); lloc = SCM_CDRLOC (*lloc);
SCM_ASSERT (scm_ilength (SCM_CAR (*lloc)) >= 0, lst, SCM_ARG1, FUNC_NAME); SCM_ASSERT (scm_ilength (SCM_CAR (*lloc)) >= 0, lst, SCM_ARG1, FUNC_NAME);
*lloc = SCM_CAR (*lloc); *lloc = SCM_CAR (*lloc);
@ -3395,7 +3394,7 @@ tail:
args = SCM_NULLP (args) ? SCM_UNDEFINED : SCM_CAR (args); args = SCM_NULLP (args) ? SCM_UNDEFINED : SCM_CAR (args);
RETURN (SCM_SUBRF (proc) (arg1, args)) RETURN (SCM_SUBRF (proc) (arg1, args))
case scm_tc7_subr_2: case scm_tc7_subr_2:
SCM_ASRTGO (SCM_NNULLP (args) && SCM_NULLP (SCM_CDR (args)), SCM_ASRTGO (!SCM_NULLP (args) && SCM_NULLP (SCM_CDR (args)),
wrongnumargs); wrongnumargs);
args = SCM_CAR (args); args = SCM_CAR (args);
RETURN (SCM_SUBRF (proc) (arg1, args)) RETURN (SCM_SUBRF (proc) (arg1, args))
@ -3415,16 +3414,14 @@ tail:
{ {
RETURN (scm_make_real (SCM_DSUBRF (proc) ((double) SCM_INUM (arg1)))); RETURN (scm_make_real (SCM_DSUBRF (proc) ((double) SCM_INUM (arg1))));
} }
SCM_ASRTGO (SCM_NIMP (arg1), floerr); else if (SCM_REALP (arg1))
if (SCM_REALP (arg1))
{ {
RETURN (scm_make_real (SCM_DSUBRF (proc) (SCM_REAL_VALUE (arg1)))); RETURN (scm_make_real (SCM_DSUBRF (proc) (SCM_REAL_VALUE (arg1))));
} }
#ifdef SCM_BIGDIG #ifdef SCM_BIGDIG
if (SCM_BIGP (arg1)) else if (SCM_BIGP (arg1))
RETURN (scm_make_real (SCM_DSUBRF (proc) (scm_i_big2dbl (arg1)))) RETURN (scm_make_real (SCM_DSUBRF (proc) (scm_i_big2dbl (arg1))))
#endif #endif
floerr:
SCM_WTA_DISPATCH_1 (*SCM_SUBR_GENERIC (proc), arg1, SCM_WTA_DISPATCH_1 (*SCM_SUBR_GENERIC (proc), arg1,
SCM_ARG1, SCM_SYMBOL_CHARS (SCM_SNAME (proc))); SCM_ARG1, SCM_SYMBOL_CHARS (SCM_SNAME (proc)));
} }
@ -3440,8 +3437,8 @@ tail:
RETURN (arg1) RETURN (arg1)
} }
case scm_tc7_subr_3: case scm_tc7_subr_3:
SCM_ASRTGO (SCM_NNULLP (args) SCM_ASRTGO (!SCM_NULLP (args)
&& SCM_NNULLP (SCM_CDR (args)) && !SCM_NULLP (SCM_CDR (args))
&& SCM_NULLP (SCM_CDDR (args)), && SCM_NULLP (SCM_CDDR (args)),
wrongnumargs); wrongnumargs);
RETURN (SCM_SUBRF (proc) (arg1, SCM_CAR (args), SCM_CAR (SCM_CDR (args)))) RETURN (SCM_SUBRF (proc) (arg1, SCM_CAR (args), SCM_CAR (SCM_CDR (args))))
@ -3506,7 +3503,7 @@ tail:
proc = SCM_CDR (SCM_CODE (proc)); proc = SCM_CDR (SCM_CODE (proc));
again: again:
arg1 = proc; arg1 = proc;
while (SCM_NNULLP (arg1 = SCM_CDR (arg1))) while (!SCM_NULLP (arg1 = SCM_CDR (arg1)))
{ {
if (SCM_IMP (SCM_CAR (proc))) if (SCM_IMP (SCM_CAR (proc)))
{ {
@ -3872,7 +3869,7 @@ SCM_DEFINE (scm_copy_tree, "copy-tree", 1, 0, 0,
SCM_VELTS (ans)[i] = scm_copy_tree (SCM_VELTS (obj)[i]); SCM_VELTS (ans)[i] = scm_copy_tree (SCM_VELTS (obj)[i]);
return ans; return ans;
} }
if (SCM_NCONSP (obj)) if (!SCM_CONSP (obj))
return obj; return obj;
ans = tl = scm_cons_source (obj, ans = tl = scm_cons_source (obj,
scm_copy_tree (SCM_CAR (obj)), scm_copy_tree (SCM_CAR (obj)),