Commit | Line | Data |
---|---|---|
bccb33a9 | 1 | /* Copyright (C) 1995,1996,1997,1998, 2000 Free Software Foundation, Inc. |
0f2d19dd JB |
2 | * |
3 | * This program is free software; you can redistribute it and/or modify | |
4 | * it under the terms of the GNU General Public License as published by | |
5 | * the Free Software Foundation; either version 2, or (at your option) | |
6 | * any later version. | |
7 | * | |
8 | * This program is distributed in the hope that it will be useful, | |
9 | * but WITHOUT ANY WARRANTY; without even the implied warranty of | |
10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
11 | * GNU General Public License for more details. | |
12 | * | |
13 | * You should have received a copy of the GNU General Public License | |
14 | * along with this software; see the file COPYING. If not, write to | |
82892bed JB |
15 | * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, |
16 | * Boston, MA 02111-1307 USA | |
0f2d19dd JB |
17 | * |
18 | * As a special exception, the Free Software Foundation gives permission | |
19 | * for additional uses of the text contained in its release of GUILE. | |
20 | * | |
21 | * The exception is that, if you link the GUILE library with other files | |
22 | * to produce an executable, this does not by itself cause the | |
23 | * resulting executable to be covered by the GNU General Public License. | |
24 | * Your use of that executable is in no way restricted on account of | |
25 | * linking the GUILE library code into it. | |
26 | * | |
27 | * This exception does not however invalidate any other reasons why | |
28 | * the executable file might be covered by the GNU General Public License. | |
29 | * | |
30 | * This exception applies only to the code released by the | |
31 | * Free Software Foundation under the name GUILE. If you copy | |
32 | * code from other Free Software Foundation releases into a copy of | |
33 | * GUILE, as the General Public License permits, the exception does | |
34 | * not apply to the code that you add in this way. To avoid misleading | |
35 | * anyone as to the status of such modified files, you must delete | |
36 | * this exception notice from them. | |
37 | * | |
38 | * If you write modifications of your own for GUILE, it is your choice | |
39 | * whether to permit this exception to apply to your modifications. | |
82892bed | 40 | * If you do not wish that, delete this exception notice. */ |
1bbd0b84 GB |
41 | |
42 | /* Software engineering face-lift by Greg J. Badros, 11-Dec-1999, | |
43 | gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */ | |
44 | ||
0f2d19dd JB |
45 | \f |
46 | ||
47 | #include <stdio.h> | |
a0599745 MD |
48 | #include "libguile/_scm.h" |
49 | #include "libguile/chars.h" | |
50 | #include "libguile/eval.h" | |
ba393257 | 51 | #include "libguile/hash.h" |
fb43bf74 | 52 | #include "libguile/smob.h" |
a0599745 MD |
53 | #include "libguile/variable.h" |
54 | #include "libguile/alist.h" | |
7e73eaee | 55 | #include "libguile/fluids.h" |
a0599745 MD |
56 | #include "libguile/strings.h" |
57 | #include "libguile/vectors.h" | |
58 | #include "libguile/weaks.h" | |
eb8db440 | 59 | #include "libguile/modules.h" |
a0599745 MD |
60 | |
61 | #include "libguile/validate.h" | |
62 | #include "libguile/symbols.h" | |
0f2d19dd | 63 | |
95b88819 GH |
64 | #ifdef HAVE_STRING_H |
65 | #include <string.h> | |
66 | #endif | |
67 | ||
0f2d19dd JB |
68 | \f |
69 | ||
28b06554 DH |
70 | static char * |
71 | duplicate_string (const char * src, unsigned long length) | |
72 | { | |
73 | char * dst = scm_must_malloc (length + 1, "duplicate_string"); | |
1e1384f0 MD |
74 | memcpy (dst, src, length); |
75 | dst[length] = 0; | |
28b06554 DH |
76 | return dst; |
77 | } | |
78 | ||
79 | \f | |
0f2d19dd JB |
80 | |
81 | /* {Symbols} | |
82 | */ | |
83 | ||
1cc91f1b | 84 | |
0f2d19dd JB |
85 | /* scm_sym2vcell |
86 | * looks up the symbol in the symhash table. | |
87 | */ | |
1cc91f1b | 88 | |
0f2d19dd | 89 | SCM |
bccb33a9 | 90 | scm_sym2vcell (SCM sym, SCM thunk, SCM definep) |
0f2d19dd | 91 | { |
bccb33a9 | 92 | if (SCM_NIMP (thunk)) |
0f2d19dd | 93 | { |
bccb33a9 MD |
94 | SCM var; |
95 | ||
fb43bf74 | 96 | if (SCM_EVAL_CLOSURE_P (thunk)) |
bccb33a9 | 97 | /* Bypass evaluator in the standard case. */ |
fb43bf74 | 98 | var = scm_eval_closure_lookup (thunk, sym, definep); |
bccb33a9 MD |
99 | else |
100 | var = scm_apply (thunk, sym, scm_cons (definep, scm_listofnull)); | |
0f2d19dd | 101 | |
bc66755e | 102 | if (SCM_FALSEP (var)) |
0f2d19dd | 103 | return SCM_BOOL_F; |
93d40df2 DH |
104 | else if (SCM_VARIABLEP (var)) |
105 | return SCM_VARVCELL (var); | |
0f2d19dd | 106 | else |
38ae064c | 107 | return scm_wta (sym, "strangely interned symbol? ", ""); |
0f2d19dd JB |
108 | } |
109 | else | |
110 | { | |
111 | SCM lsym; | |
112 | SCM * lsymp; | |
93d40df2 DH |
113 | scm_sizet hash1; |
114 | scm_sizet hash2; | |
0f2d19dd JB |
115 | |
116 | SCM_DEFER_INTS; | |
93d40df2 DH |
117 | hash1 = SCM_SYMBOL_HASH (sym) % SCM_VECTOR_LENGTH (scm_symhash); |
118 | for (lsym = SCM_VELTS (scm_symhash)[hash1]; SCM_NIMP (lsym); lsym = SCM_CDR (lsym)) | |
0f2d19dd | 119 | { |
93d40df2 | 120 | SCM z = SCM_CAR (lsym); |
bc66755e | 121 | if (SCM_EQ_P (SCM_CAR (z), sym)) |
0f2d19dd JB |
122 | { |
123 | SCM_ALLOW_INTS; | |
124 | return z; | |
125 | } | |
126 | } | |
127 | ||
93d40df2 DH |
128 | hash2 = SCM_SYMBOL_HASH (sym) % SCM_VECTOR_LENGTH (scm_weak_symhash); |
129 | for (lsym = *(lsymp = &SCM_VELTS (scm_weak_symhash)[hash2]); | |
0f2d19dd | 130 | SCM_NIMP (lsym); |
25d8012c | 131 | lsym = *(lsymp = SCM_CDRLOC (lsym))) |
0f2d19dd | 132 | { |
93d40df2 | 133 | SCM z = SCM_CAR (lsym); |
bc66755e | 134 | if (SCM_EQ_P (SCM_CAR (z), sym)) |
0f2d19dd | 135 | { |
5aab5d96 | 136 | if (SCM_NFALSEP (definep)) |
0f2d19dd | 137 | { |
49bc24fe | 138 | /* Move handle from scm_weak_symhash to scm_symhash. */ |
0f2d19dd | 139 | *lsymp = SCM_CDR (lsym); |
93d40df2 DH |
140 | SCM_SETCDR (lsym, SCM_VELTS(scm_symhash)[hash1]); |
141 | SCM_VELTS(scm_symhash)[hash1] = lsym; | |
0f2d19dd JB |
142 | } |
143 | SCM_ALLOW_INTS; | |
144 | return z; | |
145 | } | |
146 | } | |
147 | SCM_ALLOW_INTS; | |
148 | return scm_wta (sym, "uninterned symbol? ", ""); | |
149 | } | |
150 | } | |
151 | ||
152 | /* scm_sym2ovcell | |
49bc24fe | 153 | * looks up the symbol in an arbitrary obarray. |
0f2d19dd | 154 | */ |
1cc91f1b | 155 | |
0f2d19dd | 156 | SCM |
1bbd0b84 | 157 | scm_sym2ovcell_soft (SCM sym, SCM obarray) |
0f2d19dd JB |
158 | { |
159 | SCM lsym, z; | |
0f87853a | 160 | scm_sizet hash = SCM_SYMBOL_HASH (sym) % SCM_VECTOR_LENGTH (obarray); |
0f2d19dd | 161 | SCM_REDEFER_INTS; |
28b06554 | 162 | for (lsym = SCM_VELTS (obarray)[hash]; |
0f2d19dd JB |
163 | SCM_NIMP (lsym); |
164 | lsym = SCM_CDR (lsym)) | |
165 | { | |
166 | z = SCM_CAR (lsym); | |
bc66755e | 167 | if (SCM_EQ_P (SCM_CAR (z), sym)) |
0f2d19dd JB |
168 | { |
169 | SCM_REALLOW_INTS; | |
170 | return z; | |
171 | } | |
172 | } | |
173 | SCM_REALLOW_INTS; | |
174 | return SCM_BOOL_F; | |
175 | } | |
176 | ||
1cc91f1b | 177 | |
0f2d19dd | 178 | SCM |
1bbd0b84 | 179 | scm_sym2ovcell (SCM sym, SCM obarray) |
0f2d19dd JB |
180 | { |
181 | SCM answer; | |
182 | answer = scm_sym2ovcell_soft (sym, obarray); | |
bc66755e | 183 | if (!SCM_FALSEP (answer)) |
0f2d19dd JB |
184 | return answer; |
185 | scm_wta (sym, "uninterned symbol? ", ""); | |
186 | return SCM_UNSPECIFIED; /* not reached */ | |
187 | } | |
188 | ||
8ce94504 JB |
189 | /* Intern a symbol whose name is the LEN characters at NAME in OBARRAY. |
190 | ||
191 | OBARRAY should be a vector of lists, indexed by the name's hash | |
192 | value, modulo OBARRAY's length. Each list has the form | |
193 | ((SYMBOL . VALUE) ...), where SYMBOL is a symbol, and VALUE is the | |
194 | value associated with that symbol (in the current module? in the | |
195 | system module?) | |
196 | ||
197 | To "intern" a symbol means: if OBARRAY already contains a symbol by | |
198 | that name, return its (SYMBOL . VALUE) pair; otherwise, create a | |
199 | new symbol, add the pair (SYMBOL . SCM_UNDEFINED) to the | |
200 | appropriate list of the OBARRAY, and return the pair. | |
201 | ||
202 | If softness is non-zero, don't create a symbol if it isn't already | |
203 | in OBARRAY; instead, just return #f. | |
204 | ||
205 | If OBARRAY is SCM_BOOL_F, create a symbol listed in no obarray and | |
206 | return (SYMBOL . SCM_UNDEFINED). | |
207 | ||
208 | If OBARRAY is scm_symhash, and that doesn't contain the symbol, | |
209 | check scm_weak_symhash instead. */ | |
210 | ||
1cc91f1b | 211 | |
0f2d19dd | 212 | SCM |
28b06554 | 213 | scm_intern_obarray_soft (const char *name,scm_sizet len,SCM obarray,unsigned int softness) |
0f2d19dd | 214 | { |
28b06554 DH |
215 | scm_sizet raw_hash = scm_string_hash ((unsigned char *) name, len); |
216 | scm_sizet hash; | |
0f2d19dd | 217 | SCM lsym; |
0f2d19dd JB |
218 | |
219 | SCM_REDEFER_INTS; | |
220 | ||
bc66755e | 221 | if (SCM_FALSEP (obarray)) |
0f2d19dd | 222 | { |
28b06554 | 223 | hash = raw_hash % 1019; |
0f2d19dd JB |
224 | goto uninterned_symbol; |
225 | } | |
226 | ||
9fd38a3d | 227 | hash = raw_hash % SCM_VECTOR_LENGTH (obarray); |
0f2d19dd JB |
228 | |
229 | retry_new_obarray: | |
28b06554 | 230 | for (lsym = SCM_VELTS (obarray)[hash]; SCM_NIMP (lsym); lsym = SCM_CDR (lsym)) |
0f2d19dd | 231 | { |
28b06554 DH |
232 | scm_sizet i; |
233 | SCM a = SCM_CAR (lsym); | |
234 | SCM z = SCM_CAR (a); | |
e51fe79c | 235 | char *tmp = SCM_SYMBOL_CHARS (z); |
0f87853a DH |
236 | if (SCM_SYMBOL_HASH (z) != raw_hash) |
237 | goto trynext; | |
9fd38a3d | 238 | if (SCM_SYMBOL_LENGTH (z) != len) |
0f2d19dd JB |
239 | goto trynext; |
240 | for (i = len; i--;) | |
e51fe79c | 241 | if (name[i] != tmp[i]) |
0f2d19dd JB |
242 | goto trynext; |
243 | { | |
0f2d19dd JB |
244 | SCM_REALLOW_INTS; |
245 | return a; | |
246 | } | |
247 | trynext:; | |
248 | } | |
249 | ||
bc66755e | 250 | if (SCM_EQ_P (obarray, scm_symhash)) |
0f2d19dd JB |
251 | { |
252 | obarray = scm_weak_symhash; | |
253 | goto retry_new_obarray; | |
254 | } | |
255 | ||
256 | uninterned_symbol: | |
257 | if (softness) | |
258 | { | |
259 | SCM_REALLOW_INTS; | |
260 | return SCM_BOOL_F; | |
261 | } | |
262 | ||
28b06554 | 263 | SCM_NEWCELL2 (lsym); |
6a0476fd | 264 | SCM_SET_SYMBOL_CHARS (lsym, duplicate_string (name, len)); |
28b06554 | 265 | SCM_SET_SYMBOL_HASH (lsym, raw_hash); |
0f8c9efa | 266 | SCM_SET_PROP_SLOTS (lsym, scm_cons (SCM_BOOL_F, SCM_EOL)); |
93778877 | 267 | SCM_SET_SYMBOL_LENGTH (lsym, (long) len); |
0f2d19dd | 268 | |
bc66755e | 269 | if (SCM_FALSEP (obarray)) |
0f2d19dd JB |
270 | { |
271 | SCM answer; | |
272 | SCM_REALLOW_INTS; | |
273 | SCM_NEWCELL (answer); | |
274 | SCM_DEFER_INTS; | |
25d8012c MD |
275 | SCM_SETCAR (answer, lsym); |
276 | SCM_SETCDR (answer, SCM_UNDEFINED); | |
0f2d19dd JB |
277 | SCM_REALLOW_INTS; |
278 | return answer; | |
279 | } | |
280 | else | |
281 | { | |
282 | SCM a; | |
283 | SCM b; | |
284 | ||
285 | SCM_NEWCELL (a); | |
286 | SCM_NEWCELL (b); | |
287 | SCM_SETCAR (a, lsym); | |
288 | SCM_SETCDR (a, SCM_UNDEFINED); | |
289 | SCM_SETCAR (b, a); | |
28b06554 DH |
290 | SCM_SETCDR (b, SCM_VELTS(obarray)[hash]); |
291 | SCM_VELTS(obarray)[hash] = b; | |
0f2d19dd JB |
292 | SCM_REALLOW_INTS; |
293 | return SCM_CAR (b); | |
294 | } | |
295 | } | |
296 | ||
1cc91f1b | 297 | |
23ade5e7 DH |
298 | SCM |
299 | scm_mem2symbol (const char *mem, scm_sizet len) | |
300 | { | |
301 | return SCM_CAR (scm_intern_obarray_soft (mem, len, scm_symhash, 0)); | |
302 | } | |
303 | ||
304 | ||
305 | SCM | |
306 | scm_str2symbol (const char *str) | |
307 | { | |
308 | return SCM_CAR (scm_intern_obarray_soft (str, strlen (str), scm_symhash, 0)); | |
309 | } | |
310 | ||
311 | ||
0f2d19dd | 312 | SCM |
1bbd0b84 | 313 | scm_intern_obarray (const char *name,scm_sizet len,SCM obarray) |
0f2d19dd JB |
314 | { |
315 | return scm_intern_obarray_soft (name, len, obarray, 0); | |
316 | } | |
317 | ||
318 | ||
0f2d19dd | 319 | SCM |
1bbd0b84 | 320 | scm_intern (const char *name,scm_sizet len) |
0f2d19dd JB |
321 | { |
322 | return scm_intern_obarray (name, len, scm_symhash); | |
323 | } | |
324 | ||
1cc91f1b | 325 | |
0f2d19dd | 326 | SCM |
1bbd0b84 | 327 | scm_intern0 (const char * name) |
0f2d19dd JB |
328 | { |
329 | return scm_intern (name, strlen (name)); | |
330 | } | |
331 | ||
332 | ||
5aab5d96 | 333 | /* Intern the symbol named NAME in scm_symhash, NAME is null-terminated. */ |
0f2d19dd | 334 | SCM |
1bbd0b84 | 335 | scm_sysintern0_no_module_lookup (const char *name) |
0f2d19dd JB |
336 | { |
337 | SCM easy_answer; | |
338 | SCM_DEFER_INTS; | |
339 | easy_answer = scm_intern_obarray_soft (name, strlen (name), scm_symhash, 1); | |
340 | if (SCM_NIMP (easy_answer)) | |
341 | { | |
0f2d19dd JB |
342 | SCM_ALLOW_INTS; |
343 | return easy_answer; | |
344 | } | |
345 | else | |
346 | { | |
347 | SCM lsym; | |
348 | scm_sizet len = strlen (name); | |
28b06554 | 349 | scm_sizet raw_hash = scm_string_hash ((unsigned char *) name, len); |
93d40df2 | 350 | scm_sizet hash = raw_hash % SCM_VECTOR_LENGTH (scm_symhash); |
28b06554 DH |
351 | |
352 | SCM_NEWCELL2 (lsym); | |
6a0476fd | 353 | SCM_SET_SYMBOL_CHARS (lsym, name); |
28b06554 | 354 | SCM_SET_SYMBOL_HASH (lsym, raw_hash); |
0f8c9efa | 355 | SCM_SET_PROP_SLOTS (lsym, scm_cons (SCM_BOOL_F, SCM_EOL)); |
93778877 | 356 | SCM_SET_SYMBOL_LENGTH (lsym, (long) len); |
28b06554 | 357 | |
5aab5d96 | 358 | lsym = scm_cons (lsym, SCM_UNDEFINED); |
28b06554 | 359 | SCM_VELTS (scm_symhash)[hash] = scm_cons (lsym, SCM_VELTS (scm_symhash)[hash]); |
0f2d19dd JB |
360 | SCM_ALLOW_INTS; |
361 | return lsym; | |
362 | } | |
363 | } | |
364 | ||
9b8d3288 MV |
365 | /* Intern the symbol named NAME in scm_symhash, and give it the value |
366 | VAL. NAME is null-terminated. Use the current top_level lookup | |
367 | closure to give NAME its value. | |
368 | */ | |
369 | SCM | |
1bbd0b84 | 370 | scm_sysintern (const char *name, SCM val) |
5aab5d96 MD |
371 | { |
372 | SCM vcell = scm_sysintern0 (name); | |
373 | SCM_SETCDR (vcell, val); | |
374 | return vcell; | |
375 | } | |
376 | ||
377 | SCM | |
1bbd0b84 | 378 | scm_sysintern0 (const char *name) |
9b8d3288 MV |
379 | { |
380 | SCM lookup_proc; | |
eb8db440 MD |
381 | if (scm_module_system_booted_p |
382 | && SCM_NIMP (lookup_proc = SCM_TOP_LEVEL_LOOKUP_CLOSURE)) | |
9b8d3288 | 383 | { |
38ae064c | 384 | SCM sym = scm_str2symbol (name); |
9b8d3288 | 385 | SCM vcell = scm_sym2vcell (sym, lookup_proc, SCM_BOOL_T); |
bc66755e | 386 | if (SCM_FALSEP (vcell)) |
5d2d2ffc | 387 | scm_misc_error ("sysintern0", "can't define variable", sym); |
9b8d3288 MV |
388 | return vcell; |
389 | } | |
390 | else | |
5aab5d96 | 391 | return scm_sysintern0_no_module_lookup (name); |
9b8d3288 MV |
392 | } |
393 | ||
1dd28b3d MD |
394 | /* Lookup the value of the symbol named by the nul-terminated string |
395 | NAME in the current module. */ | |
396 | SCM | |
1bbd0b84 | 397 | scm_symbol_value0 (const char *name) |
1dd28b3d MD |
398 | { |
399 | /* This looks silly - we look up the symbol twice. But it is in | |
400 | fact necessary given the current module system because the module | |
401 | lookup closures are written in scheme which needs real symbols. */ | |
402 | SCM symbol = scm_intern_obarray_soft (name, strlen (name), scm_symhash, 0); | |
403 | SCM vcell = scm_sym2vcell (SCM_CAR (symbol), | |
7e73eaee | 404 | SCM_TOP_LEVEL_LOOKUP_CLOSURE, |
1dd28b3d MD |
405 | SCM_BOOL_F); |
406 | if (SCM_FALSEP (vcell)) | |
407 | return SCM_UNDEFINED; | |
408 | return SCM_CDR (vcell); | |
409 | } | |
410 | ||
3b3b36dd | 411 | SCM_DEFINE (scm_symbol_p, "symbol?", 1, 0, 0, |
8e93e199 | 412 | (SCM obj), |
5ffe9968 | 413 | "Returns @t{#t} if @var{obj} is a symbol, otherwise returns @t{#f}. (r5rs)") |
1bbd0b84 | 414 | #define FUNC_NAME s_scm_symbol_p |
0f2d19dd | 415 | { |
8e93e199 | 416 | return SCM_BOOL (SCM_SYMBOLP (obj)); |
0f2d19dd | 417 | } |
1bbd0b84 | 418 | #undef FUNC_NAME |
0f2d19dd | 419 | |
3b3b36dd | 420 | SCM_DEFINE (scm_symbol_to_string, "symbol->string", 1, 0, 0, |
1bbd0b84 | 421 | (SCM s), |
5ffe9968 | 422 | "Returns the name of @var{symbol} as a string. If the symbol was part of\n" |
ae42688c NJ |
423 | "an object returned as the value of a literal expression (section\n" |
424 | "@pxref{Literal expressions,,,r4rs, The Revised^4 Report on Scheme}) or\n" | |
425 | "by a call to the @samp{read} procedure, and its name contains alphabetic\n" | |
426 | "characters, then the string returned will contain characters in the\n" | |
427 | "implementation's preferred standard case---some implementations will\n" | |
428 | "prefer upper case, others lower case. If the symbol was returned by\n" | |
429 | "@samp{string->symbol}, the case of characters in the string returned\n" | |
430 | "will be the same as the case in the string that was passed to\n" | |
431 | "@samp{string->symbol}. It is an error to apply mutation procedures like\n" | |
432 | "@code{string-set!} to strings returned by this procedure. (r5rs)\n\n" | |
5ffe9968 GB |
433 | "The following examples assume that the implementation's standard case is\n" |
434 | "lower case:\n\n" | |
435 | "@format\n" | |
436 | "@t{(symbol->string 'flying-fish) \n" | |
437 | " ==> \"flying-fish\"\n" | |
438 | "(symbol->string 'Martin) ==> \"martin\"\n" | |
439 | "(symbol->string\n" | |
ae42688c NJ |
440 | " (string->symbol \"Malvina\")) \n" |
441 | " ==> \"Malvina\"\n" | |
5ffe9968 GB |
442 | "}\n" |
443 | "@end format") | |
1bbd0b84 | 444 | #define FUNC_NAME s_scm_symbol_to_string |
0f2d19dd | 445 | { |
28b06554 | 446 | SCM_VALIDATE_SYMBOL (1, s); |
9fd38a3d | 447 | return scm_makfromstr (SCM_SYMBOL_CHARS (s), SCM_SYMBOL_LENGTH (s), 0); |
0f2d19dd | 448 | } |
1bbd0b84 | 449 | #undef FUNC_NAME |
0f2d19dd JB |
450 | |
451 | ||
3b3b36dd | 452 | SCM_DEFINE (scm_string_to_symbol, "string->symbol", 1, 0, 0, |
1bbd0b84 | 453 | (SCM s), |
5ffe9968 GB |
454 | "Returns the symbol whose name is @var{string}. This procedure can\n" |
455 | "create symbols with names containing special characters or letters in\n" | |
456 | "the non-standard case, but it is usually a bad idea to create such\n" | |
457 | "symbols because in some implementations of Scheme they cannot be read as\n" | |
458 | "themselves. See @samp{symbol->string}.\n\n" | |
459 | "The following examples assume that the implementation's standard case is\n" | |
460 | "lower case:\n\n" | |
461 | "@format\n" | |
462 | "@t{(eq? 'mISSISSIppi 'mississippi) \n" | |
463 | " ==> #t\n" | |
464 | "(string->symbol \"mISSISSIppi\") \n" | |
465 | " ==>\n" | |
466 | " @r{}the symbol with name \"mISSISSIppi\"\n" | |
467 | "(eq? 'bitBlt (string->symbol \"bitBlt\")) \n" | |
468 | " ==> #f\n" | |
469 | "(eq? 'JollyWog\n" | |
470 | " (string->symbol\n" | |
471 | " (symbol->string 'JollyWog))) \n" | |
472 | " ==> #t\n" | |
473 | "(string=? \"K. Harper, M.D.\"\n" | |
474 | " (symbol->string\n" | |
475 | " (string->symbol \"K. Harper, M.D.\"))) \n" | |
476 | " ==> #t\n" | |
477 | "}\n" | |
478 | "@end format") | |
1bbd0b84 | 479 | #define FUNC_NAME s_scm_string_to_symbol |
0f2d19dd | 480 | { |
38ae064c DH |
481 | SCM_VALIDATE_STRING (1, s); |
482 | return scm_mem2symbol (SCM_STRING_CHARS (s), SCM_STRING_LENGTH (s)); | |
0f2d19dd | 483 | } |
1bbd0b84 | 484 | #undef FUNC_NAME |
0f2d19dd JB |
485 | |
486 | ||
3b3b36dd | 487 | SCM_DEFINE (scm_string_to_obarray_symbol, "string->obarray-symbol", 2, 1, 0, |
1bbd0b84 | 488 | (SCM o, SCM s, SCM softp), |
a3c8b9fc MD |
489 | "Intern a new symbol in @var{obarray}, a symbol table, with name\n" |
490 | "@var{string}.\n\n" | |
491 | "If @var{obarray} is @code{#f}, use the default system symbol table. If\n" | |
492 | "@var{obarray} is @code{#t}, the symbol should not be interned in any\n" | |
493 | "symbol table; merely return the pair (@var{symbol}\n" | |
494 | ". @var{#<undefined>}).\n\n" | |
495 | "The @var{soft?} argument determines whether new symbol table entries\n" | |
496 | "should be created when the specified symbol is not already present in\n" | |
497 | "@var{obarray}. If @var{soft?} is specified and is a true value, then\n" | |
498 | "new entries should not be added for symbols not already present in the\n" | |
499 | "table; instead, simply return @code{#f}.") | |
1bbd0b84 | 500 | #define FUNC_NAME s_scm_string_to_obarray_symbol |
0f2d19dd JB |
501 | { |
502 | SCM vcell; | |
503 | SCM answer; | |
504 | int softness; | |
505 | ||
a6d9e5ab | 506 | SCM_VALIDATE_STRING (2, s); |
bc66755e | 507 | SCM_ASSERT (SCM_BOOLP (o) || SCM_VECTORP (o), o, SCM_ARG1, FUNC_NAME); |
0f2d19dd | 508 | |
bc66755e | 509 | softness = (!SCM_UNBNDP (softp) && !SCM_FALSEP(softp)); |
0f2d19dd | 510 | /* iron out some screwy calling conventions */ |
bc66755e | 511 | if (SCM_FALSEP (o)) |
0f2d19dd | 512 | o = scm_symhash; |
9a09deb1 | 513 | else if (SCM_EQ_P (o, SCM_BOOL_T)) |
0f2d19dd JB |
514 | o = SCM_BOOL_F; |
515 | ||
34f0f2b8 | 516 | vcell = scm_intern_obarray_soft (SCM_STRING_CHARS(s), |
a6d9e5ab | 517 | SCM_STRING_LENGTH (s), |
49bc24fe MD |
518 | o, |
519 | softness); | |
bc66755e | 520 | if (SCM_FALSEP (vcell)) |
0f2d19dd JB |
521 | return vcell; |
522 | answer = SCM_CAR (vcell); | |
0f2d19dd JB |
523 | return answer; |
524 | } | |
1bbd0b84 | 525 | #undef FUNC_NAME |
0f2d19dd | 526 | |
3b3b36dd | 527 | SCM_DEFINE (scm_intern_symbol, "intern-symbol", 2, 0, 0, |
1bbd0b84 | 528 | (SCM o, SCM s), |
b380b885 MD |
529 | "Add a new symbol to @var{obarray} with name @var{string}, bound to an\n" |
530 | "unspecified initial value. The symbol table is not modified if a symbol\n" | |
531 | "with this name is already present.") | |
1bbd0b84 | 532 | #define FUNC_NAME s_scm_intern_symbol |
0f2d19dd | 533 | { |
49bc24fe | 534 | scm_sizet hval; |
3b3b36dd | 535 | SCM_VALIDATE_SYMBOL (2,s); |
bc66755e | 536 | if (SCM_FALSEP (o)) |
49bc24fe | 537 | o = scm_symhash; |
3b3b36dd | 538 | SCM_VALIDATE_VECTOR (1,o); |
0f87853a | 539 | hval = SCM_SYMBOL_HASH (s) % SCM_VECTOR_LENGTH (o); |
49bc24fe MD |
540 | /* If the symbol is already interned, simply return. */ |
541 | SCM_REDEFER_INTS; | |
542 | { | |
543 | SCM lsym; | |
544 | SCM sym; | |
545 | for (lsym = SCM_VELTS (o)[hval]; | |
546 | SCM_NIMP (lsym); | |
547 | lsym = SCM_CDR (lsym)) | |
548 | { | |
549 | sym = SCM_CAR (lsym); | |
bc66755e | 550 | if (SCM_EQ_P (SCM_CAR (sym), s)) |
49bc24fe MD |
551 | { |
552 | SCM_REALLOW_INTS; | |
553 | return SCM_UNSPECIFIED; | |
554 | } | |
555 | } | |
556 | SCM_VELTS (o)[hval] = | |
557 | scm_acons (s, SCM_UNDEFINED, SCM_VELTS (o)[hval]); | |
558 | } | |
559 | SCM_REALLOW_INTS; | |
560 | return SCM_UNSPECIFIED; | |
0f2d19dd | 561 | } |
1bbd0b84 | 562 | #undef FUNC_NAME |
0f2d19dd | 563 | |
3b3b36dd | 564 | SCM_DEFINE (scm_unintern_symbol, "unintern-symbol", 2, 0, 0, |
1bbd0b84 | 565 | (SCM o, SCM s), |
b380b885 MD |
566 | "Remove the symbol with name @var{string} from @var{obarray}. This\n" |
567 | "function returns @code{#t} if the symbol was present and @code{#f}\n" | |
568 | "otherwise.") | |
1bbd0b84 | 569 | #define FUNC_NAME s_scm_unintern_symbol |
0f2d19dd | 570 | { |
49bc24fe | 571 | scm_sizet hval; |
3b3b36dd | 572 | SCM_VALIDATE_SYMBOL (2,s); |
bc66755e | 573 | if (SCM_FALSEP (o)) |
49bc24fe | 574 | o = scm_symhash; |
3b3b36dd | 575 | SCM_VALIDATE_VECTOR (1,o); |
0f87853a | 576 | hval = SCM_SYMBOL_HASH (s) % SCM_VECTOR_LENGTH (o); |
49bc24fe MD |
577 | SCM_DEFER_INTS; |
578 | { | |
579 | SCM lsym_follow; | |
580 | SCM lsym; | |
581 | SCM sym; | |
582 | for (lsym = SCM_VELTS (o)[hval], lsym_follow = SCM_BOOL_F; | |
583 | SCM_NIMP (lsym); | |
584 | lsym_follow = lsym, lsym = SCM_CDR (lsym)) | |
585 | { | |
586 | sym = SCM_CAR (lsym); | |
bc66755e | 587 | if (SCM_EQ_P (SCM_CAR (sym), s)) |
49bc24fe MD |
588 | { |
589 | /* Found the symbol to unintern. */ | |
bc66755e | 590 | if (SCM_FALSEP (lsym_follow)) |
49bc24fe MD |
591 | SCM_VELTS(o)[hval] = lsym; |
592 | else | |
25d8012c | 593 | SCM_SETCDR (lsym_follow, SCM_CDR(lsym)); |
49bc24fe MD |
594 | SCM_ALLOW_INTS; |
595 | return SCM_BOOL_T; | |
596 | } | |
597 | } | |
598 | } | |
599 | SCM_ALLOW_INTS; | |
600 | return SCM_BOOL_F; | |
0f2d19dd | 601 | } |
1bbd0b84 | 602 | #undef FUNC_NAME |
0f2d19dd | 603 | |
3b3b36dd | 604 | SCM_DEFINE (scm_symbol_binding, "symbol-binding", 2, 0, 0, |
1bbd0b84 | 605 | (SCM o, SCM s), |
b380b885 MD |
606 | "Look up in @var{obarray} the symbol whose name is @var{string}, and\n" |
607 | "return the value to which it is bound. If @var{obarray} is @code{#f},\n" | |
608 | "use the global symbol table. If @var{string} is not interned in\n" | |
609 | "@var{obarray}, an error is signalled.") | |
1bbd0b84 | 610 | #define FUNC_NAME s_scm_symbol_binding |
0f2d19dd JB |
611 | { |
612 | SCM vcell; | |
3b3b36dd | 613 | SCM_VALIDATE_SYMBOL (2,s); |
bc66755e | 614 | if (SCM_FALSEP (o)) |
0f2d19dd | 615 | o = scm_symhash; |
3b3b36dd | 616 | SCM_VALIDATE_VECTOR (1,o); |
0f2d19dd JB |
617 | vcell = scm_sym2ovcell (s, o); |
618 | return SCM_CDR(vcell); | |
619 | } | |
1bbd0b84 | 620 | #undef FUNC_NAME |
0f2d19dd JB |
621 | |
622 | ||
3b3b36dd | 623 | SCM_DEFINE (scm_symbol_interned_p, "symbol-interned?", 2, 0, 0, |
1bbd0b84 | 624 | (SCM o, SCM s), |
b380b885 MD |
625 | "Return @var{#t} if @var{obarray} contains a symbol with name\n" |
626 | "@var{string}, and @var{#f} otherwise.") | |
1bbd0b84 | 627 | #define FUNC_NAME s_scm_symbol_interned_p |
0f2d19dd JB |
628 | { |
629 | SCM vcell; | |
3b3b36dd | 630 | SCM_VALIDATE_SYMBOL (2,s); |
bc66755e | 631 | if (SCM_FALSEP (o)) |
0f2d19dd | 632 | o = scm_symhash; |
3b3b36dd | 633 | SCM_VALIDATE_VECTOR (1,o); |
0f2d19dd | 634 | vcell = scm_sym2ovcell_soft (s, o); |
bc66755e | 635 | if (SCM_IMP (vcell) && SCM_EQ_P (o, scm_symhash)) |
0f2d19dd JB |
636 | vcell = scm_sym2ovcell_soft (s, scm_weak_symhash); |
637 | return (SCM_NIMP(vcell) | |
638 | ? SCM_BOOL_T | |
639 | : SCM_BOOL_F); | |
640 | } | |
1bbd0b84 | 641 | #undef FUNC_NAME |
0f2d19dd JB |
642 | |
643 | ||
3b3b36dd | 644 | SCM_DEFINE (scm_symbol_bound_p, "symbol-bound?", 2, 0, 0, |
1bbd0b84 | 645 | (SCM o, SCM s), |
b380b885 MD |
646 | "Return @var{#t} if @var{obarray} contains a symbol with name\n" |
647 | "@var{string} bound to a defined value. This differs from\n" | |
648 | "@var{symbol-bound?} in that the mere mention of a symbol usually causes\n" | |
649 | "it to be interned; @code{symbol-bound?} determines whether a symbol has\n" | |
650 | "been given any meaningful value.") | |
1bbd0b84 | 651 | #define FUNC_NAME s_scm_symbol_bound_p |
0f2d19dd JB |
652 | { |
653 | SCM vcell; | |
3b3b36dd | 654 | SCM_VALIDATE_SYMBOL (2,s); |
bc66755e | 655 | if (SCM_FALSEP (o)) |
0f2d19dd | 656 | o = scm_symhash; |
3b3b36dd | 657 | SCM_VALIDATE_VECTOR (1,o); |
0f2d19dd | 658 | vcell = scm_sym2ovcell_soft (s, o); |
bc66755e | 659 | return SCM_BOOL (SCM_NIMP (vcell) && !SCM_UNBNDP (SCM_CDR (vcell))); |
0f2d19dd | 660 | } |
1bbd0b84 | 661 | #undef FUNC_NAME |
0f2d19dd JB |
662 | |
663 | ||
3b3b36dd | 664 | SCM_DEFINE (scm_symbol_set_x, "symbol-set!", 3, 0, 0, |
1bbd0b84 | 665 | (SCM o, SCM s, SCM v), |
b380b885 MD |
666 | "Find the symbol in @var{obarray} whose name is @var{string}, and rebind\n" |
667 | "it to @var{value}. An error is signalled if @var{string} is not present\n" | |
668 | "in @var{obarray}.") | |
1bbd0b84 | 669 | #define FUNC_NAME s_scm_symbol_set_x |
0f2d19dd JB |
670 | { |
671 | SCM vcell; | |
3b3b36dd | 672 | SCM_VALIDATE_SYMBOL (2,s); |
bc66755e | 673 | if (SCM_FALSEP (o)) |
0f2d19dd | 674 | o = scm_symhash; |
3b3b36dd | 675 | SCM_VALIDATE_VECTOR (1,o); |
0f2d19dd | 676 | vcell = scm_sym2ovcell (s, o); |
25d8012c | 677 | SCM_SETCDR (vcell, v); |
0f2d19dd JB |
678 | return SCM_UNSPECIFIED; |
679 | } | |
1bbd0b84 | 680 | #undef FUNC_NAME |
0f2d19dd | 681 | |
0f2d19dd | 682 | |
3b3b36dd | 683 | SCM_DEFINE (scm_symbol_fref, "symbol-fref", 1, 0, 0, |
1bbd0b84 | 684 | (SCM s), |
b380b885 | 685 | "Return the contents of @var{symbol}'s @dfn{function slot}.") |
1bbd0b84 | 686 | #define FUNC_NAME s_scm_symbol_fref |
0f2d19dd | 687 | { |
3b3b36dd | 688 | SCM_VALIDATE_SYMBOL (1,s); |
0f2d19dd JB |
689 | return SCM_SYMBOL_FUNC (s); |
690 | } | |
1bbd0b84 | 691 | #undef FUNC_NAME |
0f2d19dd JB |
692 | |
693 | ||
3b3b36dd | 694 | SCM_DEFINE (scm_symbol_pref, "symbol-pref", 1, 0, 0, |
1bbd0b84 | 695 | (SCM s), |
b380b885 | 696 | "Return the @dfn{property list} currently associated with @var{symbol}.") |
1bbd0b84 | 697 | #define FUNC_NAME s_scm_symbol_pref |
0f2d19dd | 698 | { |
3b3b36dd | 699 | SCM_VALIDATE_SYMBOL (1,s); |
0f2d19dd JB |
700 | return SCM_SYMBOL_PROPS (s); |
701 | } | |
1bbd0b84 | 702 | #undef FUNC_NAME |
0f2d19dd JB |
703 | |
704 | ||
3b3b36dd | 705 | SCM_DEFINE (scm_symbol_fset_x, "symbol-fset!", 2, 0, 0, |
1bbd0b84 | 706 | (SCM s, SCM val), |
b380b885 | 707 | "Change the binding of @var{symbol}'s function slot.") |
1bbd0b84 | 708 | #define FUNC_NAME s_scm_symbol_fset_x |
0f2d19dd | 709 | { |
3b3b36dd | 710 | SCM_VALIDATE_SYMBOL (1,s); |
cf551a2b | 711 | SCM_SET_SYMBOL_FUNC (s, val); |
0f2d19dd JB |
712 | return SCM_UNSPECIFIED; |
713 | } | |
1bbd0b84 | 714 | #undef FUNC_NAME |
0f2d19dd JB |
715 | |
716 | ||
3b3b36dd | 717 | SCM_DEFINE (scm_symbol_pset_x, "symbol-pset!", 2, 0, 0, |
1bbd0b84 | 718 | (SCM s, SCM val), |
b380b885 | 719 | "Change the binding of @var{symbol}'s property slot.") |
1bbd0b84 | 720 | #define FUNC_NAME s_scm_symbol_pset_x |
0f2d19dd | 721 | { |
3b3b36dd | 722 | SCM_VALIDATE_SYMBOL (1,s); |
0f2d19dd | 723 | SCM_DEFER_INTS; |
cf551a2b | 724 | SCM_SET_SYMBOL_PROPS (s, val); |
0f2d19dd JB |
725 | SCM_ALLOW_INTS; |
726 | return SCM_UNSPECIFIED; | |
727 | } | |
1bbd0b84 | 728 | #undef FUNC_NAME |
0f2d19dd JB |
729 | |
730 | ||
3b3b36dd | 731 | SCM_DEFINE (scm_symbol_hash, "symbol-hash", 1, 0, 0, |
28b06554 DH |
732 | (SCM symbol), |
733 | "Return a hash value for @var{symbol}.") | |
1bbd0b84 | 734 | #define FUNC_NAME s_scm_symbol_hash |
0f2d19dd | 735 | { |
28b06554 DH |
736 | SCM_VALIDATE_SYMBOL (1, symbol); |
737 | return SCM_MAKINUM (SCM_SYMBOL_HASH (symbol)); | |
0f2d19dd | 738 | } |
1bbd0b84 | 739 | #undef FUNC_NAME |
0f2d19dd JB |
740 | |
741 | ||
b2530d66 | 742 | static void |
1bbd0b84 | 743 | copy_and_prune_obarray (SCM from, SCM to) |
b2530d66 MD |
744 | { |
745 | int i; | |
9fd38a3d | 746 | int length = SCM_VECTOR_LENGTH (from); |
b2530d66 MD |
747 | for (i = 0; i < length; ++i) |
748 | { | |
749 | SCM head = SCM_VELTS (from)[i]; /* GC protection */ | |
750 | SCM ls = head; | |
751 | SCM res = SCM_EOL; | |
752 | SCM *lloc = &res; | |
753 | while (SCM_NIMP (ls)) | |
754 | { | |
755 | if (!SCM_UNBNDP (SCM_CDAR (ls))) | |
756 | { | |
757 | *lloc = scm_cons (SCM_CAR (ls), SCM_EOL); | |
758 | lloc = SCM_CDRLOC (*lloc); | |
759 | } | |
760 | ls = SCM_CDR (ls); | |
761 | } | |
762 | SCM_VELTS (to)[i] = res; | |
763 | } | |
764 | } | |
765 | ||
766 | ||
3b3b36dd | 767 | SCM_DEFINE (scm_builtin_bindings, "builtin-bindings", 0, 0, 0, |
5ffe9968 | 768 | (), |
b380b885 MD |
769 | "Create and return a copy of the global symbol table, removing all\n" |
770 | "unbound symbols.") | |
1bbd0b84 | 771 | #define FUNC_NAME s_scm_builtin_bindings |
b2530d66 | 772 | { |
9fd38a3d | 773 | int length = SCM_VECTOR_LENGTH (scm_symhash); |
a8741caa | 774 | SCM obarray = scm_make_vector (SCM_MAKINUM (length), SCM_EOL); |
b2530d66 MD |
775 | copy_and_prune_obarray (scm_symhash, obarray); |
776 | return obarray; | |
777 | } | |
1bbd0b84 | 778 | #undef FUNC_NAME |
b2530d66 MD |
779 | |
780 | ||
3b3b36dd | 781 | SCM_DEFINE (scm_builtin_weak_bindings, "builtin-weak-bindings", 0, 0, 0, |
5ffe9968 | 782 | (), |
b380b885 | 783 | "") |
1bbd0b84 | 784 | #define FUNC_NAME s_scm_builtin_weak_bindings |
b2530d66 | 785 | { |
9fd38a3d | 786 | int length = SCM_VECTOR_LENGTH (scm_weak_symhash); |
b2530d66 MD |
787 | SCM obarray = scm_make_doubly_weak_hash_table (SCM_MAKINUM (length)); |
788 | copy_and_prune_obarray (scm_weak_symhash, obarray); | |
789 | return obarray; | |
790 | } | |
1bbd0b84 | 791 | #undef FUNC_NAME |
b2530d66 | 792 | |
e1313058 MD |
793 | #define MAX_PREFIX_LENGTH 30 |
794 | ||
1ff4df7a | 795 | static int gensym_counter; |
e1313058 MD |
796 | |
797 | SCM_DEFINE (scm_gensym, "gensym", 0, 1, 0, | |
798 | (SCM prefix), | |
799 | "Create a new symbol with name constructed from a prefix and a counter value.\n" | |
800 | "The string PREFIX can be specified as an optional argument.\n" | |
801 | "Default prefix is @code{g}. The counter is increased by 1 at each call.\n" | |
802 | "There is no provision for resetting the counter.") | |
1bbd0b84 | 803 | #define FUNC_NAME s_scm_gensym |
1ff4df7a | 804 | { |
e1313058 MD |
805 | char buf[MAX_PREFIX_LENGTH + SCM_INTBUFLEN]; |
806 | char *name = buf; | |
807 | int len; | |
808 | if (SCM_UNBNDP (prefix)) | |
809 | { | |
810 | name[0] = 'g'; | |
811 | len = 1; | |
812 | } | |
1ff4df7a | 813 | else |
c64d02c5 | 814 | { |
d1ca2c64 DH |
815 | SCM_VALIDATE_STRING (1, prefix); |
816 | len = SCM_STRING_LENGTH (prefix); | |
e1313058 MD |
817 | if (len > MAX_PREFIX_LENGTH) |
818 | name = SCM_MUST_MALLOC (MAX_PREFIX_LENGTH + SCM_INTBUFLEN); | |
34f0f2b8 | 819 | strncpy (name, SCM_STRING_CHARS (prefix), len); |
c64d02c5 | 820 | } |
e1313058 MD |
821 | { |
822 | int n_digits = scm_iint2str (gensym_counter++, 10, &name[len]); | |
38ae064c | 823 | SCM res = scm_mem2symbol (name, len + n_digits); |
e1313058 MD |
824 | if (name != buf) |
825 | scm_must_free (name); | |
826 | return res; | |
827 | } | |
828 | } | |
829 | #undef FUNC_NAME | |
1bbd0b84 | 830 | |
e1313058 MD |
831 | static int gentemp_counter; |
832 | ||
833 | SCM_DEFINE (scm_gentemp, "gentemp", 0, 2, 0, | |
834 | (SCM prefix, SCM obarray), | |
835 | "Create a new symbol with a name unique in an obarray.\n" | |
836 | "The name is constructed from an optional string PREFIX and a counter\n" | |
837 | "value. The default prefix is @var{t}. The OBARRAY is specified as a\n" | |
838 | "second optional argument. Default is the system obarray where all\n" | |
839 | "normal symbols are interned. The counter is increased by 1 at each\n" | |
840 | "call. There is no provision for resetting the counter.") | |
841 | #define FUNC_NAME s_scm_gentemp | |
842 | { | |
843 | char buf[MAX_PREFIX_LENGTH + SCM_INTBUFLEN]; | |
844 | char *name = buf; | |
845 | int len, n_digits; | |
846 | if (SCM_UNBNDP (prefix)) | |
847 | { | |
848 | name[0] = 't'; | |
849 | len = 1; | |
850 | } | |
851 | else | |
1ff4df7a | 852 | { |
d1ca2c64 DH |
853 | SCM_VALIDATE_STRING (1, prefix); |
854 | len = SCM_STRING_LENGTH (prefix); | |
e1313058 MD |
855 | if (len > MAX_PREFIX_LENGTH) |
856 | name = SCM_MUST_MALLOC (MAX_PREFIX_LENGTH + SCM_INTBUFLEN); | |
34f0f2b8 | 857 | strncpy (name, SCM_STRING_CHARS (prefix), len); |
1ff4df7a | 858 | } |
e1313058 MD |
859 | |
860 | if (SCM_UNBNDP (obarray)) | |
861 | obarray = scm_symhash; | |
1ff4df7a | 862 | else |
368cf54d | 863 | SCM_ASSERT ((SCM_VECTORP (obarray) || SCM_WVECTP (obarray)), |
1ff4df7a MD |
864 | obarray, |
865 | SCM_ARG2, | |
1bbd0b84 | 866 | FUNC_NAME); |
e1313058 MD |
867 | do |
868 | n_digits = scm_iint2str (gentemp_counter++, 10, &name[len]); | |
869 | while (!SCM_FALSEP (scm_intern_obarray_soft (name, | |
870 | len + n_digits, | |
871 | obarray, | |
872 | 1))); | |
873 | { | |
874 | SCM vcell = scm_intern_obarray_soft (name, | |
875 | len + n_digits, | |
876 | obarray, | |
877 | 0); | |
878 | if (name != buf) | |
879 | scm_must_free (name); | |
880 | return SCM_CAR (vcell); | |
881 | } | |
1ff4df7a | 882 | } |
1bbd0b84 | 883 | #undef FUNC_NAME |
1cc91f1b | 884 | |
0f2d19dd JB |
885 | void |
886 | scm_init_symbols () | |
0f2d19dd | 887 | { |
1ff4df7a | 888 | gensym_counter = 0; |
e1313058 | 889 | gentemp_counter = 0; |
8dc9439f | 890 | #ifndef SCM_MAGIC_SNARFER |
a0599745 | 891 | #include "libguile/symbols.x" |
8dc9439f | 892 | #endif |
0f2d19dd | 893 | } |
89e00824 ML |
894 | |
895 | /* | |
896 | Local Variables: | |
897 | c-file-style: "gnu" | |
898 | End: | |
899 | */ |