/* Start of the memoizers for the standard R5RS builtin macros. */
-SCM_SYNTAX (s_and, "and", scm_makmmacro, scm_m_and);
+SCM_SYNTAX (s_and, "and", scm_i_makbimacro, scm_m_and);
SCM_GLOBAL_SYMBOL (scm_sym_and, s_and);
SCM
}
-SCM_SYNTAX (s_begin, "begin", scm_makmmacro, scm_m_begin);
+SCM_SYNTAX (s_begin, "begin", scm_i_makbimacro, scm_m_begin);
SCM_GLOBAL_SYMBOL (scm_sym_begin, s_begin);
SCM
}
-SCM_SYNTAX (s_case, "case", scm_makmmacro, scm_m_case);
+SCM_SYNTAX (s_case, "case", scm_i_makbimacro, scm_m_case);
SCM_GLOBAL_SYMBOL (scm_sym_case, s_case);
SCM
}
-SCM_SYNTAX (s_cond, "cond", scm_makmmacro, scm_m_cond);
+SCM_SYNTAX (s_cond, "cond", scm_i_makbimacro, scm_m_cond);
SCM_GLOBAL_SYMBOL (scm_sym_cond, s_cond);
SCM
}
-SCM_SYNTAX(s_define, "define", scm_makmmacro, scm_m_define);
+SCM_SYNTAX(s_define, "define", scm_i_makbimacro, scm_m_define);
SCM_GLOBAL_SYMBOL(scm_sym_define, s_define);
/* Guile provides an extension to R5RS' define syntax to represent function
}
-SCM_SYNTAX (s_delay, "delay", scm_makmmacro, scm_m_delay);
+SCM_SYNTAX (s_delay, "delay", scm_i_makbimacro, scm_m_delay);
SCM_GLOBAL_SYMBOL (scm_sym_delay, s_delay);
/* Promises are implemented as closures with an empty parameter list. Thus,
<step1> <step2> ... <stepn>) ;; missing steps replaced by var
*/
-SCM_SYNTAX(s_do, "do", scm_makmmacro, scm_m_do);
+SCM_SYNTAX(s_do, "do", scm_i_makbimacro, scm_m_do);
SCM_GLOBAL_SYMBOL(scm_sym_do, s_do);
SCM
}
-SCM_SYNTAX (s_if, "if", scm_makmmacro, scm_m_if);
+SCM_SYNTAX (s_if, "if", scm_i_makbimacro, scm_m_if);
SCM_GLOBAL_SYMBOL (scm_sym_if, s_if);
SCM
}
-SCM_SYNTAX (s_lambda, "lambda", scm_makmmacro, scm_m_lambda);
+SCM_SYNTAX (s_lambda, "lambda", scm_i_makbimacro, scm_m_lambda);
SCM_GLOBAL_SYMBOL (scm_sym_lambda, s_lambda);
/* Return true if OBJ is `eq?' to one of the elements of LIST or to the
}
-SCM_SYNTAX(s_let, "let", scm_makmmacro, scm_m_let);
+SCM_SYNTAX(s_let, "let", scm_i_makbimacro, scm_m_let);
SCM_GLOBAL_SYMBOL(scm_sym_let, s_let);
SCM
}
-SCM_SYNTAX (s_letstar, "let*", scm_makmmacro, scm_m_letstar);
+SCM_SYNTAX (s_letstar, "let*", scm_i_makbimacro, scm_m_letstar);
SCM_GLOBAL_SYMBOL (scm_sym_letstar, s_letstar);
/* (let* ((v1 i1) (v2 i2) ...) body) with variables v1 .. vk and initializers
}
-SCM_SYNTAX(s_letrec, "letrec", scm_makmmacro, scm_m_letrec);
+SCM_SYNTAX(s_letrec, "letrec", scm_i_makbimacro, scm_m_letrec);
SCM_GLOBAL_SYMBOL(scm_sym_letrec, s_letrec);
SCM
}
-SCM_SYNTAX (s_or, "or", scm_makmmacro, scm_m_or);
+SCM_SYNTAX (s_or, "or", scm_i_makbimacro, scm_m_or);
SCM_GLOBAL_SYMBOL (scm_sym_or, s_or);
SCM
}
-SCM_SYNTAX (s_quote, "quote", scm_makmmacro, scm_m_quote);
+SCM_SYNTAX (s_quote, "quote", scm_i_makbimacro, scm_m_quote);
SCM_GLOBAL_SYMBOL (scm_sym_quote, s_quote);
SCM
/* Will go into the RnRS module when Guile is factorized.
-SCM_SYNTAX (s_set_x, "set!", scm_makmmacro, scm_m_set_x); */
+SCM_SYNTAX (s_set_x, "set!", scm_i_makbimacro, scm_m_set_x); */
static const char s_set_x[] = "set!";
SCM_GLOBAL_SYMBOL (scm_sym_set_x, s_set_x);
/* Start of the memoizers for non-R5RS builtin macros. */
-SCM_SYNTAX (s_atapply, "@apply", scm_makmmacro, scm_m_apply);
+SCM_SYNTAX (s_atapply, "@apply", scm_i_makbimacro, scm_m_apply);
SCM_GLOBAL_SYMBOL (scm_sym_atapply, s_atapply);
SCM_GLOBAL_SYMBOL (scm_sym_apply, s_atapply + 1);
XXX - also implement `@bind*'.
*/
-SCM_SYNTAX (s_atbind, "@bind", scm_makmmacro, scm_m_atbind);
+SCM_SYNTAX (s_atbind, "@bind", scm_i_makbimacro, scm_m_atbind);
SCM
scm_m_atbind (SCM xorig, SCM env)
}
-SCM_SYNTAX(s_atcall_cc, "@call-with-current-continuation", scm_makmmacro, scm_m_cont);
+SCM_SYNTAX(s_atcall_cc, "@call-with-current-continuation", scm_i_makbimacro, scm_m_cont);
SCM_GLOBAL_SYMBOL(scm_sym_atcall_cc, s_atcall_cc);
}
-SCM_SYNTAX (s_at_call_with_values, "@call-with-values", scm_makmmacro, scm_m_at_call_with_values);
+SCM_SYNTAX (s_at_call_with_values, "@call-with-values", scm_i_makbimacro, scm_m_at_call_with_values);
SCM_GLOBAL_SYMBOL(scm_sym_at_call_with_values, s_at_call_with_values);
SCM
}
-SCM_SYNTAX (s_future, "future", scm_makmmacro, scm_m_future);
+SCM_SYNTAX (s_future, "future", scm_i_makbimacro, scm_m_future);
SCM_GLOBAL_SYMBOL (scm_sym_future, s_future);
/* Like promises, futures are implemented as closures with an empty
}
-SCM_SYNTAX (s_gset_x, "set!", scm_makmmacro, scm_m_generalized_set_x);
+SCM_SYNTAX (s_gset_x, "set!", scm_i_makbimacro, scm_m_generalized_set_x);
SCM_SYMBOL (scm_sym_setter, "setter");
SCM
#if SCM_ENABLE_ELISP
-SCM_SYNTAX (s_nil_cond, "nil-cond", scm_makmmacro, scm_m_nil_cond);
+SCM_SYNTAX (s_nil_cond, "nil-cond", scm_i_makbimacro, scm_m_nil_cond);
SCM
scm_m_nil_cond (SCM xorig, SCM env SCM_UNUSED)
}
-SCM_SYNTAX (s_atfop, "@fop", scm_makmmacro, scm_m_atfop);
+SCM_SYNTAX (s_atfop, "@fop", scm_i_makbimacro, scm_m_atfop);
SCM
scm_m_atfop (SCM xorig, SCM env SCM_UNUSED)
/* Only handle memoizing macros. `Acros' and `macros' are really
special forms and should not be evaluated here. */
- if (!SCM_MACROP (proc) || SCM_MACRO_TYPE (proc) != 2)
+ if (!SCM_MACROP (proc)
+ || (SCM_MACRO_TYPE (proc) != 2 && !SCM_BUILTIN_MACRO_P (proc)))
return x;
SCM_SETCAR (x, orig_sym); /* Undo memoizing effect of lookupcar */
#endif
switch (SCM_MACRO_TYPE (proc))
{
+ case 3:
case 2:
if (scm_ilength (arg1) <= 0)
arg1 = scm_list_2 (SCM_IM_BEGIN, arg1);
-/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
#endif
if (SCM_MACRO_TYPE (macro) == 2)
scm_puts ("macro!", port);
+ if (SCM_MACRO_TYPE (macro) == 3)
+ scm_puts ("builtin-macro!", port);
+
scm_putc (' ', port);
scm_iprin1 (scm_macro_name (macro), port, pstate);
}
+/* Return a mmacro that is known to be one of guile's built in macros. */
+SCM
+scm_i_makbimacro (SCM code)
+#define FUNC_NAME "scm_i_makbimacro"
+{
+ SCM_VALIDATE_PROC (1, code);
+ SCM_RETURN_NEWSMOB (scm_tc16_macro | (3L << 16), SCM_UNPACK (code));
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_makmmacro, "procedure->memoizing-macro", 1, 0, 0,
+ (SCM code),
+ "Return a @dfn{macro} which, when a symbol defined to this value\n"
+ "appears as the first symbol in an expression, evaluates the\n"
+ "result of applying @var{code} to the expression and the\n"
+ "environment.\n\n"
+ "@code{procedure->memoizing-macro} is the same as\n"
+ "@code{procedure->macro}, except that the expression returned by\n"
+ "@var{code} replaces the original macro expression in the memoized\n"
+ "form of the containing code.")
+#define FUNC_NAME s_scm_makmmacro
+{
+ SCM_VALIDATE_PROC (1, code);
+ SCM_RETURN_NEWSMOB (scm_tc16_macro | (2L << 16), SCM_UNPACK (code));
+}
+#undef FUNC_NAME
+
+
SCM_DEFINE (scm_makacro, "procedure->syntax", 1, 0, 0,
(SCM code),
"Return a @dfn{macro} which, when a symbol defined to this value\n"
#endif
-SCM_DEFINE (scm_makmmacro, "procedure->memoizing-macro", 1, 0, 0,
- (SCM code),
- "Return a @dfn{macro} which, when a symbol defined to this value\n"
- "appears as the first symbol in an expression, evaluates the\n"
- "result of applying @var{code} to the expression and the\n"
- "environment.\n\n"
- "@code{procedure->memoizing-macro} is the same as\n"
- "@code{procedure->macro}, except that the expression returned by\n"
- "@var{code} replaces the original macro expression in the memoized\n"
- "form of the containing code.")
-#define FUNC_NAME s_scm_makmmacro
-{
- SCM_VALIDATE_PROC (1, code);
- SCM_RETURN_NEWSMOB (scm_tc16_macro | (2L << 16), SCM_UNPACK (code));
-}
-#undef FUNC_NAME
-
-
SCM_DEFINE (scm_macro_p, "macro?", 1, 0, 0,
(SCM obj),
"Return @code{#t} if @var{obj} is a regular macro, a memoizing macro or a\n"
SCM_SYMBOL (scm_sym_macro, "macro");
#endif
SCM_SYMBOL (scm_sym_mmacro, "macro!");
+SCM_SYMBOL (scm_sym_bimacro, "builtin-macro!");
SCM_DEFINE (scm_macro_type, "macro-type", 1, 0, 0,
(SCM m),
case 1: return scm_sym_macro;
#endif
case 2: return scm_sym_mmacro;
+ case 3: return scm_sym_bimacro;
default: scm_wrong_type_arg (FUNC_NAME, 1, m);
}
}
HCoop / bpt / guile.git / commitdiff