1 |
/* 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. |
2 |
* |
* |
3 |
* This library is free software; you can redistribute it and/or |
* This library is free software; you can redistribute it and/or |
4 |
* modify it under the terms of the GNU Lesser General Public |
* modify it under the terms of the GNU Lesser General Public |
55 |
#endif |
#endif |
56 |
if (SCM_MACRO_TYPE (macro) == 2) |
if (SCM_MACRO_TYPE (macro) == 2) |
57 |
scm_puts ("macro!", port); |
scm_puts ("macro!", port); |
58 |
|
if (SCM_MACRO_TYPE (macro) == 3) |
59 |
|
scm_puts ("builtin-macro!", port); |
60 |
|
|
61 |
scm_putc (' ', port); |
scm_putc (' ', port); |
62 |
scm_iprin1 (scm_macro_name (macro), port, pstate); |
scm_iprin1 (scm_macro_name (macro), port, pstate); |
63 |
|
|
78 |
} |
} |
79 |
|
|
80 |
|
|
81 |
|
/* Return a mmacro that is known to be one of guile's built in macros. */ |
82 |
|
SCM |
83 |
|
scm_i_makbimacro (SCM code) |
84 |
|
#define FUNC_NAME "scm_i_makbimacro" |
85 |
|
{ |
86 |
|
SCM_VALIDATE_PROC (1, code); |
87 |
|
SCM_RETURN_NEWSMOB (scm_tc16_macro | (3L << 16), SCM_UNPACK (code)); |
88 |
|
} |
89 |
|
#undef FUNC_NAME |
90 |
|
|
91 |
|
|
92 |
|
SCM_DEFINE (scm_makmmacro, "procedure->memoizing-macro", 1, 0, 0, |
93 |
|
(SCM code), |
94 |
|
"Return a @dfn{macro} which, when a symbol defined to this value\n" |
95 |
|
"appears as the first symbol in an expression, evaluates the\n" |
96 |
|
"result of applying @var{code} to the expression and the\n" |
97 |
|
"environment.\n\n" |
98 |
|
"@code{procedure->memoizing-macro} is the same as\n" |
99 |
|
"@code{procedure->macro}, except that the expression returned by\n" |
100 |
|
"@var{code} replaces the original macro expression in the memoized\n" |
101 |
|
"form of the containing code.") |
102 |
|
#define FUNC_NAME s_scm_makmmacro |
103 |
|
{ |
104 |
|
SCM_VALIDATE_PROC (1, code); |
105 |
|
SCM_RETURN_NEWSMOB (scm_tc16_macro | (2L << 16), SCM_UNPACK (code)); |
106 |
|
} |
107 |
|
#undef FUNC_NAME |
108 |
|
|
109 |
|
|
110 |
SCM_DEFINE (scm_makacro, "procedure->syntax", 1, 0, 0, |
SCM_DEFINE (scm_makacro, "procedure->syntax", 1, 0, 0, |
111 |
(SCM code), |
(SCM code), |
112 |
"Return a @dfn{macro} which, when a symbol defined to this value\n" |
"Return a @dfn{macro} which, when a symbol defined to this value\n" |
151 |
#endif |
#endif |
152 |
|
|
153 |
|
|
|
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 |
|
|
|
|
|
|
|
154 |
SCM_DEFINE (scm_macro_p, "macro?", 1, 0, 0, |
SCM_DEFINE (scm_macro_p, "macro?", 1, 0, 0, |
155 |
(SCM obj), |
(SCM obj), |
156 |
"Return @code{#t} if @var{obj} is a regular macro, a memoizing macro or a\n" |
"Return @code{#t} if @var{obj} is a regular macro, a memoizing macro or a\n" |
167 |
SCM_SYMBOL (scm_sym_macro, "macro"); |
SCM_SYMBOL (scm_sym_macro, "macro"); |
168 |
#endif |
#endif |
169 |
SCM_SYMBOL (scm_sym_mmacro, "macro!"); |
SCM_SYMBOL (scm_sym_mmacro, "macro!"); |
170 |
|
SCM_SYMBOL (scm_sym_bimacro, "builtin-macro!"); |
171 |
|
|
172 |
SCM_DEFINE (scm_macro_type, "macro-type", 1, 0, 0, |
SCM_DEFINE (scm_macro_type, "macro-type", 1, 0, 0, |
173 |
(SCM m), |
(SCM m), |
187 |
case 1: return scm_sym_macro; |
case 1: return scm_sym_macro; |
188 |
#endif |
#endif |
189 |
case 2: return scm_sym_mmacro; |
case 2: return scm_sym_mmacro; |
190 |
|
case 3: return scm_sym_bimacro; |
191 |
default: scm_wrong_type_arg (FUNC_NAME, 1, m); |
default: scm_wrong_type_arg (FUNC_NAME, 1, m); |
192 |
} |
} |
193 |
} |
} |