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