Commit | Line | Data |
---|---|---|
9f09b127 | 1 | /* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003, 2006, 2008, 2009, 2010 Free Software Foundation, Inc. |
99027e3c | 2 | * |
73be1d9e | 3 | * This library is free software; you can redistribute it and/or |
53befeb7 NJ |
4 | * modify it under the terms of the GNU Lesser General Public License |
5 | * as published by the Free Software Foundation; either version 3 of | |
6 | * the License, or (at your option) any later version. | |
99027e3c | 7 | * |
53befeb7 NJ |
8 | * This library is distributed in the hope that it will be useful, but |
9 | * WITHOUT ANY WARRANTY; without even the implied warranty of | |
73be1d9e MV |
10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
11 | * Lesser General Public License for more details. | |
99027e3c | 12 | * |
73be1d9e MV |
13 | * You should have received a copy of the GNU Lesser General Public |
14 | * License along with this library; if not, write to the Free Software | |
53befeb7 NJ |
15 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
16 | * 02110-1301 USA | |
73be1d9e | 17 | */ |
1bbd0b84 | 18 | |
1bbd0b84 | 19 | |
99027e3c | 20 | \f |
dbb605f5 LC |
21 | #ifdef HAVE_CONFIG_H |
22 | # include <config.h> | |
23 | #endif | |
99027e3c | 24 | |
a0599745 | 25 | #include "libguile/_scm.h" |
726d810a DH |
26 | #include "libguile/ports.h" |
27 | #include "libguile/print.h" | |
a0599745 | 28 | #include "libguile/smob.h" |
a0599745 MD |
29 | #include "libguile/validate.h" |
30 | #include "libguile/macros.h" | |
99027e3c | 31 | |
22fc179a HWN |
32 | #include "libguile/private-options.h" |
33 | ||
726d810a | 34 | |
e809758a | 35 | static scm_t_bits scm_tc16_macro; |
5a0132b3 | 36 | |
e809758a AW |
37 | #define SCM_MACROP(x) SCM_SMOB_PREDICATE (scm_tc16_macro, (x)) |
38 | #define SCM_MACRO_PRIMITIVE(m) ((scm_t_macro_primitive)SCM_SMOB_DATA (m)) | |
39 | #define SCM_MACRO_NAME(m) (SCM_SMOB_OBJECT_2 (m)) | |
40 | #define SCM_MACRO_TYPE(m) (SCM_SMOB_OBJECT_3 (m)) | |
41 | #define SCM_MACRO_BINDING(m) (SCM_CELL_OBJECT ((m), 4)) | |
42 | #define SCM_VALIDATE_MACRO(p,v) SCM_MAKE_VALIDATE ((p), (v), MACROP) | |
314b8716 | 43 | |
5a0132b3 | 44 | |
e809758a | 45 | SCM_API scm_t_bits scm_tc16_macro; |
726d810a | 46 | |
726d810a | 47 | |
e809758a AW |
48 | static int |
49 | macro_print (SCM macro, SCM port, scm_print_state *pstate) | |
50 | { | |
51 | if (scm_is_false (SCM_MACRO_TYPE (macro))) | |
52 | scm_puts ("#<primitive-syntax-transformer ", port); | |
53 | else | |
54 | scm_puts ("#<syntax-transformer ", port); | |
314b8716 | 55 | scm_iprin1 (scm_macro_name (macro), port, pstate); |
314b8716 AW |
56 | scm_putc ('>', port); |
57 | ||
726d810a DH |
58 | return 1; |
59 | } | |
60 | ||
e809758a AW |
61 | /* Return a mmacro that is known to be one of guile's built in macros. */ |
62 | SCM | |
63 | scm_i_make_primitive_macro (const char *name, scm_t_macro_primitive fn) | |
f5710d53 | 64 | { |
e809758a AW |
65 | SCM z = scm_words (scm_tc16_macro, 5); |
66 | SCM_SET_SMOB_DATA_N (z, 1, (scm_t_bits)fn); | |
67 | SCM_SET_SMOB_DATA_N (z, 2, scm_from_locale_symbol (name)); | |
68 | SCM_SET_SMOB_DATA_N (z, 3, SCM_BOOL_F); | |
69 | SCM_SET_SMOB_DATA_N (z, 4, SCM_BOOL_F); | |
f5710d53 MV |
70 | return z; |
71 | } | |
726d810a | 72 | |
e809758a AW |
73 | scm_t_macro_primitive |
74 | scm_i_macro_primitive (SCM macro) | |
3b88ed2a | 75 | { |
e809758a | 76 | return SCM_MACRO_PRIMITIVE (macro); |
3b88ed2a | 77 | } |
3b88ed2a DH |
78 | |
79 | ||
e809758a AW |
80 | SCM_DEFINE (scm_make_syntax_transformer, "make-syntax-transformer", 3, 0, 0, |
81 | (SCM name, SCM type, SCM binding), | |
82 | "Construct a @dfn{syntax transformer}.\n\n" | |
83 | "This function is part of Guile's low-level support for the psyntax\n" | |
84 | "syntax expander. Users should not call this function.") | |
85 | #define FUNC_NAME s_scm_make_syntax_transformer | |
5a0132b3 AW |
86 | { |
87 | SCM z; | |
e809758a | 88 | SCM (*prim)(SCM,SCM) = NULL; |
5a0132b3 | 89 | |
e809758a AW |
90 | if (scm_is_true (name)) |
91 | { | |
92 | SCM existing_var; | |
93 | ||
94 | SCM_VALIDATE_SYMBOL (1, name); | |
95 | existing_var = scm_sym2var (name, scm_current_module_lookup_closure (), | |
96 | SCM_BOOL_F); | |
97 | if (scm_is_true (existing_var) | |
98 | && scm_is_true (scm_variable_bound_p (existing_var)) | |
99 | && SCM_MACROP (SCM_VARIABLE_REF (existing_var))) | |
100 | prim = SCM_MACRO_PRIMITIVE (SCM_VARIABLE_REF (existing_var)); | |
101 | } | |
5a0132b3 | 102 | |
5a0132b3 AW |
103 | SCM_VALIDATE_SYMBOL (2, type); |
104 | ||
e809758a AW |
105 | z = scm_words (scm_tc16_macro, 5); |
106 | SCM_SET_SMOB_DATA_N (z, 1, prim); | |
107 | SCM_SET_SMOB_DATA_N (z, 2, name); | |
108 | SCM_SET_SMOB_DATA_N (z, 3, type); | |
109 | SCM_SET_SMOB_DATA_N (z, 4, binding); | |
5a0132b3 AW |
110 | return z; |
111 | } | |
112 | #undef FUNC_NAME | |
113 | ||
a1ec6916 | 114 | SCM_DEFINE (scm_macro_p, "macro?", 1, 0, 0, |
1bbd0b84 | 115 | (SCM obj), |
e809758a AW |
116 | "Return @code{#t} if @var{obj} is a syntax transformer (an object that " |
117 | "transforms Scheme expressions at expansion-time).\n\n" | |
118 | "Macros are actually just one kind of syntax transformer; this\n" | |
119 | "procedure has its name due to historical reasons.") | |
1bbd0b84 | 120 | #define FUNC_NAME s_scm_macro_p |
99027e3c | 121 | { |
e809758a | 122 | return scm_from_bool (SCM_MACROP (obj)); |
99027e3c | 123 | } |
1bbd0b84 | 124 | #undef FUNC_NAME |
99027e3c | 125 | |
a1ec6916 | 126 | SCM_DEFINE (scm_macro_type, "macro-type", 1, 0, 0, |
1bbd0b84 | 127 | (SCM m), |
e809758a AW |
128 | "Return the type of the syntax transformer @var{m}, as passed to\n" |
129 | "@code{make-syntax-transformer}. If @var{m} is a primitive syntax\n" | |
130 | "transformer, @code{#f} will be returned.") | |
1bbd0b84 | 131 | #define FUNC_NAME s_scm_macro_type |
99027e3c | 132 | { |
e809758a AW |
133 | SCM_VALIDATE_MACRO (1, m); |
134 | return SCM_MACRO_TYPE (m); | |
99027e3c | 135 | } |
1bbd0b84 | 136 | #undef FUNC_NAME |
99027e3c | 137 | |
a1ec6916 | 138 | SCM_DEFINE (scm_macro_name, "macro-name", 1, 0, 0, |
1bbd0b84 | 139 | (SCM m), |
e809758a | 140 | "Return the name of the syntax transformer @var{m}.") |
1bbd0b84 | 141 | #define FUNC_NAME s_scm_macro_name |
99027e3c | 142 | { |
e809758a AW |
143 | SCM_VALIDATE_MACRO (1, m); |
144 | return SCM_MACRO_NAME (m); | |
99027e3c | 145 | } |
1bbd0b84 | 146 | #undef FUNC_NAME |
99027e3c | 147 | |
a1ec6916 | 148 | SCM_DEFINE (scm_macro_transformer, "macro-transformer", 1, 0, 0, |
1bbd0b84 | 149 | (SCM m), |
e809758a AW |
150 | "Return the transformer procedure of the macro @var{m}.\n\n" |
151 | "If @var{m} is a syntax transformer but not a macro, @code{#f}\n" | |
152 | "will be returned. (This can happen, for example, with primitive\n" | |
153 | "syntax transformers).") | |
1bbd0b84 | 154 | #define FUNC_NAME s_scm_macro_transformer |
99027e3c | 155 | { |
e809758a AW |
156 | SCM_VALIDATE_MACRO (1, m); |
157 | /* here we rely on knowledge of how psyntax represents macro bindings, but | |
158 | hey, there is code out there that calls this function, and expects to get | |
159 | a procedure in return... */ | |
f42d8bd8 AW |
160 | if (scm_is_true (scm_procedure_p (SCM_MACRO_BINDING (m)))) |
161 | return SCM_MACRO_BINDING (m); | |
6c289afe AW |
162 | else |
163 | return SCM_BOOL_F; | |
99027e3c | 164 | } |
1bbd0b84 | 165 | #undef FUNC_NAME |
99027e3c | 166 | |
e809758a | 167 | SCM_DEFINE (scm_macro_binding, "macro-binding", 1, 0, 0, |
5a0132b3 | 168 | (SCM m), |
e809758a AW |
169 | "Return the binding of the syntax transformer @var{m}, as passed to\n" |
170 | "@code{make-syntax-transformer}. If @var{m} is a primitive syntax\n" | |
171 | "transformer, @code{#f} will be returned.") | |
2051e2bd | 172 | #define FUNC_NAME s_scm_macro_binding |
5a0132b3 | 173 | { |
e809758a AW |
174 | SCM_VALIDATE_MACRO (1, m); |
175 | return SCM_MACRO_BINDING (m); | |
5a0132b3 AW |
176 | } |
177 | #undef FUNC_NAME | |
178 | ||
5a0132b3 | 179 | |
99027e3c MD |
180 | void |
181 | scm_init_macros () | |
182 | { | |
e841c3e0 | 183 | scm_tc16_macro = scm_make_smob_type ("macro", 0); |
726d810a | 184 | scm_set_smob_print (scm_tc16_macro, macro_print); |
a0599745 | 185 | #include "libguile/macros.x" |
99027e3c | 186 | } |
89e00824 ML |
187 | |
188 | /* | |
189 | Local Variables: | |
190 | c-file-style: "gnu" | |
191 | End: | |
192 | */ |