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

* snarf.h (SCM_SYNTAX): New macro to allow convenient declaration of

Browse source 
syntactic forms, similar to SCM_PROC.
* debug.c, eval.c, evalext.c: use SCM_SYNTAX to declare all special
forms, and SCM_SYMBOL or SCM_GLOBAL_SYMBOL to delcare C variables for
the name symbols when needed.
This commit is contained in:
Maciej Stachowiak 1998-12-14 15:19:59 +00:00
parent 257665b528
commit b8229a3bab
5 changed files with 104 additions and 79 deletions
Download patch file Download diff file Expand all files Collapse all files

8
libguile/ChangeLog
View file

@ -1,3 +1,11 @@
Mon Dec 14 18:10:12 1998 Maciej Stachowiak <mstachow@mit.edu>
* snarf.h (SCM_SYNTAX): New macro to allow convenient declaration
of syntactic forms, similar to SCM_PROC.
* debug.c, eval.c, evalext.c: use SCM_SYNTAX to declare all special
forms, and SCM_SYMBOL or SCM_GLOBAL_SYMBOL to delcare C variables
for the name symbols when needed.
1998-12-14 Jim Blandy <jimb@zwingli.cygnus.com> 1998-12-14 Jim Blandy <jimb@zwingli.cygnus.com>
* Makefile.in: Regenerated. * Makefile.in: Regenerated.

5
libguile/debug.c
View file

@ -550,7 +550,8 @@ scm_start_stack (id, exp, env)
return answer; return answer;
} }
static char s_start_stack[] = "start-stack"; SCM_SYNTAX(s_start_stack, "start-stack", scm_makacro, scm_m_start_stack);
static SCM static SCM
scm_m_start_stack (exp, env) scm_m_start_stack (exp, env)
SCM exp; SCM exp;
@ -648,8 +649,6 @@ scm_init_debug ()
scm_i_args = SCM_CAR (scm_sysintern ("args", SCM_UNDEFINED)); scm_i_args = SCM_CAR (scm_sysintern ("args", SCM_UNDEFINED));
scm_i_eval_args = SCM_CAR (scm_sysintern ("eval-args", SCM_UNDEFINED)); scm_i_eval_args = SCM_CAR (scm_sysintern ("eval-args", SCM_UNDEFINED));
scm_make_synt (s_start_stack, scm_makacro, scm_m_start_stack);
#ifdef GUILE_DEBUG #ifdef GUILE_DEBUG
scm_sysintern ("SCM_IM_AND", SCM_IM_AND); scm_sysintern ("SCM_IM_AND", SCM_IM_AND);
scm_sysintern ("SCM_IM_BEGIN", SCM_IM_BEGIN); scm_sysintern ("SCM_IM_BEGIN", SCM_IM_BEGIN);

158
libguile/eval.c
View file

