mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-11 06:20:23 +02:00
Code Activity

* eval.c (scm_m_expand_body): Use scm_cons_source.

Browse source
This commit is contained in:
Mikael Djurfeldt 1999-07-29 23:01:01 +00:00
parent cb4832aefb
commit 3a3111a88d
1 changed files with 28 additions and 40 deletions
Download patch file Download diff file Expand all files Collapse all files

68
libguile/eval.c
View file

@ -518,7 +518,7 @@ scm_m_quote (xorig, env)
SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) == 1, SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) == 1,
xorig, scm_s_expression, s_quote); xorig, scm_s_expression, s_quote);
return scm_cons_source (xorig, SCM_IM_QUOTE, x); return scm_cons (SCM_IM_QUOTE, x);
} }
@ -533,7 +533,7 @@ scm_m_begin (xorig, env)
{ {
SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) >= 1, SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) >= 1,
xorig, scm_s_expression, s_begin); xorig, scm_s_expression, s_begin);
return scm_cons_source (xorig, SCM_IM_BEGIN, SCM_CDR (xorig)); return scm_cons (SCM_IM_BEGIN, SCM_CDR (xorig));
} }
SCM_SYNTAX(s_if, "if", scm_makmmacro, scm_m_if); SCM_SYNTAX(s_if, "if", scm_makmmacro, scm_m_if);
@ -546,7 +546,7 @@ scm_m_if (xorig, 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, xorig, scm_s_expression, "if");
return scm_cons_source (xorig, SCM_IM_IF, SCM_CDR (xorig)); return scm_cons (SCM_IM_IF, SCM_CDR (xorig));
} }
@ -564,7 +564,7 @@ scm_m_set_x (xorig, env)
SCM_ASSYNT (2 == scm_ilength (x), xorig, scm_s_expression, scm_s_set_x); SCM_ASSYNT (2 == scm_ilength (x), xorig, scm_s_expression, scm_s_set_x);
SCM_ASSYNT (SCM_NIMP (SCM_CAR (x)) && SCM_SYMBOLP (SCM_CAR (x)), SCM_ASSYNT (SCM_NIMP (SCM_CAR (x)) && SCM_SYMBOLP (SCM_CAR (x)),
xorig, scm_s_variable, scm_s_set_x); xorig, scm_s_variable, scm_s_set_x);
return scm_cons_source (xorig, SCM_IM_SET_X, x); return scm_cons (SCM_IM_SET_X, x);
} }
@ -617,7 +617,7 @@ scm_m_and (xorig, 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, xorig, scm_s_test, s_and);
if (len >= 1) if (len >= 1)
return scm_cons_source (xorig, SCM_IM_AND, SCM_CDR (xorig)); return scm_cons (SCM_IM_AND, SCM_CDR (xorig));
else else
return SCM_BOOL_T; return SCM_BOOL_T;
} }
@ -633,7 +633,7 @@ scm_m_or (xorig, 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, xorig, scm_s_test, s_or);
if (len >= 1) if (len >= 1)
return scm_cons_source (xorig, SCM_IM_OR, SCM_CDR (xorig)); return scm_cons (SCM_IM_OR, SCM_CDR (xorig));
else else
return SCM_BOOL_F; return SCM_BOOL_F;
} }
@ -657,7 +657,7 @@ scm_m_case (xorig, env)
|| scm_i_else == SCM_CAR (proc), || scm_i_else == SCM_CAR (proc),
xorig, scm_s_clauses, s_case); xorig, scm_s_clauses, s_case);
} }
return scm_cons_source (xorig, SCM_IM_CASE, cdrx); return scm_cons (SCM_IM_CASE, cdrx);
} }
@ -689,7 +689,7 @@ scm_m_cond (xorig, env)
xorig, "bad recipient", s_cond); xorig, "bad recipient", s_cond);
x = SCM_CDR (x); x = SCM_CDR (x);
} }
return scm_cons_source (xorig, SCM_IM_COND, cdrx); return scm_cons (SCM_IM_COND, cdrx);
} }
SCM_SYNTAX(s_lambda, "lambda", scm_makmmacro, scm_m_lambda); SCM_SYNTAX(s_lambda, "lambda", scm_makmmacro, scm_m_lambda);
@ -734,12 +734,8 @@ scm_m_lambda (xorig, env)
} }
memlambda: memlambda:
return scm_cons_source (xorig, return scm_cons2 (SCM_IM_LAMBDA, SCM_CAR (x),
SCM_IM_LAMBDA, scm_m_body (SCM_IM_LAMBDA, SCM_CDR (x), s_lambda));
scm_cons (SCM_CAR (x),
scm_m_body (SCM_IM_LAMBDA,
SCM_CDR (x),
s_lambda)));
} }
SCM_SYNTAX(s_letstar,"let*", scm_makmmacro, scm_m_letstar); SCM_SYNTAX(s_letstar,"let*", scm_makmmacro, scm_m_letstar);
@ -768,12 +764,8 @@ scm_m_letstar (xorig, env)
} }
x = scm_cons (vars, SCM_CDR (x)); x = scm_cons (vars, SCM_CDR (x));
return scm_cons_source (xorig, return scm_cons2 (SCM_IM_LETSTAR, SCM_CAR (x),
SCM_IM_LETSTAR, scm_m_body (SCM_IM_LETSTAR, SCM_CDR (x), s_letstar));
scm_cons (SCM_CAR (x),
scm_m_body (SCM_IM_LETSTAR,
SCM_CDR (x),
"let*")));
} }
/* DO gets the most radically altered syntax /* DO gets the most radically altered syntax
@ -827,7 +819,7 @@ scm_m_do (xorig, env)
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);
bodycheck (xorig, SCM_CARLOC (SCM_CDR (SCM_CDR (x))), "do"); bodycheck (xorig, SCM_CARLOC (SCM_CDR (SCM_CDR (x))), "do");
return scm_cons_source (xorig, SCM_IM_DO, x); return scm_cons (SCM_IM_DO, x);
} }
/* evalcar is small version of inline EVALCAR when we don't care about /* evalcar is small version of inline EVALCAR when we don't care about
@ -1008,11 +1000,8 @@ scm_m_letrec1 (op, imm, xorig, env)
} }
while (SCM_NIMP (proc = SCM_CDR (proc))); while (SCM_NIMP (proc = SCM_CDR (proc)));
return scm_cons_source (xorig, op, return scm_cons2 (op, vars,
scm_cons (vars, scm_cons (inits, scm_m_body (imm, SCM_CDR (x), what)));
scm_cons (inits,
scm_m_body (imm, SCM_CDR (x),
what))));
} }
SCM_SYNTAX(s_letrec, "letrec", scm_makmmacro, scm_m_letrec); SCM_SYNTAX(s_letrec, "letrec", scm_makmmacro, scm_m_letrec);
@ -1027,12 +1016,10 @@ scm_m_letrec (xorig, env)
SCM_ASSYNT (scm_ilength (x) >= 2, xorig, scm_s_body, s_letrec); SCM_ASSYNT (scm_ilength (x) >= 2, xorig, 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_cons_source (xorig, return scm_m_letstar (scm_cons2 (SCM_CAR (xorig), SCM_EOL,
SCM_CAR (xorig), scm_m_body (SCM_IM_LETREC,
scm_cons (SCM_EOL, SCM_CDR (x),
scm_m_body (SCM_IM_LETREC, s_letrec)),
SCM_CDR (x),
"letrec"))),
env); env);
else else
return scm_m_letrec1 (SCM_IM_LETREC, SCM_IM_LETREC, xorig, env); return scm_m_letrec1 (SCM_IM_LETREC, SCM_IM_LETREC, xorig, env);
@ -1058,12 +1045,10 @@ scm_m_let (xorig, env)
&& SCM_CONSP (SCM_CAR (proc)) && SCM_NULLP (SCM_CDR (proc)))) && SCM_CONSP (SCM_CAR (proc)) && SCM_NULLP (SCM_CDR (proc))))
{ {
/* null or single binding, let* is faster */ /* null or single binding, let* is faster */
return scm_m_letstar (scm_cons_source (xorig, return scm_m_letstar (scm_cons2 (SCM_CAR (xorig), proc,
SCM_CAR (xorig), scm_m_body (SCM_IM_LET,
scm_cons (proc, SCM_CDR (x),
scm_m_body (SCM_IM_LET, s_let)),
SCM_CDR (x),
"let"))),
env); env);
} }
@ -1128,7 +1113,7 @@ scm_m_cont (xorig, env)
{ {
SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) == 1, SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) == 1,
xorig, scm_s_expression, s_atcall_cc); xorig, scm_s_expression, s_atcall_cc);
return scm_cons_source (xorig, SCM_IM_CONT, SCM_CDR (xorig)); return scm_cons (SCM_IM_CONT, SCM_CDR (xorig));
} }
/* Multi-language support */ /* Multi-language support */
@ -1256,7 +1241,10 @@ scm_m_expand_body (SCM xorig, SCM env)
if (!SCM_SYMBOLP (SCM_CAR (form))) if (!SCM_SYMBOLP (SCM_CAR (form)))
break; break;
form = scm_macroexp (scm_cons (SCM_CAR (form), SCM_CDR (form)), env); form = scm_macroexp (scm_cons_source (form,
SCM_CAR (form),
SCM_CDR (form)),
env);
if (SCM_IM_DEFINE == SCM_CAR (form)) if (SCM_IM_DEFINE == SCM_CAR (form))
{ {