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

remove mmacros, SCM_SYNTAX snarf macro

Browse source 
* libguile/snarf.h (SCM_SYNTAX): Remove snarf macro, users can't define
  primitive syntax any more.

* libguile/memoize.c (SCM_SYNTAX): Define locally, and just call
  scm_i_makbimacro as there's no difference between that and
  scm_makmmacro. Alter invocations to suit.

* libguile/macros.h:
* libguile/macros.c (scm_i_makmmacro): Remove; users can't define
  primitive syntax any more. Use define-syntax instead.
  (scm_make_synt): Remove, this was only used by the SCM_SYNTAX snarf
  macro.
  (scm_i_makbimacro): Change prototype of this internal function to make
  the gsubr on behalf of the caller.
  (macro_print, scm_macro_type): Remove cases for mmacros.
This commit is contained in:
Andy Wingo 2010-01-05 11:05:12 +01:00
parent 9f09b127d4
commit bab9804661
4 changed files with 27 additions and 65 deletions
Download patch file Download diff file Expand all files Collapse all files

38
libguile/macros.c
View file

@ -56,8 +56,6 @@ macro_print (SCM macro, SCM port, scm_print_state *pstate)
if (!SCM_PROGRAM_P (code)) if (!SCM_PROGRAM_P (code))
scm_puts ("primitive-", port); scm_puts ("primitive-", port);
if (SCM_MACRO_TYPE (macro) == 2)
scm_puts ("macro!", port);
if (SCM_MACRO_TYPE (macro) == 3) if (SCM_MACRO_TYPE (macro) == 3)
scm_puts ("builtin-macro!", port); scm_puts ("builtin-macro!", port);
if (SCM_MACRO_TYPE (macro) == 4) if (SCM_MACRO_TYPE (macro) == 4)
@ -90,31 +88,10 @@ makmac (SCM code, scm_t_bits flags)
/* Return a mmacro that is known to be one of guile's built in macros. */ /* Return a mmacro that is known to be one of guile's built in macros. */
SCM SCM
scm_i_makbimacro (SCM code) scm_i_makbimacro (const char *name, SCM (*fn)(SCM, SCM))
#define FUNC_NAME "scm_i_makbimacro"
{ {
SCM_VALIDATE_PROC (1, code); return makmac (scm_c_make_gsubr (name, 2, 0, 0, fn), 3);
return makmac (code, 3);
} }
#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);
return makmac (code, 2);
}
#undef FUNC_NAME
SCM_DEFINE (scm_make_syncase_macro, "make-syncase-macro", 2, 0, 0, SCM_DEFINE (scm_make_syncase_macro, "make-syncase-macro", 2, 0, 0,
@ -163,7 +140,6 @@ SCM_DEFINE (scm_macro_p, "macro?", 1, 0, 0,
#undef FUNC_NAME #undef FUNC_NAME
SCM_SYMBOL (scm_sym_mmacro, "macro!");
SCM_SYMBOL (scm_sym_bimacro, "builtin-macro!"); SCM_SYMBOL (scm_sym_bimacro, "builtin-macro!");
SCM_SYMBOL (scm_sym_syncase_macro, "syncase-macro"); SCM_SYMBOL (scm_sym_syncase_macro, "syncase-macro");
@ -180,7 +156,6 @@ SCM_DEFINE (scm_macro_type, "macro-type", 1, 0, 0,
return SCM_BOOL_F; return SCM_BOOL_F;
switch (SCM_MACRO_TYPE (m)) switch (SCM_MACRO_TYPE (m))
{ {
case 2: return scm_sym_mmacro;
case 3: return scm_sym_bimacro; case 3: return scm_sym_bimacro;
case 4: return scm_sym_syncase_macro; case 4: return scm_sym_syncase_macro;
default: scm_wrong_type_arg (FUNC_NAME, 1, m); default: scm_wrong_type_arg (FUNC_NAME, 1, m);
@ -247,15 +222,6 @@ SCM_DEFINE (scm_syncase_macro_binding, "syncase-macro-binding", 1, 0, 0,
} }
#undef FUNC_NAME #undef FUNC_NAME
SCM
scm_make_synt (const char *name, SCM (*macroizer) (), SCM (*fcn)() )
{
SCM var = scm_c_define (name, SCM_UNDEFINED);
SCM transformer = scm_c_make_gsubr (name, 2, 0, 0, fcn);
SCM_VARIABLE_SET (var, macroizer (transformer));
return SCM_UNSPECIFIED;
}
void void
scm_init_macros () scm_init_macros ()
{ {

6
libguile/macros.h
View file

@ -43,8 +43,7 @@
SCM_API scm_t_bits scm_tc16_macro; SCM_API scm_t_bits scm_tc16_macro;
SCM_INTERNAL SCM scm_i_makbimacro (SCM code); SCM_INTERNAL SCM scm_i_makbimacro (const char *name, SCM (*fn)(SCM,SCM));
SCM_API SCM scm_makmmacro (SCM code);
SCM_API SCM scm_make_syncase_macro (SCM type, SCM binding); SCM_API SCM scm_make_syncase_macro (SCM type, SCM binding);
SCM_API SCM scm_make_extended_syncase_macro (SCM builtin, SCM type, SCM_API SCM scm_make_extended_syncase_macro (SCM builtin, SCM type,
SCM binding); SCM binding);
@ -54,9 +53,6 @@ SCM_API SCM scm_macro_name (SCM m);
SCM_API SCM scm_macro_transformer (SCM m); SCM_API SCM scm_macro_transformer (SCM m);
SCM_API SCM scm_syncase_macro_type (SCM m); SCM_API SCM scm_syncase_macro_type (SCM m);
SCM_API SCM scm_syncase_macro_binding (SCM m); SCM_API SCM scm_syncase_macro_binding (SCM m);
SCM_API SCM scm_make_synt (const char *name,
SCM (*macroizer) (SCM),
SCM (*fcn) ());
SCM_INTERNAL void scm_init_macros (void); SCM_INTERNAL void scm_init_macros (void);

42
libguile/memoize.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009 /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009,2010
* Free Software Foundation, Inc. * Free Software Foundation, Inc.
* *
* This library is free software; you can redistribute it and/or * This library is free software; you can redistribute it and/or
@ -390,27 +390,31 @@ memoize_sequence (const SCM forms, const SCM env)
/* Memoization. */ /* Memoization. */
#define SCM_SYNTAX(RANAME, STR, CFN) \
SCM_SNARF_HERE(static const char RANAME[]=STR)\
SCM_SNARF_INIT(scm_c_define (RANAME, scm_i_makbimacro (RANAME, CFN)))
/* bimacros (built-in macros) have isym codes. /* bimacros (built-in macros) have isym codes.
mmacros don't exist at runtime, they just expand out to more primitive mmacros don't exist at runtime, they just expand out to more primitive
forms. */ forms. */
SCM_SYNTAX (s_at, "@", scm_i_makbimacro, scm_m_at); SCM_SYNTAX (s_at, "@", scm_m_at);
SCM_SYNTAX (s_atat, "@@", scm_i_makbimacro, scm_m_atat); SCM_SYNTAX (s_atat, "@@", scm_m_atat);
SCM_SYNTAX (s_and, "and", scm_makmmacro, scm_m_and); SCM_SYNTAX (s_and, "and", scm_m_and);
SCM_SYNTAX (s_begin, "begin", scm_i_makbimacro, scm_m_begin); SCM_SYNTAX (s_begin, "begin", scm_m_begin);
SCM_SYNTAX (s_atcall_cc, "@call-with-current-continuation", scm_i_makbimacro, scm_m_cont); SCM_SYNTAX (s_atcall_cc, "@call-with-current-continuation", scm_m_cont);
SCM_SYNTAX (s_at_call_with_values, "@call-with-values", scm_i_makbimacro, scm_m_at_call_with_values); SCM_SYNTAX (s_at_call_with_values, "@call-with-values", scm_m_at_call_with_values);
SCM_SYNTAX (s_cond, "cond", scm_makmmacro, scm_m_cond); SCM_SYNTAX (s_cond, "cond", scm_m_cond);
SCM_SYNTAX (s_define, "define", scm_i_makbimacro, scm_m_define); SCM_SYNTAX (s_define, "define", scm_m_define);
SCM_SYNTAX (s_eval_when, "eval-when", scm_makmmacro, scm_m_eval_when); SCM_SYNTAX (s_eval_when, "eval-when", scm_m_eval_when);
SCM_SYNTAX (s_if, "if", scm_i_makbimacro, scm_m_if); SCM_SYNTAX (s_if, "if", scm_m_if);
SCM_SYNTAX (s_lambda, "lambda", scm_i_makbimacro, scm_m_lambda); SCM_SYNTAX (s_lambda, "lambda", scm_m_lambda);
SCM_SYNTAX (s_let, "let", scm_i_makbimacro, scm_m_let); SCM_SYNTAX (s_let, "let", scm_m_let);
SCM_SYNTAX (s_letrec, "letrec", scm_makmmacro, scm_m_letrec); SCM_SYNTAX (s_letrec, "letrec", scm_m_letrec);
SCM_SYNTAX (s_letstar, "let*", scm_makmmacro, scm_m_letstar); SCM_SYNTAX (s_letstar, "let*", scm_m_letstar);
SCM_SYNTAX (s_or, "or", scm_makmmacro, scm_m_or); SCM_SYNTAX (s_or, "or", scm_m_or);
SCM_SYNTAX (s_quote, "quote", scm_i_makbimacro, scm_m_quote); SCM_SYNTAX (s_quote, "quote", scm_m_quote);
SCM_SYNTAX (s_set_x, "set!", scm_i_makbimacro, scm_m_set_x); SCM_SYNTAX (s_set_x, "set!", scm_m_set_x);
SCM_SYNTAX (s_atapply, "@apply", scm_i_makbimacro, scm_m_apply); SCM_SYNTAX (s_atapply, "@apply", scm_m_apply);
SCM_GLOBAL_SYMBOL (scm_sym_apply, "apply"); SCM_GLOBAL_SYMBOL (scm_sym_apply, "apply");

6
libguile/snarf.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_SNARF_H #ifndef SCM_SNARF_H
#define SCM_SNARF_H #define SCM_SNARF_H
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006, 2009 Free Software Foundation, Inc. /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006, 2009, 2010 Free Software Foundation, Inc.
* *
* This library is free software; you can redistribute it and/or * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * modify it under the terms of the GNU Lesser General Public License
@ -211,10 +211,6 @@ scm_c_define_subr_with_generic (RANAME, TYPE, \
(SCM_FUNC_CAST_ARBITRARY_ARGS) CFN, &GF) \ (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN, &GF) \
) )
#define SCM_SYNTAX(RANAME, STR, TYPE, CFN) \
SCM_SNARF_HERE(static const char RANAME[]=STR)\
SCM_SNARF_INIT(scm_make_synt (RANAME, TYPE, CFN))
#ifdef SCM_SUPPORT_STATIC_ALLOCATION #ifdef SCM_SUPPORT_STATIC_ALLOCATION
# define SCM_SYMBOL(c_name, scheme_name) \ # define SCM_SYMBOL(c_name, scheme_name) \