@ -434,13 +434,8 @@ char scm_s_variable[] = "bad variable";
char scm_s_clauses[] = "bad or missing clauses"; char scm_s_clauses[] = "bad or missing clauses";
char scm_s_formals[] = "bad formals"; char scm_s_formals[] = "bad formals";
SCM scm_i_dot, scm_i_quote, scm_i_quasiquote, scm_i_lambda, scm_i_let, SCM scm_i_dot, scm_i_arrow, scm_i_else, scm_i_unquote, scm_i_uq_splicing, scm_i_apply;
scm_i_arrow, scm_i_else, scm_i_unquote, scm_i_uq_splicing, scm_i_apply;
SCM scm_i_define, scm_i_and, scm_i_begin, scm_i_case, scm_i_cond,
scm_i_do, scm_i_if, scm_i_let, scm_i_letrec, scm_i_letstar,
scm_i_or, scm_i_set, scm_i_atapply, scm_i_atcall_cc;
static char s_quasiquote[] = "quasiquote";
static char s_delay[] = "delay";
#ifdef DEBUG_EXTENSIONS #ifdef DEBUG_EXTENSIONS
SCM scm_i_enter_frame, scm_i_apply_frame, scm_i_exit_frame; SCM scm_i_enter_frame, scm_i_apply_frame, scm_i_exit_frame;
SCM scm_i_trace; SCM scm_i_trace;
@ -461,7 +456,8 @@ bodycheck (xorig, bodyloc, what)
ASRTSYNTAX (scm_ilength (*bodyloc) >= 1, scm_s_expression); ASRTSYNTAX (scm_ilength (*bodyloc) >= 1, scm_s_expression);
} }
SCM_SYNTAX(s_quote,"quote", scm_makmmacro, scm_m_quote);
SCM_GLOBAL_SYMBOL(scm_i_quote,s_quote);
SCM SCM
scm_m_quote (xorig, env) scm_m_quote (xorig, env)
@ -469,23 +465,27 @@ scm_m_quote (xorig, env)
SCM env; SCM env;
{ {
SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) == 1, SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) == 1,
xorig, scm_s_expression, "quote"); xorig, scm_s_expression, s_quote);
return scm_cons (SCM_IM_QUOTE, SCM_CDR (xorig)); return scm_cons (SCM_IM_QUOTE, SCM_CDR (xorig));
} }
SCM_SYNTAX(s_begin, "begin", scm_makmmacro, scm_m_begin);
SCM_SYMBOL(scm_i_begin, s_begin);
SCM SCM
scm_m_begin (xorig, env) scm_m_begin (xorig, env)
SCM xorig; SCM xorig;
SCM env; SCM env;
{ {
SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) >= 1, SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) >= 1,
xorig, scm_s_expression, "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));
} }
SCM_SYNTAX(s_if, "if", scm_makmmacro, scm_m_if);
SCM_SYMBOL(scm_i_if, s_if);
SCM SCM
scm_m_if (xorig, env) scm_m_if (xorig, env)
@ -498,6 +498,8 @@ scm_m_if (xorig, env)
} }
SCM_SYNTAX(s_set,"set!", scm_makmmacro, scm_m_set);
SCM_SYMBOL(scm_i_set,s_set);
SCM SCM
scm_m_set (xorig, env) scm_m_set (xorig, env)
@ -505,9 +507,9 @@ scm_m_set (xorig, env)
SCM env; SCM env;
{ {
SCM x = SCM_CDR (xorig); SCM x = SCM_CDR (xorig);
SCM_ASSYNT (2 == scm_ilength (x), xorig, scm_s_expression, "set!"); SCM_ASSYNT (2 == scm_ilength (x), xorig, scm_s_expression, s_set);
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, "set!"); xorig, scm_s_variable, s_set);
return scm_cons (SCM_IM_SET, x); return scm_cons (SCM_IM_SET, x);
} }
@ -551,6 +553,8 @@ scm_m_vset (xorig, env)
#endif #endif
SCM_SYNTAX(s_and, "and", scm_makmmacro, scm_m_and);
SCM_GLOBAL_SYMBOL(scm_i_and, s_and);
SCM SCM
scm_m_and (xorig, env) scm_m_and (xorig, env)
@ -558,14 +562,15 @@ scm_m_and (xorig, env)
SCM env; SCM env;
{ {
int len = scm_ilength (SCM_CDR (xorig)); int len = scm_ilength (SCM_CDR (xorig));
SCM_ASSYNT (len >= 0, xorig, scm_s_test, "and"); SCM_ASSYNT (len >= 0, xorig, 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
return SCM_BOOL_T; return SCM_BOOL_T;
} }
SCM_SYNTAX(s_or,"or", scm_makmmacro, scm_m_or);
SCM_SYMBOL(scm_i_or,s_or);
SCM SCM
scm_m_or (xorig, env) scm_m_or (xorig, env)
@ -573,7 +578,7 @@ scm_m_or (xorig, env)
SCM env; SCM env;
{ {
int len = scm_ilength (SCM_CDR (xorig)); int len = scm_ilength (SCM_CDR (xorig));
SCM_ASSYNT (len >= 0, xorig, scm_s_test, "or"); SCM_ASSYNT (len >= 0, xorig, 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
@ -581,6 +586,8 @@ scm_m_or (xorig, env)
} }
SCM_SYNTAX(s_case, "case", scm_makmmacro, scm_m_case);
SCM_SYMBOL(scm_i_case, s_case);
SCM SCM
scm_m_case (xorig, env) scm_m_case (xorig, env)
@ -588,19 +595,22 @@ scm_m_case (xorig, env)
SCM env; SCM env;
{ {
SCM proc, x = SCM_CDR (xorig); SCM proc, x = SCM_CDR (xorig);
SCM_ASSYNT (scm_ilength (x) >= 2, xorig, scm_s_clauses, "case"); SCM_ASSYNT (scm_ilength (x) >= 2, xorig, 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, "case"); SCM_ASSYNT (scm_ilength (proc) >= 2, xorig, scm_s_clauses, s_case);
SCM_ASSYNT (scm_ilength (SCM_CAR (proc)) >= 0 SCM_ASSYNT (scm_ilength (SCM_CAR (proc)) >= 0
|| scm_i_else == SCM_CAR (proc), || scm_i_else == SCM_CAR (proc),
xorig, scm_s_clauses, "case"); xorig, scm_s_clauses, s_case);
} }
return scm_cons (SCM_IM_CASE, SCM_CDR (xorig)); return scm_cons (SCM_IM_CASE, SCM_CDR (xorig));
} }
SCM_SYNTAX(s_cond, "cond", scm_makmmacro, scm_m_cond);
SCM_SYMBOL(scm_i_cond, s_cond);
SCM SCM
scm_m_cond (xorig, env) scm_m_cond (xorig, env)
@ -609,27 +619,28 @@ scm_m_cond (xorig, env)
{ {
SCM arg1, x = SCM_CDR (xorig); SCM arg1, x = SCM_CDR (xorig);
int len = scm_ilength (x); int len = scm_ilength (x);
SCM_ASSYNT (len >= 1, xorig, scm_s_clauses, "cond"); SCM_ASSYNT (len >= 1, xorig, 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, "cond"); SCM_ASSYNT (len >= 1, xorig, scm_s_clauses, s_cond);
if (scm_i_else == SCM_CAR (arg1)) if (scm_i_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", "cond"); xorig, "bad ELSE clause", s_cond);
SCM_SETCAR (arg1, SCM_BOOL_T); SCM_SETCAR (arg1, SCM_BOOL_T);
} }
if (len >= 2 && scm_i_arrow == SCM_CAR (SCM_CDR (arg1))) if (len >= 2 && scm_i_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", "cond"); xorig, "bad recipient", s_cond);
x = SCM_CDR (x); x = SCM_CDR (x);
} }
return scm_cons (SCM_IM_COND, SCM_CDR (xorig)); return scm_cons (SCM_IM_COND, SCM_CDR (xorig));
} }
SCM_SYNTAX(s_lambda, "lambda", scm_makmmacro, scm_m_lambda);
SCM_GLOBAL_SYMBOL(scm_i_lambda, s_lambda);
SCM SCM
scm_m_lambda (xorig, env) scm_m_lambda (xorig, env)
@ -669,6 +680,8 @@ memlambda:
return scm_cons (SCM_IM_LAMBDA, SCM_CDR (xorig)); return scm_cons (SCM_IM_LAMBDA, SCM_CDR (xorig));
} }
SCM_SYNTAX(s_letstar,"let*", scm_makmmacro, scm_m_letstar);
SCM_SYMBOL(scm_i_letstar,s_letstar);
SCM SCM
@ -678,21 +691,21 @@ scm_m_letstar (xorig, 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, "let*"); SCM_ASSYNT (len >= 2, xorig, scm_s_body, s_letstar);
proc = SCM_CAR (x); proc = SCM_CAR (x);
SCM_ASSYNT (scm_ilength (proc) >= 0, xorig, scm_s_bindings, "let*"); SCM_ASSYNT (scm_ilength (proc) >= 0, xorig, 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, "let*"); SCM_ASSYNT (2 == scm_ilength (arg1), xorig, scm_s_bindings, s_letstar);
SCM_ASSYNT (SCM_NIMP (SCM_CAR (arg1)) && SCM_SYMBOLP (SCM_CAR (arg1)), SCM_ASSYNT (SCM_NIMP (SCM_CAR (arg1)) && SCM_SYMBOLP (SCM_CAR (arg1)),
xorig, scm_s_variable, "let*"); xorig, 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);
} }
x = scm_cons (vars, SCM_CDR (x)); x = scm_cons (vars, SCM_CDR (x));
bodycheck (xorig, SCM_CDRLOC (x), "let*"); bodycheck (xorig, SCM_CDRLOC (x), s_letstar);
return scm_cons (SCM_IM_LETSTAR, x); return scm_cons (SCM_IM_LETSTAR, x);
} }
@ -710,7 +723,8 @@ scm_m_letstar (xorig, env)
<step1> <step2> ... <stepn>) ;; missing steps replaced by var <step1> <step2> ... <stepn>) ;; missing steps replaced by var
*/ */
SCM_SYNTAX(s_do, "do", scm_makmmacro, scm_m_do);
SCM_SYMBOL(scm_i_do, s_do);
SCM SCM
scm_m_do (xorig, env) scm_m_do (xorig, env)
@ -758,6 +772,20 @@ scm_m_do (xorig, env)
static SCM iqq SCM_P ((SCM form, SCM env, int depth)); static SCM iqq SCM_P ((SCM form, SCM env, int depth));
SCM_SYNTAX(s_quasiquote, "quasiquote", scm_makacro, scm_m_quasiquote);
SCM_GLOBAL_SYMBOL(scm_i_quasiquote, s_quasiquote);
SCM
scm_m_quasiquote (xorig, env)
SCM xorig;
SCM env;
{
SCM x = SCM_CDR (xorig);
SCM_ASSYNT (scm_ilength (x) == 1, xorig, scm_s_expression, s_quasiquote);
return iqq (SCM_CAR (x), env, 1);
}
static SCM static SCM
iqq (form, env, depth) iqq (form, env, depth)
SCM form; SCM form;
@ -807,17 +835,7 @@ iqq (form, env, depth)
/* Here are acros which return values rather than code. */ /* Here are acros which return values rather than code. */
SCM_SYNTAX(s_delay, "delay", scm_makacro, scm_m_delay);
SCM
scm_m_quasiquote (xorig, env)
SCM xorig;
SCM env;
{
SCM x = SCM_CDR (xorig);
SCM_ASSYNT (scm_ilength (x) == 1, xorig, scm_s_expression, s_quasiquote);
return iqq (SCM_CAR (x), env, 1);
}
SCM SCM
scm_m_delay (xorig, env) scm_m_delay (xorig, env)
@ -844,6 +862,8 @@ scm_env_top_level (env)
return SCM_BOOL_F; return SCM_BOOL_F;
} }
SCM_SYNTAX(s_define, "define", scm_makmmacro, scm_m_define);
SCM_SYMBOL(scm_i_define, s_define);
SCM SCM
scm_m_define (x, env) scm_m_define (x, env)
@ -853,7 +873,7 @@ scm_m_define (x, env)
SCM proc, arg1 = x; SCM proc, arg1 = x;
x = SCM_CDR (x); x = SCM_CDR (x);
/* SCM_ASSYNT(SCM_NULLP(env), x, "bad placement", s_define);*/ /* SCM_ASSYNT(SCM_NULLP(env), x, "bad placement", s_define);*/
SCM_ASSYNT (scm_ilength (x) >= 2, arg1, scm_s_expression, "define"); SCM_ASSYNT (scm_ilength (x) >= 2, arg1, scm_s_expression, s_define);
proc = SCM_CAR (x); proc = SCM_CAR (x);
x = SCM_CDR (x); x = SCM_CDR (x);
while (SCM_NIMP (proc) && SCM_CONSP (proc)) while (SCM_NIMP (proc) && SCM_CONSP (proc))
@ -862,8 +882,8 @@ scm_m_define (x, env)
proc = SCM_CAR (proc); proc = SCM_CAR (proc);
} }
SCM_ASSYNT (SCM_NIMP (proc) && SCM_SYMBOLP (proc), SCM_ASSYNT (SCM_NIMP (proc) && SCM_SYMBOLP (proc),
arg1, scm_s_variable, "define"); arg1, scm_s_variable, s_define);
SCM_ASSYNT (1 == scm_ilength (x), arg1, scm_s_expression, "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);
@ -907,6 +927,8 @@ scm_m_define (x, env)
/* end of acros */ /* end of acros */
SCM_SYNTAX(s_letrec, "letrec", scm_makmmacro, scm_m_letrec);
SCM_SYMBOL(scm_i_letrec, s_letrec);
SCM SCM
scm_m_letrec (xorig, env) scm_m_letrec (xorig, env)
@ -941,6 +963,9 @@ scm_m_letrec (xorig, env)
} }
SCM_SYNTAX(s_let, "let", scm_makmmacro, scm_m_let);
SCM_SYMBOL(scm_i_let, s_let);
SCM SCM
scm_m_let (xorig, env) scm_m_let (xorig, env)
SCM xorig; SCM xorig;
@ -950,29 +975,29 @@ scm_m_let (xorig, 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, "let"); SCM_ASSYNT (scm_ilength (x) >= 2, xorig, scm_s_body, s_let);
proc = SCM_CAR (x); proc = SCM_CAR (x);
if (SCM_NULLP (proc) if (SCM_NULLP (proc)
|| (SCM_NIMP (proc) && SCM_CONSP (proc) || (SCM_NIMP (proc) && SCM_CONSP (proc)
&& SCM_NIMP (SCM_CAR (proc)) && SCM_CONSP (SCM_CAR (proc)) && SCM_NULLP (SCM_CDR (proc)))) && SCM_NIMP (SCM_CAR (proc)) && SCM_CONSP (SCM_CAR (proc)) && SCM_NULLP (SCM_CDR (proc))))
return scm_m_letstar (xorig, env); /* null or single binding, let* is faster */ return scm_m_letstar (xorig, env); /* null or single binding, let* is faster */
SCM_ASSYNT (SCM_NIMP (proc), xorig, scm_s_bindings, "let"); SCM_ASSYNT (SCM_NIMP (proc), xorig, scm_s_bindings, s_let);
if (SCM_CONSP (proc)) /* plain let, proc is <bindings> */ if (SCM_CONSP (proc)) /* plain let, proc is <bindings> */
return scm_cons (SCM_IM_LET, SCM_CDR (scm_m_letrec (xorig, env))); return scm_cons (SCM_IM_LET, SCM_CDR (scm_m_letrec (xorig, env)));
if (!SCM_SYMBOLP (proc)) if (!SCM_SYMBOLP (proc))
scm_wta (xorig, scm_s_bindings, "let"); /* bad let */ scm_wta (xorig, scm_s_bindings, s_let); /* 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, "let"); SCM_ASSYNT (scm_ilength (x) >= 2, xorig, scm_s_body, s_let);
proc = SCM_CAR (x); /* bindings scm_list */ proc = SCM_CAR (x); /* bindings scm_list */
SCM_ASSYNT (scm_ilength (proc) >= 0, xorig, scm_s_bindings, "let"); SCM_ASSYNT (scm_ilength (proc) >= 0, xorig, scm_s_bindings, s_let);
while SCM_NIMP while SCM_NIMP
(proc) (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, "let"); SCM_ASSYNT (2 == scm_ilength (arg1), xorig, scm_s_bindings, s_let);
SCM_ASSYNT (SCM_NIMP (SCM_CAR (arg1)) && SCM_SYMBOLP (SCM_CAR (arg1)), SCM_ASSYNT (SCM_NIMP (SCM_CAR (arg1)) && SCM_SYMBOLP (SCM_CAR (arg1)),
xorig, scm_s_variable, "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);
@ -987,6 +1012,8 @@ scm_m_let (xorig, env)
} }
SCM_SYNTAX(s_atapply,"@apply", scm_makmmacro, scm_m_apply);
SCM_SYMBOL(scm_i_atapply, s_atapply);
SCM SCM
scm_m_apply (xorig, env) scm_m_apply (xorig, env)
@ -994,11 +1021,13 @@ scm_m_apply (xorig, env)
SCM env; SCM env;
{ {
SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) == 2, SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) == 2,
xorig, scm_s_expression, "@apply"); xorig, scm_s_expression, s_atapply);
return scm_cons (SCM_IM_APPLY, SCM_CDR (xorig)); return scm_cons (SCM_IM_APPLY, SCM_CDR (xorig));
} }
#define s_atcall_cc (SCM_ISYMCHARS(SCM_IM_CONT)+1)
SCM_SYNTAX(s_atcall_cc,"@call-with-current-continuation", scm_makmmacro, scm_m_cont);
SCM_SYMBOL(scm_i_atcall_cc,s_atcall_cc);
SCM SCM
@ -1007,7 +1036,7 @@ scm_m_cont (xorig, env)
SCM env; SCM env;
{ {
SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) == 1, SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) == 1,
xorig, scm_s_expression, "@call-with-current-continuation"); xorig, scm_s_expression, s_atcall_cc);
return scm_cons (SCM_IM_CONT, SCM_CDR (xorig)); return scm_cons (SCM_IM_CONT, SCM_CDR (xorig));
} }
@ -3312,6 +3341,7 @@ scm_init_eval ()
SCM_N_EVAL_OPTIONS); SCM_N_EVAL_OPTIONS);
scm_tc16_promise = scm_newsmob (&promsmob); scm_tc16_promise = scm_newsmob (&promsmob);
scm_i_apply = scm_make_subr ("apply", scm_tc7_lsubr_2, scm_apply); scm_i_apply = scm_make_subr ("apply", scm_tc7_lsubr_2, scm_apply);
scm_system_transformer = scm_sysintern ("scm:eval-transformer", SCM_UNDEFINED); scm_system_transformer = scm_sysintern ("scm:eval-transformer", SCM_UNDEFINED);
scm_i_dot = SCM_CAR (scm_sysintern (".", SCM_UNDEFINED)); scm_i_dot = SCM_CAR (scm_sysintern (".", SCM_UNDEFINED));
@ -3321,32 +3351,12 @@ scm_init_eval ()
scm_i_uq_splicing = SCM_CAR (scm_sysintern ("unquote-splicing", SCM_UNDEFINED)); scm_i_uq_splicing = SCM_CAR (scm_sysintern ("unquote-splicing", SCM_UNDEFINED));
/* acros */ /* acros */
scm_i_quasiquote = scm_make_synt (s_quasiquote, scm_makacro, scm_m_quasiquote);
scm_make_synt (s_delay, scm_makacro, scm_m_delay);
/* end of acros */ /* end of acros */
scm_top_level_lookup_closure_var = scm_top_level_lookup_closure_var =
scm_sysintern("*top-level-lookup-closure*", SCM_BOOL_F); scm_sysintern("*top-level-lookup-closure*", SCM_BOOL_F);
scm_can_use_top_level_lookup_closure_var = 1; scm_can_use_top_level_lookup_closure_var = 1;
scm_i_and = scm_make_synt ("and", scm_makmmacro, scm_m_and);
scm_i_begin = scm_make_synt ("begin", scm_makmmacro, scm_m_begin);
scm_i_case = scm_make_synt ("case", scm_makmmacro, scm_m_case);
scm_i_cond = scm_make_synt ("cond", scm_makmmacro, scm_m_cond);
scm_i_define = scm_make_synt ("define", scm_makmmacro, scm_m_define);
scm_i_do = scm_make_synt ("do", scm_makmmacro, scm_m_do);
scm_i_if = scm_make_synt ("if", scm_makmmacro, scm_m_if);
scm_i_lambda = scm_make_synt ("lambda", scm_makmmacro, scm_m_lambda);
scm_i_let = scm_make_synt ("let", scm_makmmacro, scm_m_let);
scm_i_letrec = scm_make_synt ("letrec", scm_makmmacro, scm_m_letrec);
scm_i_letstar = scm_make_synt ("let*", scm_makmmacro, scm_m_letstar);
scm_i_or = scm_make_synt ("or", scm_makmmacro, scm_m_or);
scm_i_quote = scm_make_synt ("quote", scm_makmmacro, scm_m_quote);
scm_i_set = scm_make_synt ("set!", scm_makmmacro, scm_m_set);
scm_i_atapply = scm_make_synt ("@apply", scm_makmmacro, scm_m_apply);
scm_i_atcall_cc = scm_make_synt ("@call-with-current-continuation",
scm_makmmacro, scm_m_cont);
#ifdef DEBUG_EXTENSIONS #ifdef DEBUG_EXTENSIONS
scm_i_enter_frame = SCM_CAR (scm_sysintern ("enter-frame", SCM_UNDEFINED)); scm_i_enter_frame = SCM_CAR (scm_sysintern ("enter-frame", SCM_UNDEFINED));
scm_i_apply_frame = SCM_CAR (scm_sysintern ("apply-frame", SCM_UNDEFINED)); scm_i_apply_frame = SCM_CAR (scm_sysintern ("apply-frame", SCM_UNDEFINED));

