Commit | Line | Data |
---|---|---|
2b829bbb | 1 | /* Copyright (C) 1995,1996,1997,1998,2000,2001, 2003, 2004, 2006 Free Software Foundation, Inc. |
0f2d19dd | 2 | * |
73be1d9e MV |
3 | * This library is free software; you can redistribute it and/or |
4 | * modify it under the terms of the GNU Lesser General Public | |
5 | * License as published by the Free Software Foundation; either | |
6 | * version 2.1 of the License, or (at your option) any later version. | |
0f2d19dd | 7 | * |
73be1d9e MV |
8 | * This library 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 GNU | |
11 | * Lesser General Public License for more details. | |
0f2d19dd | 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 | |
92205699 | 15 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA |
73be1d9e | 16 | */ |
1bbd0b84 | 17 | |
1bbd0b84 | 18 | |
0f2d19dd | 19 | \f |
dbb605f5 | 20 | #ifdef HAVE_CONFIG_H |
cf007485 RB |
21 | # include <config.h> |
22 | #endif | |
0f2d19dd | 23 | |
a0599745 MD |
24 | #include "libguile/_scm.h" |
25 | #include "libguile/chars.h" | |
26 | #include "libguile/eval.h" | |
ba393257 | 27 | #include "libguile/hash.h" |
fb43bf74 | 28 | #include "libguile/smob.h" |
a0599745 MD |
29 | #include "libguile/variable.h" |
30 | #include "libguile/alist.h" | |
7e73eaee | 31 | #include "libguile/fluids.h" |
a0599745 MD |
32 | #include "libguile/strings.h" |
33 | #include "libguile/vectors.h" | |
00ffa0e7 | 34 | #include "libguile/hashtab.h" |
a0599745 | 35 | #include "libguile/weaks.h" |
eb8db440 | 36 | #include "libguile/modules.h" |
1206efbe MV |
37 | #include "libguile/read.h" |
38 | #include "libguile/srfi-13.h" | |
a0599745 MD |
39 | |
40 | #include "libguile/validate.h" | |
41 | #include "libguile/symbols.h" | |
0f2d19dd | 42 | |
22fc179a HWN |
43 | #include "libguile/private-options.h" |
44 | ||
45 | ||
95b88819 GH |
46 | #ifdef HAVE_STRING_H |
47 | #include <string.h> | |
48 | #endif | |
49 | ||
0f2d19dd JB |
50 | \f |
51 | ||
0f979f3f DH |
52 | static SCM symbols; |
53 | ||
a4c91488 MD |
54 | #ifdef GUILE_DEBUG |
55 | SCM_DEFINE (scm_sys_symbols, "%symbols", 0, 0, 0, | |
56 | (), | |
57 | "Return the system symbol obarray.") | |
58 | #define FUNC_NAME s_scm_sys_symbols | |
59 | { | |
60 | return symbols; | |
61 | } | |
62 | #undef FUNC_NAME | |
63 | #endif | |
64 | ||
0f979f3f DH |
65 | \f |
66 | ||
0f2d19dd JB |
67 | /* {Symbols} |
68 | */ | |
69 | ||
c35738c1 MD |
70 | /* In order to optimize reading speed, this function breaks part of |
71 | * the hashtable abstraction. The optimizations are: | |
72 | * | |
73 | * 1. The argument string can be compared directly to symbol objects | |
74 | * without first creating an SCM string object. (This would have | |
75 | * been necessary if we had used the hashtable API in hashtab.h.) | |
76 | * | |
3ee86942 | 77 | * 2. We can use the raw hash value stored in scm_i_symbol_hash (sym) |
c35738c1 MD |
78 | * to speed up lookup. |
79 | * | |
80 | * Both optimizations might be possible without breaking the | |
81 | * abstraction if the API in hashtab.c is improved. | |
82 | */ | |
83 | ||
84 | unsigned long | |
85 | scm_i_hash_symbol (SCM obj, unsigned long n, void *closure) | |
86 | { | |
3ee86942 | 87 | return scm_i_symbol_hash (obj) % n; |
c35738c1 | 88 | } |
1cc91f1b | 89 | |
3ee86942 | 90 | static SCM |
fd0a5bbc HWN |
91 | lookup_interned_symbol (const char *name, size_t len, |
92 | unsigned long raw_hash) | |
b52e071b | 93 | { |
fd0a5bbc | 94 | /* Try to find the symbol in the symbols table */ |
488b10b5 LC |
95 | SCM result = SCM_BOOL_F; |
96 | SCM bucket, elt, previous_elt; | |
fd0a5bbc HWN |
97 | unsigned long hash = raw_hash % SCM_HASHTABLE_N_BUCKETS (symbols); |
98 | ||
488b10b5 LC |
99 | bucket = SCM_HASHTABLE_BUCKET (symbols, hash); |
100 | for (elt = bucket, previous_elt = SCM_BOOL_F; | |
101 | !scm_is_null (elt); | |
102 | previous_elt = elt, elt = SCM_CDR (elt)) | |
fd0a5bbc | 103 | { |
3a2de079 LC |
104 | SCM pair, sym; |
105 | ||
488b10b5 | 106 | pair = SCM_CAR (elt); |
3a2de079 LC |
107 | if (!scm_is_pair (pair)) |
108 | abort (); | |
488b10b5 LC |
109 | |
110 | if (SCM_WEAK_PAIR_CAR_DELETED_P (pair)) | |
111 | { | |
112 | /* PAIR is a weak pair whose key got nullified: remove it from | |
113 | BUCKET. */ | |
114 | /* FIXME: Since this is done lazily, i.e., only when a new symbol | |
115 | is to be inserted in a bucket containing deleted symbols, the | |
116 | number of items in the hash table may remain erroneous for some | |
117 | time, thus precluding proper rehashing. */ | |
118 | if (previous_elt != SCM_BOOL_F) | |
119 | SCM_SETCDR (previous_elt, SCM_CDR (elt)); | |
120 | else | |
121 | bucket = SCM_CDR (elt); | |
122 | ||
123 | SCM_HASHTABLE_DECREMENT (symbols); | |
124 | continue; | |
125 | } | |
3a2de079 LC |
126 | |
127 | sym = SCM_CAR (pair); | |
128 | ||
fd0a5bbc HWN |
129 | if (scm_i_symbol_hash (sym) == raw_hash |
130 | && scm_i_symbol_length (sym) == len) | |
131 | { | |
132 | const char *chrs = scm_i_symbol_chars (sym); | |
133 | size_t i = len; | |
134 | ||
135 | while (i != 0) | |
136 | { | |
137 | --i; | |
138 | if (name[i] != chrs[i]) | |
139 | goto next_symbol; | |
140 | } | |
141 | ||
488b10b5 LC |
142 | /* We found it. */ |
143 | result = sym; | |
144 | break; | |
fd0a5bbc HWN |
145 | } |
146 | next_symbol: | |
147 | ; | |
148 | } | |
149 | ||
488b10b5 LC |
150 | if (SCM_HASHTABLE_N_ITEMS (symbols) < SCM_HASHTABLE_LOWER (symbols)) |
151 | /* We removed many symbols in this pass so trigger a rehashing. */ | |
152 | scm_i_rehash (symbols, scm_i_hash_symbol, 0, "lookup_interned_symbol"); | |
153 | ||
154 | return result; | |
fd0a5bbc | 155 | } |
3ee86942 | 156 | |
fd0a5bbc HWN |
157 | static SCM |
158 | scm_i_c_mem2symbol (const char *name, size_t len) | |
159 | { | |
160 | SCM symbol; | |
6869328b | 161 | size_t raw_hash = scm_string_hash ((const unsigned char *) name, len); |
c35738c1 | 162 | size_t hash = raw_hash % SCM_HASHTABLE_N_BUCKETS (symbols); |
b52e071b | 163 | |
fd0a5bbc HWN |
164 | symbol = lookup_interned_symbol (name, len, raw_hash); |
165 | if (symbol != SCM_BOOL_F) | |
166 | return symbol; | |
167 | ||
b52e071b | 168 | { |
fd0a5bbc HWN |
169 | /* The symbol was not found - create it. */ |
170 | SCM symbol = scm_i_c_make_symbol (name, len, 0, raw_hash, | |
171 | scm_cons (SCM_BOOL_F, SCM_EOL)); | |
172 | ||
173 | SCM slot = SCM_HASHTABLE_BUCKET (symbols, hash); | |
488b10b5 | 174 | SCM cell = scm_weak_car_pair (symbol, SCM_UNDEFINED); |
fd0a5bbc HWN |
175 | SCM_SET_HASHTABLE_BUCKET (symbols, hash, scm_cons (cell, slot)); |
176 | SCM_HASHTABLE_INCREMENT (symbols); | |
177 | if (SCM_HASHTABLE_N_ITEMS (symbols) > SCM_HASHTABLE_UPPER (symbols)) | |
178 | scm_i_rehash (symbols, scm_i_hash_symbol, 0, "scm_mem2symbol"); | |
179 | ||
180 | return symbol; | |
b52e071b | 181 | } |
fd0a5bbc HWN |
182 | } |
183 | ||
184 | static SCM | |
185 | scm_i_mem2symbol (SCM str) | |
186 | { | |
187 | SCM symbol; | |
188 | const char *name = scm_i_string_chars (str); | |
189 | size_t len = scm_i_string_length (str); | |
190 | size_t raw_hash = scm_string_hash ((const unsigned char *) name, len); | |
191 | size_t hash = raw_hash % SCM_HASHTABLE_N_BUCKETS (symbols); | |
192 | ||
193 | symbol = lookup_interned_symbol (name, len, raw_hash); | |
194 | if (symbol != SCM_BOOL_F) | |
195 | return symbol; | |
b52e071b DH |
196 | |
197 | { | |
198 | /* The symbol was not found - create it. */ | |
6869328b | 199 | SCM symbol = scm_i_make_symbol (str, 0, raw_hash, |
3ee86942 | 200 | scm_cons (SCM_BOOL_F, SCM_EOL)); |
b52e071b | 201 | |
4057a3e0 | 202 | SCM slot = SCM_HASHTABLE_BUCKET (symbols, hash); |
488b10b5 | 203 | SCM cell = scm_weak_car_pair (symbol, SCM_UNDEFINED); |
c35738c1 MD |
204 | SCM_SET_HASHTABLE_BUCKET (symbols, hash, scm_cons (cell, slot)); |
205 | SCM_HASHTABLE_INCREMENT (symbols); | |
206 | if (SCM_HASHTABLE_N_ITEMS (symbols) > SCM_HASHTABLE_UPPER (symbols)) | |
207 | scm_i_rehash (symbols, scm_i_hash_symbol, 0, "scm_mem2symbol"); | |
b52e071b DH |
208 | |
209 | return symbol; | |
210 | } | |
211 | } | |
212 | ||
fd0a5bbc | 213 | |
3ee86942 MV |
214 | static SCM |
215 | scm_i_mem2uninterned_symbol (SCM str) | |
ac48757b | 216 | { |
3ee86942 MV |
217 | const char *name = scm_i_string_chars (str); |
218 | size_t len = scm_i_string_length (str); | |
6869328b | 219 | size_t raw_hash = scm_string_hash ((const unsigned char *) name, len); |
3ee86942 | 220 | |
6869328b MV |
221 | return scm_i_make_symbol (str, SCM_I_F_SYMBOL_UNINTERNED, |
222 | raw_hash, scm_cons (SCM_BOOL_F, SCM_EOL)); | |
b52e071b DH |
223 | } |
224 | ||
3b3b36dd | 225 | SCM_DEFINE (scm_symbol_p, "symbol?", 1, 0, 0, |
8e93e199 | 226 | (SCM obj), |
1e6808ea MG |
227 | "Return @code{#t} if @var{obj} is a symbol, otherwise return\n" |
228 | "@code{#f}.") | |
1bbd0b84 | 229 | #define FUNC_NAME s_scm_symbol_p |
0f2d19dd | 230 | { |
3ee86942 | 231 | return scm_from_bool (scm_is_symbol (obj)); |
0f2d19dd | 232 | } |
1bbd0b84 | 233 | #undef FUNC_NAME |
0f2d19dd | 234 | |
ac48757b MV |
235 | SCM_DEFINE (scm_symbol_interned_p, "symbol-interned?", 1, 0, 0, |
236 | (SCM symbol), | |
237 | "Return @code{#t} if @var{symbol} is interned, otherwise return\n" | |
238 | "@code{#f}.") | |
239 | #define FUNC_NAME s_scm_symbol_interned_p | |
240 | { | |
241 | SCM_VALIDATE_SYMBOL (1, symbol); | |
3ee86942 | 242 | return scm_from_bool (scm_i_symbol_is_interned (symbol)); |
ac48757b MV |
243 | } |
244 | #undef FUNC_NAME | |
245 | ||
246 | SCM_DEFINE (scm_make_symbol, "make-symbol", 1, 0, 0, | |
247 | (SCM name), | |
248 | "Return a new uninterned symbol with the name @var{name}. " | |
249 | "The returned symbol is guaranteed to be unique and future " | |
d58d5bfc | 250 | "calls to @code{string->symbol} will not return it.") |
ac48757b MV |
251 | #define FUNC_NAME s_scm_make_symbol |
252 | { | |
ac48757b | 253 | SCM_VALIDATE_STRING (1, name); |
3ee86942 | 254 | return scm_i_mem2uninterned_symbol (name); |
ac48757b MV |
255 | } |
256 | #undef FUNC_NAME | |
257 | ||
3b3b36dd | 258 | SCM_DEFINE (scm_symbol_to_string, "symbol->string", 1, 0, 0, |
1bbd0b84 | 259 | (SCM s), |
1e6808ea MG |
260 | "Return the name of @var{symbol} as a string. If the symbol was\n" |
261 | "part of an object returned as the value of a literal expression\n" | |
7a095584 | 262 | "(section @pxref{Literal expressions,,,r5rs, The Revised^5\n" |
1e6808ea MG |
263 | "Report on Scheme}) or by a call to the @code{read} procedure,\n" |
264 | "and its name contains alphabetic characters, then the string\n" | |
265 | "returned will contain characters in the implementation's\n" | |
266 | "preferred standard case---some implementations will prefer\n" | |
267 | "upper case, others lower case. If the symbol was returned by\n" | |
268 | "@code{string->symbol}, the case of characters in the string\n" | |
269 | "returned will be the same as the case in the string that was\n" | |
270 | "passed to @code{string->symbol}. It is an error to apply\n" | |
271 | "mutation procedures like @code{string-set!} to strings returned\n" | |
272 | "by this procedure.\n" | |
273 | "\n" | |
942e5b91 | 274 | "The following examples assume that the implementation's\n" |
1e6808ea MG |
275 | "standard case is lower case:\n" |
276 | "\n" | |
942e5b91 | 277 | "@lisp\n" |
1e6808ea MG |
278 | "(symbol->string 'flying-fish) @result{} \"flying-fish\"\n" |
279 | "(symbol->string 'Martin) @result{} \"martin\"\n" | |
5ffe9968 | 280 | "(symbol->string\n" |
942e5b91 MG |
281 | " (string->symbol \"Malvina\")) @result{} \"Malvina\"\n" |
282 | "@end lisp") | |
1bbd0b84 | 283 | #define FUNC_NAME s_scm_symbol_to_string |
0f2d19dd | 284 | { |
28b06554 | 285 | SCM_VALIDATE_SYMBOL (1, s); |
3ee86942 | 286 | return scm_i_symbol_substring (s, 0, scm_i_symbol_length (s)); |
0f2d19dd | 287 | } |
1bbd0b84 | 288 | #undef FUNC_NAME |
0f2d19dd JB |
289 | |
290 | ||
3b3b36dd | 291 | SCM_DEFINE (scm_string_to_symbol, "string->symbol", 1, 0, 0, |
1e6808ea MG |
292 | (SCM string), |
293 | "Return the symbol whose name is @var{string}. This procedure\n" | |
942e5b91 MG |
294 | "can create symbols with names containing special characters or\n" |
295 | "letters in the non-standard case, but it is usually a bad idea\n" | |
1e6808ea MG |
296 | "to create such symbols because in some implementations of\n" |
297 | "Scheme they cannot be read as themselves. See\n" | |
298 | "@code{symbol->string}.\n" | |
299 | "\n" | |
942e5b91 | 300 | "The following examples assume that the implementation's\n" |
1e6808ea MG |
301 | "standard case is lower case:\n" |
302 | "\n" | |
942e5b91 MG |
303 | "@lisp\n" |
304 | "(eq? 'mISSISSIppi 'mississippi) @result{} #t\n" | |
305 | "(string->symbol \"mISSISSIppi\") @result{} @r{the symbol with name \"mISSISSIppi\"}\n" | |
306 | "(eq? 'bitBlt (string->symbol \"bitBlt\")) @result{} #f\n" | |
307 | "(eq? 'JollyWog\n" | |
308 | " (string->symbol (symbol->string 'JollyWog))) @result{} #t\n" | |
309 | "(string=? \"K. Harper, M.D.\"\n" | |
310 | " (symbol->string\n" | |
311 | " (string->symbol \"K. Harper, M.D.\"))) @result{}#t\n" | |
312 | "@end lisp") | |
1bbd0b84 | 313 | #define FUNC_NAME s_scm_string_to_symbol |
0f2d19dd | 314 | { |
1e6808ea | 315 | SCM_VALIDATE_STRING (1, string); |
3ee86942 | 316 | return scm_i_mem2symbol (string); |
0f2d19dd | 317 | } |
1bbd0b84 | 318 | #undef FUNC_NAME |
0f2d19dd | 319 | |
1206efbe MV |
320 | SCM_DEFINE (scm_string_ci_to_symbol, "string-ci->symbol", 1, 0, 0, |
321 | (SCM str), | |
322 | "Return the symbol whose name is @var{str}. @var{str} is\n" | |
323 | "converted to lowercase before the conversion is done, if Guile\n" | |
324 | "is currently reading symbols case-insensitively.") | |
325 | #define FUNC_NAME s_scm_string_ci_to_symbol | |
326 | { | |
327 | return scm_string_to_symbol (SCM_CASE_INSENSITIVE_P | |
328 | ? scm_string_downcase(str) | |
329 | : str); | |
330 | } | |
331 | #undef FUNC_NAME | |
332 | ||
86d31dfe | 333 | #define MAX_PREFIX_LENGTH 30 |
0f2d19dd | 334 | |
86d31dfe MV |
335 | SCM_DEFINE (scm_gensym, "gensym", 0, 1, 0, |
336 | (SCM prefix), | |
337 | "Create a new symbol with a name constructed from a prefix and\n" | |
338 | "a counter value. The string @var{prefix} can be specified as\n" | |
68dc153d | 339 | "an optional argument. Default prefix is @code{ g}. The counter\n" |
86d31dfe MV |
340 | "is increased by 1 at each call. There is no provision for\n" |
341 | "resetting the counter.") | |
342 | #define FUNC_NAME s_scm_gensym | |
0f2d19dd | 343 | { |
7426a638 | 344 | static int gensym_counter = 0; |
3ee86942 MV |
345 | |
346 | SCM suffix, name; | |
347 | int n, n_digits; | |
348 | char buf[SCM_INTBUFLEN]; | |
7426a638 | 349 | |
86d31dfe | 350 | if (SCM_UNBNDP (prefix)) |
3ee86942 MV |
351 | prefix = scm_from_locale_string (" g"); |
352 | ||
353 | /* mutex in case another thread looks and incs at the exact same moment */ | |
9de87eea | 354 | scm_i_scm_pthread_mutex_lock (&scm_i_misc_mutex); |
3ee86942 | 355 | n = gensym_counter++; |
9de87eea | 356 | scm_i_pthread_mutex_unlock (&scm_i_misc_mutex); |
3ee86942 MV |
357 | |
358 | n_digits = scm_iint2str (n, 10, buf); | |
359 | suffix = scm_from_locale_stringn (buf, n_digits); | |
360 | name = scm_string_append (scm_list_2 (prefix, suffix)); | |
361 | return scm_string_to_symbol (name); | |
0f2d19dd | 362 | } |
1bbd0b84 | 363 | #undef FUNC_NAME |
0f2d19dd | 364 | |
86d31dfe MV |
365 | SCM_DEFINE (scm_symbol_hash, "symbol-hash", 1, 0, 0, |
366 | (SCM symbol), | |
367 | "Return a hash value for @var{symbol}.") | |
368 | #define FUNC_NAME s_scm_symbol_hash | |
0f2d19dd | 369 | { |
86d31dfe | 370 | SCM_VALIDATE_SYMBOL (1, symbol); |
3ee86942 | 371 | return scm_from_ulong (scm_i_symbol_hash (symbol)); |
0f2d19dd | 372 | } |
1bbd0b84 | 373 | #undef FUNC_NAME |
0f2d19dd | 374 | |
3b3b36dd | 375 | SCM_DEFINE (scm_symbol_fref, "symbol-fref", 1, 0, 0, |
1bbd0b84 | 376 | (SCM s), |
b380b885 | 377 | "Return the contents of @var{symbol}'s @dfn{function slot}.") |
1bbd0b84 | 378 | #define FUNC_NAME s_scm_symbol_fref |
0f2d19dd | 379 | { |
34d19ef6 | 380 | SCM_VALIDATE_SYMBOL (1, s); |
3ee86942 | 381 | return SCM_CAR (SCM_CELL_OBJECT_3 (s)); |
0f2d19dd | 382 | } |
1bbd0b84 | 383 | #undef FUNC_NAME |
0f2d19dd JB |
384 | |
385 | ||
3b3b36dd | 386 | SCM_DEFINE (scm_symbol_pref, "symbol-pref", 1, 0, 0, |
1bbd0b84 | 387 | (SCM s), |
b380b885 | 388 | "Return the @dfn{property list} currently associated with @var{symbol}.") |
1bbd0b84 | 389 | #define FUNC_NAME s_scm_symbol_pref |
0f2d19dd | 390 | { |
34d19ef6 | 391 | SCM_VALIDATE_SYMBOL (1, s); |
3ee86942 | 392 | return SCM_CDR (SCM_CELL_OBJECT_3 (s)); |
0f2d19dd | 393 | } |
1bbd0b84 | 394 | #undef FUNC_NAME |
0f2d19dd JB |
395 | |
396 | ||
3b3b36dd | 397 | SCM_DEFINE (scm_symbol_fset_x, "symbol-fset!", 2, 0, 0, |
1bbd0b84 | 398 | (SCM s, SCM val), |
b380b885 | 399 | "Change the binding of @var{symbol}'s function slot.") |
1bbd0b84 | 400 | #define FUNC_NAME s_scm_symbol_fset_x |
0f2d19dd | 401 | { |
34d19ef6 | 402 | SCM_VALIDATE_SYMBOL (1, s); |
3ee86942 | 403 | SCM_SETCAR (SCM_CELL_OBJECT_3 (s), val); |
0f2d19dd JB |
404 | return SCM_UNSPECIFIED; |
405 | } | |
1bbd0b84 | 406 | #undef FUNC_NAME |
0f2d19dd JB |
407 | |
408 | ||
3b3b36dd | 409 | SCM_DEFINE (scm_symbol_pset_x, "symbol-pset!", 2, 0, 0, |
1bbd0b84 | 410 | (SCM s, SCM val), |
b380b885 | 411 | "Change the binding of @var{symbol}'s property slot.") |
1bbd0b84 | 412 | #define FUNC_NAME s_scm_symbol_pset_x |
0f2d19dd | 413 | { |
34d19ef6 | 414 | SCM_VALIDATE_SYMBOL (1, s); |
3ee86942 | 415 | SCM_SETCDR (SCM_CELL_OBJECT_3 (s), val); |
0f2d19dd JB |
416 | return SCM_UNSPECIFIED; |
417 | } | |
1bbd0b84 | 418 | #undef FUNC_NAME |
0f2d19dd | 419 | |
3ee86942 MV |
420 | SCM |
421 | scm_from_locale_symbol (const char *sym) | |
af68e5e5 | 422 | { |
fd0a5bbc | 423 | return scm_i_c_mem2symbol (sym, strlen (sym)); |
af68e5e5 | 424 | } |
af68e5e5 | 425 | |
3ee86942 MV |
426 | SCM |
427 | scm_from_locale_symboln (const char *sym, size_t len) | |
428 | { | |
fd0a5bbc HWN |
429 | return scm_i_c_mem2symbol (sym, len); |
430 | } | |
431 | ||
432 | SCM | |
433 | scm_take_locale_symboln (char *sym, size_t len) | |
434 | { | |
435 | SCM res; | |
436 | unsigned long raw_hash; | |
437 | ||
438 | if (len == (size_t)-1) | |
439 | len = strlen (sym); | |
440 | else | |
441 | { | |
442 | /* Ensure STR is null terminated. A realloc for 1 extra byte should | |
443 | often be satisfied from the alignment padding after the block, with | |
444 | no actual data movement. */ | |
445 | sym = scm_realloc (sym, len+1); | |
446 | sym[len] = '\0'; | |
447 | } | |
448 | ||
449 | raw_hash = scm_string_hash ((unsigned char *)sym, len); | |
450 | res = lookup_interned_symbol (sym, len, raw_hash); | |
451 | if (res != SCM_BOOL_F) | |
452 | { | |
453 | free (sym); | |
454 | return res; | |
455 | } | |
456 | ||
457 | res = scm_i_c_take_symbol (sym, len, 0, raw_hash, | |
458 | scm_cons (SCM_BOOL_F, SCM_EOL)); | |
459 | ||
460 | return res; | |
461 | } | |
462 | ||
463 | SCM | |
464 | scm_take_locale_symbol (char *sym) | |
465 | { | |
466 | return scm_take_locale_symboln (sym, (size_t)-1); | |
3ee86942 | 467 | } |
af68e5e5 | 468 | |
0f979f3f DH |
469 | void |
470 | scm_symbols_prehistory () | |
471 | { | |
e11e83f3 | 472 | symbols = scm_make_weak_key_hash_table (scm_from_int (2139)); |
0f979f3f DH |
473 | } |
474 | ||
475 | ||
0f2d19dd JB |
476 | void |
477 | scm_init_symbols () | |
0f2d19dd | 478 | { |
a0599745 | 479 | #include "libguile/symbols.x" |
0f2d19dd | 480 | } |
89e00824 ML |
481 | |
482 | /* | |
483 | Local Variables: | |
484 | c-file-style: "gnu" | |
485 | End: | |
486 | */ |