diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 4eaf0e6ec..503f0b406 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,29 @@ +2003-05-04 Dirk Herrmann + + The purpose of this patch is to make guile's internal memoizers + distinguishable from memoizing macros created on the scheme level + or from user provided primitive memoizing macros. The reason is, + that the internal memoizers are the only ones that are allowed to + transform their scheme input into memoizer byte code, while all + other memoizing macros may only transform scheme code into new + scheme code. + + To achieve this, a new macro type 'builtin-macro!' is introduced. + Currently, 'builtin-macro!'s are handled as memoizing macros, but + this will change when the memoizer and executor are separated. + + * macros.[ch] (scm_i_makbimacro): New. + + * macros.h (SCM_BUILTIN_MACRO_P): New. + + * macros.c (macro_print, scm_macro_type): Support builtin-macro!s. + + * eval.c, goops.c: All of guile's primitive memoizing macros are + primitive builtin-macros now. + + * eval.c (scm_macroexp, SCM_CEVAL): Make sure the primitive + builtin-macros are handled equally to memoizing macros. + 2003-05-04 Marius Vollmer * throw.c (scm_ithrow): Remove "asm volatile" hack. It used to diff --git a/libguile/eval.c b/libguile/eval.c index dd907d204..3b3d1b4fe 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -455,7 +455,7 @@ scm_m_body (SCM op, SCM xorig, const char *what) /* 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 @@ -470,7 +470,7 @@ scm_m_and (SCM xorig, SCM env SCM_UNUSED) } -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 @@ -481,7 +481,7 @@ scm_m_begin (SCM xorig, SCM env SCM_UNUSED) } -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 @@ -505,7 +505,7 @@ scm_m_case (SCM xorig, SCM env SCM_UNUSED) } -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 @@ -535,7 +535,7 @@ scm_m_cond (SCM xorig, SCM env SCM_UNUSED) } -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 @@ -597,7 +597,7 @@ scm_m_define (SCM x, SCM env) } -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, @@ -631,7 +631,7 @@ scm_m_delay (SCM xorig, SCM env SCM_UNUSED) ... ) ;; 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 @@ -673,7 +673,7 @@ scm_m_do (SCM xorig, SCM env SCM_UNUSED) } -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 @@ -685,7 +685,7 @@ scm_m_if (SCM xorig, SCM env SCM_UNUSED) } -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 @@ -757,7 +757,7 @@ transform_bindings (SCM bindings, SCM *rvarloc, SCM *initloc, const char *what) } -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 @@ -827,7 +827,7 @@ scm_m_let (SCM xorig, SCM env) } -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 @@ -859,7 +859,7 @@ scm_m_letstar (SCM xorig, SCM env SCM_UNUSED) } -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 @@ -884,7 +884,7 @@ scm_m_letrec (SCM xorig, SCM env) } -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 @@ -970,7 +970,7 @@ scm_m_quasiquote (SCM xorig, SCM env) } -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 @@ -982,7 +982,7 @@ scm_m_quote (SCM xorig, SCM env SCM_UNUSED) /* 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); @@ -999,7 +999,7 @@ scm_m_set_x (SCM xorig, SCM env SCM_UNUSED) /* 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); @@ -1028,7 +1028,7 @@ scm_m_apply (SCM xorig, SCM env SCM_UNUSED) 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) @@ -1065,7 +1065,7 @@ 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); @@ -1078,7 +1078,7 @@ scm_m_cont (SCM xorig, SCM env SCM_UNUSED) } -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 @@ -1090,7 +1090,7 @@ scm_m_at_call_with_values (SCM xorig, SCM env SCM_UNUSED) } -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 @@ -1106,7 +1106,7 @@ scm_m_future (SCM xorig, SCM env SCM_UNUSED) } -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 @@ -1162,7 +1162,7 @@ scm_m_atslot_set_x (SCM xorig, SCM env SCM_UNUSED) #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) @@ -1173,7 +1173,7 @@ 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) @@ -1305,7 +1305,8 @@ scm_macroexp (SCM x, SCM env) /* 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 */ @@ -2771,6 +2772,7 @@ dispatch: #endif switch (SCM_MACRO_TYPE (proc)) { + case 3: case 2: if (scm_ilength (arg1) <= 0) arg1 = scm_list_2 (SCM_IM_BEGIN, arg1); diff --git a/libguile/goops.c b/libguile/goops.c index de0123585..1a2bb7304 100644 --- a/libguile/goops.c +++ b/libguile/goops.c @@ -1102,8 +1102,8 @@ SCM_DEFINE (scm_sys_fast_slot_set_x, "%fast-slot-set!", 3, 0, 0, #undef FUNC_NAME -SCM_SYNTAX (s_atslot_ref, "@slot-ref", scm_makmmacro, scm_m_atslot_ref); -SCM_SYNTAX (s_atslot_set_x, "@slot-set!", scm_makmmacro, scm_m_atslot_set_x); +SCM_SYNTAX (s_atslot_ref, "@slot-ref", scm_i_makbimacro, scm_m_atslot_ref); +SCM_SYNTAX (s_atslot_set_x, "@slot-set!", scm_i_makbimacro, scm_m_atslot_set_x); /** Utilities **/ diff --git a/libguile/macros.c b/libguile/macros.c index 2ddf7a4d6..32282f19c 100644 --- a/libguile/macros.c +++ b/libguile/macros.c @@ -1,4 +1,4 @@ -/* 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 @@ -55,6 +55,9 @@ macro_print (SCM macro, SCM port, scm_print_state *pstate) #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); @@ -75,6 +78,35 @@ macro_print (SCM macro, SCM port, scm_print_state *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" @@ -119,24 +151,6 @@ SCM_DEFINE (scm_makmacro, "procedure->macro", 1, 0, 0, #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" @@ -153,6 +167,7 @@ SCM_SYMBOL (scm_sym_syntax, "syntax"); 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), @@ -172,6 +187,7 @@ SCM_DEFINE (scm_macro_type, "macro-type", 1, 0, 0, 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); } } diff --git a/libguile/macros.h b/libguile/macros.h index 7f9469b27..c53f21038 100644 --- a/libguile/macros.h +++ b/libguile/macros.h @@ -3,7 +3,7 @@ #ifndef SCM_MACROS_H #define SCM_MACROS_H -/* Copyright (C) 1998,2000,2001,2002 Free Software Foundation, Inc. +/* Copyright (C) 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 @@ -31,12 +31,14 @@ #define SCM_MACROP(x) SCM_TYP16_PREDICATE (scm_tc16_macro, (x)) #define SCM_MACRO_TYPE(m) (SCM_CELL_WORD_0 (m) >> 16) +#define SCM_BUILTIN_MACRO_P(x) (SCM_MACROP (x) && SCM_MACRO_TYPE (x) == 3) #define SCM_MACRO_CODE(m) SCM_CELL_OBJECT_1 (m) SCM_API scm_t_bits scm_tc16_macro; -SCM_API SCM scm_makacro (SCM code); +SCM_API SCM scm_i_makbimacro (SCM code); SCM_API SCM scm_makmmacro (SCM code); +SCM_API SCM scm_makacro (SCM code); SCM_API SCM scm_macro_p (SCM obj); SCM_API SCM scm_macro_type (SCM m); SCM_API SCM scm_macro_name (SCM m);