4
libguile/evalext.c
View file

@ -94,7 +94,8 @@ scm_definedp (SCM sym, SCM env)
: SCM_BOOL_T); : SCM_BOOL_T);
} }
static char s_undefine[] = "undefine";
SCM_SYNTAX (s_undefine, "undefine", scm_makacro, scm_m_undefine);
SCM SCM
scm_m_undefine (x, env) scm_m_undefine (x, env)
@ -135,6 +136,5 @@ SCM_PROC (s_map_in_order, "map-in-order", 2, 0, 1, scm_map);
void void
scm_init_evalext () scm_init_evalext ()
{ {
scm_make_synt (s_undefine, scm_makacro, scm_m_undefine);
#include "evalext.x" #include "evalext.x"
} }

8
libguile/snarf.h
View file

@ -60,6 +60,14 @@
%%% scm_make_subr(RANAME, TYPE, CFN) %%% scm_make_subr(RANAME, TYPE, CFN)
#endif #endif
#ifndef SCM_MAGIC_SNARFER
#define SCM_SYNTAX(RANAME, STR, TYPE, CFN) \
static char RANAME[]=STR
#else
#define SCM_SYNTAX(RANAME, STR, TYPE, CFN) \
%%% scm_make_synt (RANAME, TYPE, CFN)
#endif
#ifndef SCM_MAGIC_SNARFER #ifndef SCM_MAGIC_SNARFER
#define SCM_SYMBOL(c_name, scheme_name) \ #define SCM_SYMBOL(c_name, scheme_name) \
static SCM c_name = SCM_BOOL_F static SCM c_name = SCM_BOOL_F