Commit | Line | Data |
---|---|---|
0f2d19dd JB |
1 | /* classes: h_files */ |
2 | ||
3 | #ifndef GSCMH | |
4 | #define GSCMH | |
5 | ||
6 | /* Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc. | |
7 | * | |
8 | * This program is free software; you can redistribute it and/or modify | |
9 | * it under the terms of the GNU General Public License as published by | |
10 | * the Free Software Foundation; either version 2, or (at your option) | |
11 | * any later version. | |
12 | * | |
13 | * This program is distributed in the hope that it will be useful, | |
14 | * but WITHOUT ANY WARRANTY; without even the implied warranty of | |
15 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
16 | * GNU General Public License for more details. | |
17 | * | |
18 | * You should have received a copy of the GNU General Public License | |
19 | * along with this software; see the file COPYING. If not, write to | |
20 | * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
21 | * | |
22 | * As a special exception, the Free Software Foundation gives permission | |
23 | * for additional uses of the text contained in its release of GUILE. | |
24 | * | |
25 | * The exception is that, if you link the GUILE library with other files | |
26 | * to produce an executable, this does not by itself cause the | |
27 | * resulting executable to be covered by the GNU General Public License. | |
28 | * Your use of that executable is in no way restricted on account of | |
29 | * linking the GUILE library code into it. | |
30 | * | |
31 | * This exception does not however invalidate any other reasons why | |
32 | * the executable file might be covered by the GNU General Public License. | |
33 | * | |
34 | * This exception applies only to the code released by the | |
35 | * Free Software Foundation under the name GUILE. If you copy | |
36 | * code from other Free Software Foundation releases into a copy of | |
37 | * GUILE, as the General Public License permits, the exception does | |
38 | * not apply to the code that you add in this way. To avoid misleading | |
39 | * anyone as to the status of such modified files, you must delete | |
40 | * this exception notice from them. | |
41 | * | |
42 | * If you write modifications of your own for GUILE, it is your choice | |
43 | * whether to permit this exception to apply to your modifications. | |
44 | * If you do not wish that, delete this exception notice. | |
45 | */ | |
46 | \f | |
47 | ||
48 | #include "libguile.h" | |
49 | ||
50 | \f | |
51 | /* {Locking Out Async Execution (including async GC) and Non-Local Exits} | |
52 | */ | |
53 | ||
54 | #define GSCM_DEFER_INTS SCM_DEFER_INTS | |
55 | #define GSCM_ALLOW_INTS SCM_ALLOW_INTS | |
56 | ||
57 | \f | |
58 | /* {Common Constants} | |
59 | */ | |
60 | ||
61 | #define GSCM_EOL SCM_EOL | |
62 | #define GSCM_FALSE SCM_BOOL_F | |
63 | #define GSCM_TRUE SCM_BOOL_T | |
64 | ||
65 | #define GSCM_EOL_MARKER SCM_UNDEFINED | |
66 | #define GSCM_NOT_PASSED SCM_UNDEFINED | |
67 | #define GSCM_UNSPECIFIED SCM_UNSPECIFIED | |
68 | ||
69 | \f | |
70 | /* {Booleans} | |
71 | */ | |
72 | ||
73 | #define gscm_bool(CBOOL) ((CBOOL) ? SCM_BOOL_T : SCM_BOOL_F) | |
74 | #define gscm_2_bool(BOOL) (((BOOL) == SCM_BOOL_F) ? 0 : 1) | |
75 | ||
76 | \f | |
77 | /* {Numbers} | |
78 | */ | |
79 | ||
80 | #define gscm_ulong scm_ulong2num | |
81 | #define gscm_long scm_long2num | |
82 | #define gscm_double(X) scm_makdbl ((X), 0.0) | |
83 | ||
84 | #define gscm_2_ulong(OBJ) scm_num2ulong((OBJ), (char *)SCM_ARG1, "gscm_2_ulong") | |
85 | #define gscm_2_long(OBJ) scm_num2long((OBJ), (char *)SCM_ARG1, "gscm_2_long") | |
86 | #define gscm_2_double(OBJ) scm_num2dbl((OBJ), "gscm_2_double") | |
87 | ||
88 | \f | |
89 | /* {Characters} | |
90 | */ | |
91 | ||
92 | #define gscm_char(C) SCM_MAKICHR(C) | |
93 | /* extern int gscm_2_char P((SCM)); */ | |
94 | ||
95 | \f | |
96 | /* {Strings} | |
97 | */ | |
98 | ||
99 | #define gscm_str(SRC, LEN) scm_makfromstr (SRC, LEN, 0) | |
100 | #define gscm_str0 scm_makfrom0str | |
101 | ||
102 | \f | |
103 | ||
104 | /* {Pairs and Lists} | |
105 | */ | |
106 | ||
107 | #define gscm_cons scm_cons | |
108 | #define gscm_list scm_listify | |
109 | #define gscm_ilength scm_ilength | |
110 | ||
111 | ||
112 | #define gscm_set_car(OBJ, VAL) \ | |
113 | ((SCM_NIMP(OBJ) && SCM_CONSP(OBJ)) \ | |
114 | ? (SCM_CAR(OBJ) = VAL) \ | |
115 | : scm_wta ((OBJ), (char *)SCM_ARG1, "set-car!")) | |
116 | ||
117 | #define gscm_set_cdr(OBJ, VAL) \ | |
118 | ((SCM_NIMP(OBJ) && SCM_CONSP(OBJ)) \ | |
119 | ? (SCM_CDR(OBJ) = VAL) \ | |
120 | : scm_wta ((OBJ), (char *)SCM_ARG1, "set-cdr!")) | |
121 | ||
122 | ||
123 | #define GSCM_SAFE_CAR(X) ((SCM_NIMP(X) && SCM_CONSP(X)) \ | |
124 | ? SCM_CAR(X) \ | |
125 | : scm_wta ((X), (char *)SCM_ARG1, "car")) | |
126 | ||
127 | #define GSCM_SAFE_CDR(X) ((SCM_NIMP(X) && SCM_CONSP(X)) \ | |
128 | ? SCM_CDR(X) \ | |
129 | : scm_wta ((X), (char *)SCM_ARG1, "cdr")) | |
130 | ||
131 | #define gscm_car(OBJ) GSCM_SAFE_CAR (OBJ) | |
132 | #define gscm_cdr(OBJ) GSCM_SAFE_CDR (OBJ) | |
133 | ||
134 | #define gscm_caar(OBJ) GSCM_SAFE_CAR (GSCM_SAFE_CAR (OBJ)) | |
135 | #define gscm_cdar(OBJ) GSCM_SAFE_CDR (GSCM_SAFE_CAR (OBJ)) | |
136 | #define gscm_cadr(OBJ) GSCM_SAFE_CAR (GSCM_SAFE_CDR (OBJ)) | |
137 | #define gscm_cddr(OBJ) GSCM_SAFE_CDR (GSCM_SAFE_CDR (OBJ)) | |
138 | ||
139 | #define gscm_caaar(OBJ) GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (OBJ))) | |
140 | #define gscm_cdaar(OBJ) GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (OBJ))) | |
141 | #define gscm_cadar(OBJ) GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (OBJ))) | |
142 | #define gscm_cddar(OBJ) GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (OBJ))) | |
143 | #define gscm_caadr(OBJ) GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (OBJ))) | |
144 | #define gscm_cdadr(OBJ) GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (OBJ))) | |
145 | #define gscm_caddr(OBJ) GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (OBJ))) | |
146 | #define gscm_cdddr(OBJ) GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (OBJ))) | |
147 | ||
148 | #define gscm_caaaar(OBJ) GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (OBJ)))) | |
149 | #define gscm_cdaaar(OBJ) GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (OBJ)))) | |
150 | #define gscm_cadaar(OBJ) GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (OBJ)))) | |
151 | #define gscm_cddaar(OBJ) GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (OBJ)))) | |
152 | #define gscm_caadar(OBJ) GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (OBJ)))) | |
153 | #define gscm_cdadar(OBJ) GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (OBJ)))) | |
154 | #define gscm_caddar(OBJ) GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (OBJ)))) | |
155 | #define gscm_cdddar(OBJ) GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (OBJ)))) | |
156 | #define gscm_caaadr(OBJ) GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (OBJ)))) | |
157 | #define gscm_cdaadr(OBJ) GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (OBJ)))) | |
158 | #define gscm_cadadr(OBJ) GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (OBJ)))) | |
159 | #define gscm_cddadr(OBJ) GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (OBJ)))) | |
160 | #define gscm_caaddr(OBJ) GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (OBJ)))) | |
161 | #define gscm_cdaddr(OBJ) GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (OBJ)))) | |
162 | #define gscm_cadddr(OBJ) GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (OBJ)))) | |
163 | #define gscm_cddddr(OBJ) GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (OBJ)))) | |
164 | ||
165 | \f | |
166 | /* {Symbols} | |
167 | */ | |
168 | ||
169 | #define gscm_symbol(STR, LEN) SCM_CAR(scm_intern (STR, LEN)) | |
170 | #define gscm_tmp_symbol(STR, LEN) SCM_CAR(scm_intern_obarray (STR, LEN, SCM_BOOL_F)) | |
171 | ||
172 | \f | |
173 | /* {Vectors} | |
174 | */ | |
175 | ||
176 | #define gscm_vector(N, FILL) scm_make_vector (SCM_MAKINUM(N), (FILL), SCM_UNDEFINED) | |
177 | #define gscm_vref(V, I) scm_vector_ref ((V), SCM_MAKINUM(I)) | |
178 | #define gscm_vset(V, I, VAL) scm_vector_set_x ((V), SCM_MAKINUM(I), (VAL)) | |
179 | ||
180 | \f | |
181 | /* {Procedures} | |
182 | */ | |
183 | ||
184 | /* extern SCM gscm_make_subr P((SCM (*fn)(), int req, int opt, int varp, char * doc)); */ | |
185 | /* extern SCM gscm_curry P((SCM procedure, SCM first_arg)); */ | |
186 | ||
187 | #define gscm_apply(PROC, ARGS) scm_apply ((PROC), (ARGS), SCM_EOL) | |
188 | ||
189 | ||
190 | \f | |
191 | /* {Non-local Exits} | |
192 | */ | |
193 | ||
194 | ||
195 | #define gscm_catch(T, TH, H) scm_catch ((T), (TH), (H)) | |
196 | #define gscm_throw(T, V) scm_throw ((T), (V)) | |
197 | #define gscm_dynamic_wind(E, T, L) scm_dynwind ((E), (T), (L)) | |
198 | /* extern void gscm_error P((char * message, SCM args)); */ | |
199 | ||
200 | \f | |
201 | /* {I/O} | |
202 | */ | |
203 | ||
439791ec | 204 | #define gscm_print_obj scm_prin1 |
0f2d19dd JB |
205 | #define gscm_putc scm_putc |
206 | #define gscm_puts scm_puts | |
207 | #define gscm_fwrite scm_fwrite | |
208 | #define gscm_flush scm_flush | |
209 | ||
210 | extern char * gscm_last_attempted_init_file; | |
211 | \f | |
212 | /* {Equivalence} | |
213 | */ | |
214 | ||
215 | ||
216 | #define gscm_is_eq(OBJ) (SCM_BOOL_F != scm_eq (OBJ)) | |
217 | #define gscm_is_eqv(OBJ) (SCM_BOOL_F != scm_eqv (OBJ)) | |
218 | #define gscm_is_equal(OBJ) (SCM_BOOL_F != scm_equal_p (OBJ)) | |
219 | ||
220 | \f | |
221 | /* {Procedure Properties} | |
222 | */ | |
223 | ||
224 | #define gscm_procedure_properties scm_procedure_properties | |
225 | #define gscm_set_procedure_properties_x scm_set_procedure_properties_x | |
226 | #define gscm_procedure_property scm_procedure_property | |
227 | #define gscm_set_procedure_property_x scm_set_procedure_property_x | |
228 | ||
229 | \f | |
230 | /* {Generic Length Procedure} | |
231 | */ | |
232 | ||
233 | #define gscm_obj_length scm_obj_length | |
234 | ||
235 | \f | |
236 | /* {Proc Declaration Macro} | |
237 | */ | |
238 | #ifndef GSCM_MAGIC_SNARFER | |
239 | #define GSCM_PROC(RANAME, CFN, STR, REQ, OPT, VAR) \ | |
240 | static char RANAME[]=STR; | |
241 | #else | |
242 | #define GSCM_PROC(RANAME, CFN, STR, REQ, OPT, VAR) \ | |
243 | %%% gscm_define_procedure (RANAME, CFN, REQ, OPT, VAR, "") | |
244 | #endif | |
245 | ||
246 | #define gscm_define_procedure(NAME, FN, REQ, OPT, VARP, DOC) scm_make_gsubr(name, req, opt, varp, fn) | |
247 | #define gscm_curry scm_curry | |
248 | #define gscm_define scm_sysintern | |
249 | \f | |
250 | ||
251 | typedef int GSCM_top_level; | |
252 | ||
253 | \f | |
254 | /* {Error Returns} | |
255 | */ | |
256 | ||
257 | typedef int GSCM_status; | |
258 | ||
259 | #define GSCM_OK 0 | |
260 | #define GSCM_ERROR 1 | |
261 | #define GSCM_ILLEGALLY_REENTERED 2 | |
262 | #define GSCM_OUT_OF_MEM 3 | |
263 | #define GSCM_ERROR_OPENING_FILE 4 | |
264 | #define GSCM_ERROR_OPENING_INIT_FILE 5 | |
265 | ||
266 | \f | |
267 | ||
1717856b JB |
268 | extern GSCM_status gscm_seval_str SCM_P ((SCM *answer, GSCM_top_level toplvl, char * str)); |
269 | extern GSCM_status gscm_seval_file SCM_P ((SCM *answer, GSCM_top_level toplvl, char * file_name)); | |
270 | extern GSCM_status gscm_eval_str SCM_P ((char ** answer, GSCM_top_level toplvl, char * str)); | |
271 | extern GSCM_status gscm_eval_file SCM_P ((char ** answer, GSCM_top_level toplvl, char * file_name)); | |
272 | extern GSCM_status gscm_run_scm SCM_P ((int argc, char ** argv, FILE * in, FILE * out, FILE * err, GSCM_status (*initfn)(void), char * initfile, char * initcmd)); | |
273 | extern char * gscm_error_msg SCM_P ((int n)); | |
274 | extern SCM gscm_make_subr SCM_P ((SCM (*fn)(), int req, int opt, int varp, char * doc)); | |
275 | extern int gscm_2_char SCM_P ((SCM c)); | |
276 | extern void gscm_2_str SCM_P ((char ** out, int * len_out, SCM * objp)); | |
277 | extern void gscm_error SCM_P ((char * message, SCM args)); | |
278 | extern void scm_init_guile SCM_P ((void)); | |
279 | ||
0f2d19dd JB |
280 | #endif /* GSCMH */ |
281 |