Commit | Line | Data |
---|---|---|
ceed7709 LC |
1 | /* Copyright (C) 1995, 1996, 1997, 1998, 2000, 2001, 2003, 2004, |
2 | * 2006, 2009, 2011 Free Software Foundation, Inc. | |
3 | * | |
73be1d9e | 4 | * This library is free software; you can redistribute it and/or |
53befeb7 NJ |
5 | * modify it under the terms of the GNU Lesser General Public License |
6 | * as published by the Free Software Foundation; either version 3 of | |
7 | * the License, or (at your option) any later version. | |
0f2d19dd | 8 | * |
53befeb7 NJ |
9 | * This library is distributed in the hope that it will be useful, but |
10 | * WITHOUT ANY WARRANTY; without even the implied warranty of | |
73be1d9e MV |
11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
12 | * Lesser General Public License for more details. | |
0f2d19dd | 13 | * |
73be1d9e MV |
14 | * You should have received a copy of the GNU Lesser General Public |
15 | * License along with this library; if not, write to the Free Software | |
53befeb7 NJ |
16 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
17 | * 02110-1301 USA | |
73be1d9e | 18 | */ |
1bbd0b84 | 19 | |
1bbd0b84 | 20 | |
0f2d19dd | 21 | \f |
dbb605f5 | 22 | #ifdef HAVE_CONFIG_H |
cf007485 RB |
23 | # include <config.h> |
24 | #endif | |
0f2d19dd | 25 | |
a0599745 MD |
26 | #include "libguile/_scm.h" |
27 | #include "libguile/chars.h" | |
28 | #include "libguile/eval.h" | |
ba393257 | 29 | #include "libguile/hash.h" |
fb43bf74 | 30 | #include "libguile/smob.h" |
a0599745 MD |
31 | #include "libguile/variable.h" |
32 | #include "libguile/alist.h" | |
7e73eaee | 33 | #include "libguile/fluids.h" |
a0599745 MD |
34 | #include "libguile/strings.h" |
35 | #include "libguile/vectors.h" | |
00ffa0e7 | 36 | #include "libguile/hashtab.h" |
a0599745 | 37 | #include "libguile/weaks.h" |
eb8db440 | 38 | #include "libguile/modules.h" |
1206efbe MV |
39 | #include "libguile/read.h" |
40 | #include "libguile/srfi-13.h" | |
a0599745 MD |
41 | |
42 | #include "libguile/validate.h" | |
43 | #include "libguile/symbols.h" | |
0f2d19dd | 44 | |
22fc179a HWN |
45 | #include "libguile/private-options.h" |
46 | ||
47 | ||
95b88819 GH |
48 | #ifdef HAVE_STRING_H |
49 | #include <string.h> | |
50 | #endif | |
51 | ||
0f2d19dd JB |
52 | \f |
53 | ||
0f979f3f | 54 | static SCM symbols; |
b3460881 | 55 | static scm_i_pthread_mutex_t symbols_lock = SCM_I_PTHREAD_MUTEX_INITIALIZER; |
0f979f3f | 56 | |
a4c91488 MD |
57 | #ifdef GUILE_DEBUG |
58 | SCM_DEFINE (scm_sys_symbols, "%symbols", 0, 0, 0, | |
59 | (), | |
60 | "Return the system symbol obarray.") | |
61 | #define FUNC_NAME s_scm_sys_symbols | |
62 | { | |
63 | return symbols; | |
64 | } | |
65 | #undef FUNC_NAME | |
66 | #endif | |
67 | ||
0f979f3f DH |
68 | \f |
69 | ||
0f2d19dd JB |
70 | /* {Symbols} |
71 | */ | |
72 | ||
c35738c1 MD |
73 | unsigned long |
74 | scm_i_hash_symbol (SCM obj, unsigned long n, void *closure) | |
75 | { | |
3ee86942 | 76 | return scm_i_symbol_hash (obj) % n; |
c35738c1 | 77 | } |
1cc91f1b | 78 | |
e0c83bf5 AW |
79 | struct string_lookup_data |
80 | { | |
17072fd2 | 81 | SCM string; |
e0c83bf5 AW |
82 | unsigned long string_hash; |
83 | }; | |
84 | ||
17072fd2 AW |
85 | static int |
86 | string_lookup_predicate_fn (SCM sym, void *closure) | |
e0c83bf5 AW |
87 | { |
88 | struct string_lookup_data *data = closure; | |
89 | ||
17072fd2 AW |
90 | if (scm_i_symbol_hash (sym) == data->string_hash |
91 | && scm_i_symbol_length (sym) == scm_i_string_length (data->string)) | |
fd0a5bbc | 92 | { |
17072fd2 AW |
93 | size_t n = scm_i_symbol_length (sym); |
94 | while (n--) | |
95 | if (scm_i_symbol_ref (sym, n) != scm_i_string_ref (data->string, n)) | |
96 | return 0; | |
97 | return 1; | |
fd0a5bbc | 98 | } |
17072fd2 AW |
99 | else |
100 | return 0; | |
e0c83bf5 | 101 | } |
488b10b5 | 102 | |
e0c83bf5 AW |
103 | static SCM |
104 | lookup_interned_symbol (SCM name, unsigned long raw_hash) | |
105 | { | |
106 | struct string_lookup_data data; | |
107 | SCM handle; | |
108 | ||
17072fd2 | 109 | data.string = name; |
e0c83bf5 AW |
110 | data.string_hash = raw_hash; |
111 | ||
b3460881 | 112 | scm_i_pthread_mutex_lock (&symbols_lock); |
17072fd2 AW |
113 | handle = scm_hash_fn_get_handle_by_hash (symbols, raw_hash, |
114 | string_lookup_predicate_fn, | |
115 | &data); | |
b3460881 | 116 | scm_i_pthread_mutex_unlock (&symbols_lock); |
e0c83bf5 AW |
117 | |
118 | if (scm_is_true (handle)) | |
119 | return SCM_CAR (handle); | |
120 | else | |
121 | return SCM_BOOL_F; | |
fd0a5bbc | 122 | } |
3ee86942 | 123 | |
30c282bf AW |
124 | struct latin1_lookup_data |
125 | { | |
126 | const char *str; | |
127 | size_t len; | |
128 | unsigned long string_hash; | |
129 | }; | |
130 | ||
131 | static int | |
132 | latin1_lookup_predicate_fn (SCM sym, void *closure) | |
133 | { | |
134 | struct latin1_lookup_data *data = closure; | |
135 | ||
136 | return scm_i_symbol_hash (sym) == data->string_hash | |
137 | && scm_i_is_narrow_symbol (sym) | |
138 | && scm_i_symbol_length (sym) == data->len | |
139 | && strncmp (scm_i_symbol_chars (sym), data->str, data->len) == 0; | |
140 | } | |
141 | ||
142 | static SCM | |
143 | lookup_interned_latin1_symbol (const char *str, size_t len, | |
144 | unsigned long raw_hash) | |
145 | { | |
146 | struct latin1_lookup_data data; | |
147 | SCM handle; | |
148 | ||
149 | data.str = str; | |
150 | data.len = len; | |
151 | data.string_hash = raw_hash; | |
152 | ||
b3460881 | 153 | scm_i_pthread_mutex_lock (&symbols_lock); |
30c282bf AW |
154 | handle = scm_hash_fn_get_handle_by_hash (symbols, raw_hash, |
155 | latin1_lookup_predicate_fn, | |
156 | &data); | |
b3460881 | 157 | scm_i_pthread_mutex_unlock (&symbols_lock); |
30c282bf AW |
158 | |
159 | if (scm_is_true (handle)) | |
160 | return SCM_CAR (handle); | |
161 | else | |
162 | return SCM_BOOL_F; | |
163 | } | |
164 | ||
e0c83bf5 AW |
165 | static unsigned long |
166 | symbol_lookup_hash_fn (SCM obj, unsigned long max, void *closure) | |
167 | { | |
168 | return scm_i_symbol_hash (obj) % max; | |
169 | } | |
170 | ||
171 | static SCM | |
172 | symbol_lookup_assoc_fn (SCM obj, SCM alist, void *closure) | |
05588a1a | 173 | { |
e0c83bf5 AW |
174 | for (; !scm_is_null (alist); alist = SCM_CDR (alist)) |
175 | { | |
176 | SCM sym = SCM_CAAR (alist); | |
177 | ||
178 | if (scm_i_symbol_hash (sym) == scm_i_symbol_hash (obj) | |
179 | && scm_is_true (scm_string_equal_p (scm_symbol_to_string (sym), | |
180 | scm_symbol_to_string (obj)))) | |
181 | return SCM_CAR (alist); | |
182 | } | |
183 | ||
184 | return SCM_BOOL_F; | |
185 | } | |
186 | ||
e0c83bf5 AW |
187 | /* Intern SYMBOL, an uninterned symbol. Might return a different |
188 | symbol, if another one was interned at the same time. */ | |
189 | static SCM | |
190 | intern_symbol (SCM symbol) | |
191 | { | |
192 | SCM handle; | |
05588a1a | 193 | |
b3460881 | 194 | scm_i_pthread_mutex_lock (&symbols_lock); |
e0c83bf5 AW |
195 | handle = scm_hash_fn_create_handle_x (symbols, symbol, SCM_UNDEFINED, |
196 | symbol_lookup_hash_fn, | |
197 | symbol_lookup_assoc_fn, | |
198 | NULL); | |
b3460881 | 199 | scm_i_pthread_mutex_unlock (&symbols_lock); |
05588a1a | 200 | |
e0c83bf5 | 201 | return SCM_CAR (handle); |
05588a1a LC |
202 | } |
203 | ||
fd0a5bbc | 204 | static SCM |
e23106d5 | 205 | scm_i_str2symbol (SCM str) |
fd0a5bbc HWN |
206 | { |
207 | SCM symbol; | |
e23106d5 | 208 | size_t raw_hash = scm_i_string_hash (str); |
b52e071b | 209 | |
e23106d5 | 210 | symbol = lookup_interned_symbol (str, raw_hash); |
e0c83bf5 AW |
211 | if (scm_is_true (symbol)) |
212 | return symbol; | |
213 | else | |
05588a1a LC |
214 | { |
215 | /* The symbol was not found, create it. */ | |
216 | symbol = scm_i_make_symbol (str, 0, raw_hash, | |
217 | scm_cons (SCM_BOOL_F, SCM_EOL)); | |
e0c83bf5 | 218 | return intern_symbol (symbol); |
05588a1a | 219 | } |
b52e071b DH |
220 | } |
221 | ||
fd0a5bbc | 222 | |
3ee86942 | 223 | static SCM |
e23106d5 | 224 | scm_i_str2uninterned_symbol (SCM str) |
ac48757b | 225 | { |
e23106d5 | 226 | size_t raw_hash = scm_i_string_hash (str); |
3ee86942 | 227 | |
6869328b MV |
228 | return scm_i_make_symbol (str, SCM_I_F_SYMBOL_UNINTERNED, |
229 | raw_hash, scm_cons (SCM_BOOL_F, SCM_EOL)); | |
b52e071b DH |
230 | } |
231 | ||
3b3b36dd | 232 | SCM_DEFINE (scm_symbol_p, "symbol?", 1, 0, 0, |
8e93e199 | 233 | (SCM obj), |
1e6808ea MG |
234 | "Return @code{#t} if @var{obj} is a symbol, otherwise return\n" |
235 | "@code{#f}.") | |
1bbd0b84 | 236 | #define FUNC_NAME s_scm_symbol_p |
0f2d19dd | 237 | { |
3ee86942 | 238 | return scm_from_bool (scm_is_symbol (obj)); |
0f2d19dd | 239 | } |
1bbd0b84 | 240 | #undef FUNC_NAME |
0f2d19dd | 241 | |
ac48757b MV |
242 | SCM_DEFINE (scm_symbol_interned_p, "symbol-interned?", 1, 0, 0, |
243 | (SCM symbol), | |
244 | "Return @code{#t} if @var{symbol} is interned, otherwise return\n" | |
245 | "@code{#f}.") | |
246 | #define FUNC_NAME s_scm_symbol_interned_p | |
247 | { | |
248 | SCM_VALIDATE_SYMBOL (1, symbol); | |
3ee86942 | 249 | return scm_from_bool (scm_i_symbol_is_interned (symbol)); |
ac48757b MV |
250 | } |
251 | #undef FUNC_NAME | |
252 | ||
253 | SCM_DEFINE (scm_make_symbol, "make-symbol", 1, 0, 0, | |
254 | (SCM name), | |
255 | "Return a new uninterned symbol with the name @var{name}. " | |
256 | "The returned symbol is guaranteed to be unique and future " | |
d58d5bfc | 257 | "calls to @code{string->symbol} will not return it.") |
ac48757b MV |
258 | #define FUNC_NAME s_scm_make_symbol |
259 | { | |
ac48757b | 260 | SCM_VALIDATE_STRING (1, name); |
e23106d5 | 261 | return scm_i_str2uninterned_symbol (name); |
ac48757b MV |
262 | } |
263 | #undef FUNC_NAME | |
264 | ||
3b3b36dd | 265 | SCM_DEFINE (scm_symbol_to_string, "symbol->string", 1, 0, 0, |
1bbd0b84 | 266 | (SCM s), |
1e6808ea MG |
267 | "Return the name of @var{symbol} as a string. If the symbol was\n" |
268 | "part of an object returned as the value of a literal expression\n" | |
7a095584 | 269 | "(section @pxref{Literal expressions,,,r5rs, The Revised^5\n" |
1e6808ea MG |
270 | "Report on Scheme}) or by a call to the @code{read} procedure,\n" |
271 | "and its name contains alphabetic characters, then the string\n" | |
272 | "returned will contain characters in the implementation's\n" | |
273 | "preferred standard case---some implementations will prefer\n" | |
274 | "upper case, others lower case. If the symbol was returned by\n" | |
275 | "@code{string->symbol}, the case of characters in the string\n" | |
276 | "returned will be the same as the case in the string that was\n" | |
277 | "passed to @code{string->symbol}. It is an error to apply\n" | |
278 | "mutation procedures like @code{string-set!} to strings returned\n" | |
279 | "by this procedure.\n" | |
280 | "\n" | |
942e5b91 | 281 | "The following examples assume that the implementation's\n" |
1e6808ea MG |
282 | "standard case is lower case:\n" |
283 | "\n" | |
942e5b91 | 284 | "@lisp\n" |
1e6808ea MG |
285 | "(symbol->string 'flying-fish) @result{} \"flying-fish\"\n" |
286 | "(symbol->string 'Martin) @result{} \"martin\"\n" | |
5ffe9968 | 287 | "(symbol->string\n" |
942e5b91 MG |
288 | " (string->symbol \"Malvina\")) @result{} \"Malvina\"\n" |
289 | "@end lisp") | |
1bbd0b84 | 290 | #define FUNC_NAME s_scm_symbol_to_string |
0f2d19dd | 291 | { |
28b06554 | 292 | SCM_VALIDATE_SYMBOL (1, s); |
3ee86942 | 293 | return scm_i_symbol_substring (s, 0, scm_i_symbol_length (s)); |
0f2d19dd | 294 | } |
1bbd0b84 | 295 | #undef FUNC_NAME |
0f2d19dd JB |
296 | |
297 | ||
3b3b36dd | 298 | SCM_DEFINE (scm_string_to_symbol, "string->symbol", 1, 0, 0, |
1e6808ea MG |
299 | (SCM string), |
300 | "Return the symbol whose name is @var{string}. This procedure\n" | |
942e5b91 MG |
301 | "can create symbols with names containing special characters or\n" |
302 | "letters in the non-standard case, but it is usually a bad idea\n" | |
1e6808ea MG |
303 | "to create such symbols because in some implementations of\n" |
304 | "Scheme they cannot be read as themselves. See\n" | |
305 | "@code{symbol->string}.\n" | |
306 | "\n" | |
942e5b91 | 307 | "The following examples assume that the implementation's\n" |
1e6808ea MG |
308 | "standard case is lower case:\n" |
309 | "\n" | |
942e5b91 MG |
310 | "@lisp\n" |
311 | "(eq? 'mISSISSIppi 'mississippi) @result{} #t\n" | |
312 | "(string->symbol \"mISSISSIppi\") @result{} @r{the symbol with name \"mISSISSIppi\"}\n" | |
313 | "(eq? 'bitBlt (string->symbol \"bitBlt\")) @result{} #f\n" | |
314 | "(eq? 'JollyWog\n" | |
315 | " (string->symbol (symbol->string 'JollyWog))) @result{} #t\n" | |
316 | "(string=? \"K. Harper, M.D.\"\n" | |
317 | " (symbol->string\n" | |
318 | " (string->symbol \"K. Harper, M.D.\"))) @result{}#t\n" | |
319 | "@end lisp") | |
1bbd0b84 | 320 | #define FUNC_NAME s_scm_string_to_symbol |
0f2d19dd | 321 | { |
1e6808ea | 322 | SCM_VALIDATE_STRING (1, string); |
e23106d5 | 323 | return scm_i_str2symbol (string); |
0f2d19dd | 324 | } |
1bbd0b84 | 325 | #undef FUNC_NAME |
0f2d19dd | 326 | |
1206efbe MV |
327 | SCM_DEFINE (scm_string_ci_to_symbol, "string-ci->symbol", 1, 0, 0, |
328 | (SCM str), | |
329 | "Return the symbol whose name is @var{str}. @var{str} is\n" | |
330 | "converted to lowercase before the conversion is done, if Guile\n" | |
331 | "is currently reading symbols case-insensitively.") | |
332 | #define FUNC_NAME s_scm_string_ci_to_symbol | |
333 | { | |
334 | return scm_string_to_symbol (SCM_CASE_INSENSITIVE_P | |
335 | ? scm_string_downcase(str) | |
336 | : str); | |
337 | } | |
338 | #undef FUNC_NAME | |
339 | ||
ceed7709 LC |
340 | /* The default prefix for `gensym'd symbols. */ |
341 | static SCM default_gensym_prefix; | |
342 | ||
4496c9c1 | 343 | #define MAX_PREFIX_LENGTH 30 |
0f2d19dd | 344 | |
86d31dfe MV |
345 | SCM_DEFINE (scm_gensym, "gensym", 0, 1, 0, |
346 | (SCM prefix), | |
347 | "Create a new symbol with a name constructed from a prefix and\n" | |
348 | "a counter value. The string @var{prefix} can be specified as\n" | |
68dc153d | 349 | "an optional argument. Default prefix is @code{ g}. The counter\n" |
86d31dfe MV |
350 | "is increased by 1 at each call. There is no provision for\n" |
351 | "resetting the counter.") | |
352 | #define FUNC_NAME s_scm_gensym | |
0f2d19dd | 353 | { |
4496c9c1 AW |
354 | static int gensym_counter = 0; |
355 | ||
3ee86942 | 356 | SCM suffix, name; |
4496c9c1 AW |
357 | int n, n_digits; |
358 | char buf[SCM_INTBUFLEN]; | |
7426a638 | 359 | |
86d31dfe | 360 | if (SCM_UNBNDP (prefix)) |
ceed7709 LC |
361 | prefix = default_gensym_prefix; |
362 | ||
4496c9c1 AW |
363 | /* mutex in case another thread looks and incs at the exact same moment */ |
364 | scm_i_scm_pthread_mutex_lock (&scm_i_misc_mutex); | |
365 | n = gensym_counter++; | |
366 | scm_i_pthread_mutex_unlock (&scm_i_misc_mutex); | |
3ee86942 | 367 | |
4496c9c1 AW |
368 | n_digits = scm_iint2str (n, 10, buf); |
369 | suffix = scm_from_latin1_stringn (buf, n_digits); | |
3ee86942 MV |
370 | name = scm_string_append (scm_list_2 (prefix, suffix)); |
371 | return scm_string_to_symbol (name); | |
0f2d19dd | 372 | } |
1bbd0b84 | 373 | #undef FUNC_NAME |
0f2d19dd | 374 | |
86d31dfe MV |
375 | SCM_DEFINE (scm_symbol_hash, "symbol-hash", 1, 0, 0, |
376 | (SCM symbol), | |
377 | "Return a hash value for @var{symbol}.") | |
378 | #define FUNC_NAME s_scm_symbol_hash | |
0f2d19dd | 379 | { |
86d31dfe | 380 | SCM_VALIDATE_SYMBOL (1, symbol); |
3ee86942 | 381 | return scm_from_ulong (scm_i_symbol_hash (symbol)); |
0f2d19dd | 382 | } |
1bbd0b84 | 383 | #undef FUNC_NAME |
0f2d19dd | 384 | |
3b3b36dd | 385 | SCM_DEFINE (scm_symbol_fref, "symbol-fref", 1, 0, 0, |
1bbd0b84 | 386 | (SCM s), |
b7e64f8b | 387 | "Return the contents of the symbol @var{s}'s @dfn{function slot}.") |
1bbd0b84 | 388 | #define FUNC_NAME s_scm_symbol_fref |
0f2d19dd | 389 | { |
34d19ef6 | 390 | SCM_VALIDATE_SYMBOL (1, s); |
3ee86942 | 391 | return SCM_CAR (SCM_CELL_OBJECT_3 (s)); |
0f2d19dd | 392 | } |
1bbd0b84 | 393 | #undef FUNC_NAME |
0f2d19dd JB |
394 | |
395 | ||
3b3b36dd | 396 | SCM_DEFINE (scm_symbol_pref, "symbol-pref", 1, 0, 0, |
1bbd0b84 | 397 | (SCM s), |
b7e64f8b BT |
398 | "Return the @dfn{property list} currently associated with the\n" |
399 | "symbol @var{s}.") | |
1bbd0b84 | 400 | #define FUNC_NAME s_scm_symbol_pref |
0f2d19dd | 401 | { |
34d19ef6 | 402 | SCM_VALIDATE_SYMBOL (1, s); |
3ee86942 | 403 | return SCM_CDR (SCM_CELL_OBJECT_3 (s)); |
0f2d19dd | 404 | } |
1bbd0b84 | 405 | #undef FUNC_NAME |
0f2d19dd JB |
406 | |
407 | ||
3b3b36dd | 408 | SCM_DEFINE (scm_symbol_fset_x, "symbol-fset!", 2, 0, 0, |
1bbd0b84 | 409 | (SCM s, SCM val), |
b7e64f8b | 410 | "Change the binding of the symbol @var{s}'s function slot.") |
1bbd0b84 | 411 | #define FUNC_NAME s_scm_symbol_fset_x |
0f2d19dd | 412 | { |
34d19ef6 | 413 | SCM_VALIDATE_SYMBOL (1, s); |
3ee86942 | 414 | SCM_SETCAR (SCM_CELL_OBJECT_3 (s), val); |
0f2d19dd JB |
415 | return SCM_UNSPECIFIED; |
416 | } | |
1bbd0b84 | 417 | #undef FUNC_NAME |
0f2d19dd JB |
418 | |
419 | ||
3b3b36dd | 420 | SCM_DEFINE (scm_symbol_pset_x, "symbol-pset!", 2, 0, 0, |
1bbd0b84 | 421 | (SCM s, SCM val), |
b7e64f8b | 422 | "Change the binding of the symbol @var{s}'s property slot.") |
1bbd0b84 | 423 | #define FUNC_NAME s_scm_symbol_pset_x |
0f2d19dd | 424 | { |
34d19ef6 | 425 | SCM_VALIDATE_SYMBOL (1, s); |
3ee86942 | 426 | SCM_SETCDR (SCM_CELL_OBJECT_3 (s), val); |
0f2d19dd JB |
427 | return SCM_UNSPECIFIED; |
428 | } | |
1bbd0b84 | 429 | #undef FUNC_NAME |
0f2d19dd | 430 | |
3ee86942 MV |
431 | SCM |
432 | scm_from_locale_symbol (const char *sym) | |
af68e5e5 | 433 | { |
e23106d5 | 434 | return scm_from_locale_symboln (sym, -1); |
af68e5e5 | 435 | } |
af68e5e5 | 436 | |
3ee86942 MV |
437 | SCM |
438 | scm_from_locale_symboln (const char *sym, size_t len) | |
439 | { | |
e23106d5 MG |
440 | SCM str = scm_from_locale_stringn (sym, len); |
441 | return scm_i_str2symbol (str); | |
fd0a5bbc HWN |
442 | } |
443 | ||
444 | SCM | |
445 | scm_take_locale_symboln (char *sym, size_t len) | |
446 | { | |
e23106d5 | 447 | SCM str; |
fd0a5bbc | 448 | |
e23106d5 MG |
449 | str = scm_take_locale_stringn (sym, len); |
450 | return scm_i_str2symbol (str); | |
fd0a5bbc HWN |
451 | } |
452 | ||
453 | SCM | |
454 | scm_take_locale_symbol (char *sym) | |
455 | { | |
456 | return scm_take_locale_symboln (sym, (size_t)-1); | |
3ee86942 | 457 | } |
af68e5e5 | 458 | |
ad5cbc47 AW |
459 | SCM |
460 | scm_from_latin1_symbol (const char *sym) | |
461 | { | |
462 | return scm_from_latin1_symboln (sym, -1); | |
463 | } | |
464 | ||
465 | SCM | |
466 | scm_from_latin1_symboln (const char *sym, size_t len) | |
467 | { | |
30c282bf AW |
468 | unsigned long hash; |
469 | SCM ret; | |
470 | ||
471 | if (len == (size_t) -1) | |
472 | len = strlen (sym); | |
473 | hash = scm_i_latin1_string_hash (sym, len); | |
474 | ||
475 | ret = lookup_interned_latin1_symbol (sym, len, hash); | |
476 | if (scm_is_false (ret)) | |
477 | { | |
478 | SCM str = scm_from_latin1_stringn (sym, len); | |
479 | ret = scm_i_str2symbol (str); | |
480 | } | |
481 | ||
482 | return ret; | |
ad5cbc47 AW |
483 | } |
484 | ||
485 | SCM | |
486 | scm_from_utf8_symbol (const char *sym) | |
487 | { | |
488 | return scm_from_utf8_symboln (sym, -1); | |
489 | } | |
490 | ||
491 | SCM | |
492 | scm_from_utf8_symboln (const char *sym, size_t len) | |
493 | { | |
494 | SCM str = scm_from_utf8_stringn (sym, len); | |
495 | return scm_i_str2symbol (str); | |
496 | } | |
497 | ||
0f979f3f DH |
498 | void |
499 | scm_symbols_prehistory () | |
500 | { | |
e11e83f3 | 501 | symbols = scm_make_weak_key_hash_table (scm_from_int (2139)); |
0f979f3f DH |
502 | } |
503 | ||
504 | ||
0f2d19dd JB |
505 | void |
506 | scm_init_symbols () | |
0f2d19dd | 507 | { |
a0599745 | 508 | #include "libguile/symbols.x" |
ceed7709 LC |
509 | |
510 | default_gensym_prefix = scm_from_latin1_string (" g"); | |
0f2d19dd | 511 | } |
89e00824 ML |
512 | |
513 | /* | |
514 | Local Variables: | |
515 | c-file-style: "gnu" | |
516 | End: | |
517 | */ |