1 /* This file contains definitions for deprecated features. When you
2 deprecate something, move it here when that is feasible.
5 /* Copyright (C) 2003, 2004 Free Software Foundation, Inc.
7 * This library is free software; you can redistribute it and/or
8 * modify it under the terms of the GNU Lesser General Public
9 * License as published by the Free Software Foundation; either
10 * version 2.1 of the License, or (at your option) any later version.
12 * This library is distributed in the hope that it will be useful,
13 * but WITHOUT ANY WARRANTY; without even the implied warranty of
14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 * Lesser General Public License for more details.
17 * You should have received a copy of the GNU Lesser General Public
18 * License along with this library; if not, write to the Free Software
19 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
22 #include "libguile/_scm.h"
23 #include "libguile/deprecated.h"
24 #include "libguile/deprecation.h"
25 #include "libguile/snarf.h"
26 #include "libguile/validate.h"
27 #include "libguile/strings.h"
28 #include "libguile/srfi-13.h"
29 #include "libguile/modules.h"
30 #include "libguile/eval.h"
31 #include "libguile/smob.h"
32 #include "libguile/procprop.h"
33 #include "libguile/vectors.h"
34 #include "libguile/hashtab.h"
35 #include "libguile/struct.h"
36 #include "libguile/variable.h"
37 #include "libguile/fluids.h"
38 #include "libguile/ports.h"
39 #include "libguile/eq.h"
40 #include "libguile/read.h"
41 #include "libguile/strports.h"
42 #include "libguile/smob.h"
43 #include "libguile/alist.h"
48 #if (SCM_ENABLE_DEPRECATED == 1)
50 /* From print.c: Internal symbol names of isyms. Deprecated in guile 1.7.0 on
52 char *scm_isymnames
[] =
58 /* From eval.c: Error messages of the evaluator. These were deprecated in
59 * guile 1.7.0 on 2003-06-02. */
60 const char scm_s_expression
[] = "missing or extra expression";
61 const char scm_s_test
[] = "bad test";
62 const char scm_s_body
[] = "bad body";
63 const char scm_s_bindings
[] = "bad bindings";
64 const char scm_s_variable
[] = "bad variable";
65 const char scm_s_clauses
[] = "bad or missing clauses";
66 const char scm_s_formals
[] = "bad formals";
69 SCM_REGISTER_PROC(s_substring_move_left_x
, "substring-move-left!", 5, 0, 0, scm_substring_move_x
);
71 SCM_REGISTER_PROC(s_substring_move_right_x
, "substring-move-right!", 5, 0, 0, scm_substring_move_x
);
74 scm_wta (SCM arg
, const char *pos
, const char *s_subr
)
76 if (!s_subr
|| !*s_subr
)
78 if ((~0x1fL
) & (long) pos
)
80 /* error string supplied. */
81 scm_misc_error (s_subr
, pos
, scm_list_1 (arg
));
85 /* numerical error code. */
86 scm_t_bits error
= (scm_t_bits
) pos
;
91 scm_wrong_type_arg (s_subr
, 0, arg
);
93 scm_wrong_type_arg (s_subr
, 1, arg
);
95 scm_wrong_type_arg (s_subr
, 2, arg
);
97 scm_wrong_type_arg (s_subr
, 3, arg
);
99 scm_wrong_type_arg (s_subr
, 4, arg
);
101 scm_wrong_type_arg (s_subr
, 5, arg
);
103 scm_wrong_type_arg (s_subr
, 6, arg
);
105 scm_wrong_type_arg (s_subr
, 7, arg
);
107 scm_wrong_num_args (arg
);
109 scm_out_of_range (s_subr
, arg
);
111 scm_memory_error (s_subr
);
113 /* this shouldn't happen. */
114 scm_misc_error (s_subr
, "Unknown error", SCM_EOL
);
117 return SCM_UNSPECIFIED
;
123 /* We can't use SCM objects here. One should be able to call
124 SCM_REGISTER_MODULE from a C++ constructor for a static
125 object. This happens before main and thus before libguile is
129 struct moddata
*link
;
134 static struct moddata
*registered_mods
= NULL
;
137 scm_register_module_xxx (char *module_name
, void *init_func
)
141 scm_c_issue_deprecation_warning
142 ("`scm_register_module_xxx' is deprecated. Use extensions instead.");
144 /* XXX - should we (and can we) DEFER_INTS here? */
146 for (md
= registered_mods
; md
; md
= md
->link
)
147 if (!strcmp (md
->module_name
, module_name
))
149 md
->init_func
= init_func
;
153 md
= (struct moddata
*) malloc (sizeof (struct moddata
));
157 "guile: can't register module (%s): not enough memory",
162 md
->module_name
= module_name
;
163 md
->init_func
= init_func
;
164 md
->link
= registered_mods
;
165 registered_mods
= md
;
168 SCM_DEFINE (scm_registered_modules
, "c-registered-modules", 0, 0, 0,
170 "Return a list of the object code modules that have been imported into\n"
171 "the current Guile process. Each element of the list is a pair whose\n"
172 "car is the name of the module, and whose cdr is the function handle\n"
173 "for that module's initializer function. The name is the string that\n"
174 "has been passed to scm_register_module_xxx.")
175 #define FUNC_NAME s_scm_registered_modules
181 for (md
= registered_mods
; md
; md
= md
->link
)
182 res
= scm_cons (scm_cons (scm_from_locale_string (md
->module_name
),
183 scm_from_ulong ((unsigned long) md
->init_func
)),
189 SCM_DEFINE (scm_clear_registered_modules
, "c-clear-registered-modules", 0, 0, 0,
191 "Destroy the list of modules registered with the current Guile process.\n"
192 "The return value is unspecified. @strong{Warning:} this function does\n"
193 "not actually unlink or deallocate these modules, but only destroys the\n"
194 "records of which modules have been loaded. It should therefore be used\n"
195 "only by module bookkeeping operations.")
196 #define FUNC_NAME s_scm_clear_registered_modules
198 struct moddata
*md1
, *md2
;
202 for (md1
= registered_mods
; md1
; md1
= md2
)
207 registered_mods
= NULL
;
210 return SCM_UNSPECIFIED
;
215 scm_remember (SCM
*ptr
)
217 scm_c_issue_deprecation_warning ("`scm_remember' is deprecated. "
218 "Use the `scm_remember_upto_here*' family of functions instead.");
222 scm_protect_object (SCM obj
)
224 scm_c_issue_deprecation_warning ("`scm_protect_object' is deprecated. "
225 "Use `scm_gc_protect_object' instead.");
226 return scm_gc_protect_object (obj
);
230 scm_unprotect_object (SCM obj
)
232 scm_c_issue_deprecation_warning ("`scm_unprotect_object' is deprecated. "
233 "Use `scm_gc_unprotect_object' instead.");
234 return scm_gc_unprotect_object (obj
);
237 SCM_SYMBOL (scm_sym_app
, "app");
238 SCM_SYMBOL (scm_sym_modules
, "modules");
239 static SCM module_prefix
= SCM_BOOL_F
;
240 static SCM make_modules_in_var
;
241 static SCM beautify_user_module_x_var
;
242 static SCM try_module_autoload_var
;
247 #define PERM(x) scm_permanent_object(x)
249 if (module_prefix
== SCM_BOOL_F
)
251 module_prefix
= PERM (scm_list_2 (scm_sym_app
, scm_sym_modules
));
252 make_modules_in_var
= PERM (scm_c_lookup ("make-modules-in"));
253 beautify_user_module_x_var
=
254 PERM (scm_c_lookup ("beautify-user-module!"));
255 try_module_autoload_var
= PERM (scm_c_lookup ("try-module-autoload"));
260 scm_the_root_module ()
262 init_module_stuff ();
263 scm_c_issue_deprecation_warning ("`scm_the_root_module' is deprecated. "
264 "Use `scm_c_resolve_module (\"guile\")' "
267 return scm_c_resolve_module ("guile");
271 scm_module_full_name (SCM name
)
273 init_module_stuff ();
274 if (scm_is_eq (SCM_CAR (name
), scm_sym_app
))
277 return scm_append (scm_list_2 (module_prefix
, name
));
281 scm_make_module (SCM name
)
283 init_module_stuff ();
284 scm_c_issue_deprecation_warning ("`scm_make_module' is deprecated. "
285 "Use `scm_c_define_module instead.");
287 return scm_call_2 (SCM_VARIABLE_REF (make_modules_in_var
),
288 scm_the_root_module (),
289 scm_module_full_name (name
));
293 scm_ensure_user_module (SCM module
)
295 init_module_stuff ();
296 scm_c_issue_deprecation_warning ("`scm_ensure_user_module' is deprecated. "
297 "Use `scm_c_define_module instead.");
299 scm_call_1 (SCM_VARIABLE_REF (beautify_user_module_x_var
), module
);
300 return SCM_UNSPECIFIED
;
304 scm_load_scheme_module (SCM name
)
306 init_module_stuff ();
307 scm_c_issue_deprecation_warning ("`scm_load_scheme_module' is deprecated. "
308 "Use `scm_c_resolve_module instead.");
310 return scm_call_1 (SCM_VARIABLE_REF (try_module_autoload_var
), name
);
313 /* This is implemented in C solely for SCM_COERCE_OUTPORT ... */
316 maybe_close_port (void *data
, SCM port
)
318 SCM except
= (SCM
)data
;
320 while (!SCM_NULLP (except
))
322 SCM p
= SCM_COERCE_OUTPORT (SCM_CAR (except
));
323 if (scm_is_eq (p
, port
))
325 except
= SCM_CDR (except
);
328 scm_close_port (port
);
331 SCM_DEFINE (scm_close_all_ports_except
, "close-all-ports-except", 0, 0, 1,
333 "[DEPRECATED] Close all open file ports used by the interpreter\n"
334 "except for those supplied as arguments. This procedure\n"
335 "was intended to be used before an exec call to close file descriptors\n"
336 "which are not needed in the new process. However it has the\n"
337 "undesirable side effect of flushing buffers, so it's deprecated.\n"
338 "Use port-for-each instead.")
339 #define FUNC_NAME s_scm_close_all_ports_except
342 SCM_VALIDATE_REST_ARGUMENT (ports
);
344 for (p
= ports
; !SCM_NULLP (p
); p
= SCM_CDR (p
))
345 SCM_VALIDATE_OPPORT (SCM_ARG1
, SCM_COERCE_OUTPORT (SCM_CAR (p
)));
347 scm_c_port_for_each (maybe_close_port
, ports
);
349 return SCM_UNSPECIFIED
;
353 SCM_DEFINE (scm_variable_set_name_hint
, "variable-set-name-hint!", 2, 0, 0,
355 "Do not use this function.")
356 #define FUNC_NAME s_scm_variable_set_name_hint
358 SCM_VALIDATE_VARIABLE (1, var
);
359 SCM_VALIDATE_SYMBOL (2, hint
);
360 scm_c_issue_deprecation_warning
361 ("'variable-set-name-hint!' is deprecated. Do not use it.");
362 return SCM_UNSPECIFIED
;
366 SCM_DEFINE (scm_builtin_variable
, "builtin-variable", 1, 0, 0,
368 "Do not use this function.")
369 #define FUNC_NAME s_scm_builtin_variable
371 SCM_VALIDATE_SYMBOL (1,name
);
372 scm_c_issue_deprecation_warning ("`builtin-variable' is deprecated. "
373 "Use module system operations instead.");
374 return scm_sym2var (name
, SCM_BOOL_F
, SCM_BOOL_T
);
379 scm_makstr (size_t len
, int dummy
)
381 scm_c_issue_deprecation_warning
382 ("'scm_makstr' is deprecated. Use 'scm_c_make_string' instead.");
383 return scm_c_make_string (len
, SCM_UNDEFINED
);
387 scm_makfromstr (const char *src
, size_t len
, int dummy SCM_UNUSED
)
389 scm_c_issue_deprecation_warning ("`scm_makfromstr' is deprecated. "
390 "Use `scm_from_locale_stringn' instead.");
392 return scm_from_locale_stringn (src
, len
);
396 scm_internal_with_fluids (SCM fluids
, SCM values
, SCM (*cproc
) (), void *cdata
)
398 scm_c_issue_deprecation_warning ("`scm_internal_with_fluids' is deprecated. "
399 "Use `scm_c_with_fluids' instead.");
401 return scm_c_with_fluids (fluids
, values
, cproc
, cdata
);
405 scm_make_gsubr (const char *name
, int req
, int opt
, int rst
, SCM (*fcn
)())
407 scm_c_issue_deprecation_warning
408 ("`scm_make_gsubr' is deprecated. Use `scm_c_define_gsubr' instead.");
410 return scm_c_define_gsubr (name
, req
, opt
, rst
, fcn
);
414 scm_make_gsubr_with_generic (const char *name
,
415 int req
, int opt
, int rst
,
416 SCM (*fcn
)(), SCM
*gf
)
418 scm_c_issue_deprecation_warning
419 ("`scm_make_gsubr_with_generic' is deprecated. "
420 "Use `scm_c_define_gsubr_with_generic' instead.");
422 return scm_c_define_gsubr_with_generic (name
, req
, opt
, rst
, fcn
, gf
);
426 scm_create_hook (const char *name
, int n_args
)
428 scm_c_issue_deprecation_warning
429 ("'scm_create_hook' is deprecated. "
430 "Use 'scm_make_hook' and 'scm_c_define' instead.");
432 SCM hook
= scm_make_hook (scm_from_int (n_args
));
433 scm_c_define (name
, hook
);
434 return scm_permanent_object (hook
);
438 SCM_DEFINE (scm_sloppy_memq
, "sloppy-memq", 2, 0, 0,
440 "This procedure behaves like @code{memq}, but does no type or error checking.\n"
441 "Its use is recommended only in writing Guile internals,\n"
442 "not for high-level Scheme programs.")
443 #define FUNC_NAME s_scm_sloppy_memq
445 scm_c_issue_deprecation_warning
446 ("'sloppy-memq' is deprecated. Use 'memq' instead.");
448 for(; SCM_CONSP (lst
); lst
= SCM_CDR(lst
))
450 if (scm_is_eq (SCM_CAR (lst
), x
))
458 SCM_DEFINE (scm_sloppy_memv
, "sloppy-memv", 2, 0, 0,
460 "This procedure behaves like @code{memv}, but does no type or error checking.\n"
461 "Its use is recommended only in writing Guile internals,\n"
462 "not for high-level Scheme programs.")
463 #define FUNC_NAME s_scm_sloppy_memv
465 scm_c_issue_deprecation_warning
466 ("'sloppy-memv' is deprecated. Use 'memv' instead.");
468 for(; SCM_CONSP (lst
); lst
= SCM_CDR(lst
))
470 if (! scm_is_false (scm_eqv_p (SCM_CAR (lst
), x
)))
478 SCM_DEFINE (scm_sloppy_member
, "sloppy-member", 2, 0, 0,
480 "This procedure behaves like @code{member}, but does no type or error checking.\n"
481 "Its use is recommended only in writing Guile internals,\n"
482 "not for high-level Scheme programs.")
483 #define FUNC_NAME s_scm_sloppy_member
485 scm_c_issue_deprecation_warning
486 ("'sloppy-member' is deprecated. Use 'member' instead.");
488 for(; SCM_CONSP (lst
); lst
= SCM_CDR(lst
))
490 if (! scm_is_false (scm_equal_p (SCM_CAR (lst
), x
)))
497 SCM_SYMBOL (scm_end_of_file_key
, "end-of-file");
499 SCM_DEFINE (scm_read_and_eval_x
, "read-and-eval!", 0, 1, 0,
501 "Read a form from @var{port} (standard input by default), and evaluate it\n"
502 "(memoizing it in the process) in the top-level environment. If no data\n"
503 "is left to be read from @var{port}, an @code{end-of-file} error is\n"
505 #define FUNC_NAME s_scm_read_and_eval_x
509 scm_c_issue_deprecation_warning
510 ("'read-and-eval!' is deprecated. Use 'read' and 'eval' instead.");
512 form
= scm_read (port
);
513 if (SCM_EOF_OBJECT_P (form
))
514 scm_ithrow (scm_end_of_file_key
, SCM_EOL
, 1);
515 return scm_eval_x (form
, scm_current_module ());
520 scm_make_subr_opt (const char *name
, int type
, SCM (*fcn
) (), int set
)
522 scm_c_issue_deprecation_warning
523 ("`scm_make_subr_opt' is deprecated. Use `scm_c_make_subr' or "
524 "`scm_c_define_subr' instead.");
527 return scm_c_define_subr (name
, type
, fcn
);
529 return scm_c_make_subr (name
, type
, fcn
);
533 scm_make_subr (const char *name
, int type
, SCM (*fcn
) ())
535 scm_c_issue_deprecation_warning
536 ("`scm_make_subr' is deprecated. Use `scm_c_define_subr' instead.");
538 return scm_c_define_subr (name
, type
, fcn
);
542 scm_make_subr_with_generic (const char *name
, int type
, SCM (*fcn
) (), SCM
*gf
)
544 scm_c_issue_deprecation_warning
545 ("`scm_make_subr_with_generic' is deprecated. Use "
546 "`scm_c_define_subr_with_generic' instead.");
548 return scm_c_define_subr_with_generic (name
, type
, fcn
, gf
);
551 /* Call thunk(closure) underneath a top-level error handler.
552 * If an error occurs, pass the exitval through err_filter and return it.
553 * If no error occurs, return the value of thunk.
557 typedef int setjmp_type
;
559 typedef long setjmp_type
;
562 struct cce_handler_data
{
563 SCM (*err_filter
) ();
568 invoke_err_filter (void *d
, SCM tag
, SCM args
)
570 struct cce_handler_data
*data
= (struct cce_handler_data
*)d
;
571 return data
->err_filter (SCM_BOOL_F
, data
->closure
);
575 scm_call_catching_errors (SCM (*thunk
)(), SCM (*err_filter
)(), void *closure
)
577 scm_c_issue_deprecation_warning
578 ("'scm_call_catching_errors' is deprecated. "
579 "Use 'scm_internal_catch' instead.");
582 struct cce_handler_data data
;
583 data
.err_filter
= err_filter
;
584 data
.closure
= closure
;
585 return scm_internal_catch (SCM_BOOL_T
,
586 (scm_t_catch_body
)thunk
, closure
,
587 (scm_t_catch_handler
)invoke_err_filter
, &data
);
592 scm_make_smob_type_mfpe (char *name
, size_t size
,
594 size_t (*free
) (SCM
),
595 int (*print
) (SCM
, SCM
, scm_print_state
*),
596 SCM (*equalp
) (SCM
, SCM
))
598 scm_c_issue_deprecation_warning
599 ("'scm_make_smob_type_mfpe' is deprecated. "
600 "Use 'scm_make_smob_type' plus 'scm_set_smob_*' instead.");
603 long answer
= scm_make_smob_type (name
, size
);
604 scm_set_smob_mfpe (answer
, mark
, free
, print
, equalp
);
610 scm_set_smob_mfpe (long tc
,
612 size_t (*free
) (SCM
),
613 int (*print
) (SCM
, SCM
, scm_print_state
*),
614 SCM (*equalp
) (SCM
, SCM
))
616 scm_c_issue_deprecation_warning
617 ("'scm_set_smob_mfpe' is deprecated. "
618 "Use 'scm_set_smob_mark' instead, for example.");
620 if (mark
) scm_set_smob_mark (tc
, mark
);
621 if (free
) scm_set_smob_free (tc
, free
);
622 if (print
) scm_set_smob_print (tc
, print
);
623 if (equalp
) scm_set_smob_equalp (tc
, equalp
);
627 scm_read_0str (char *expr
)
629 scm_c_issue_deprecation_warning
630 ("scm_read_0str is deprecated. Use scm_c_read_string instead.");
632 return scm_c_read_string (expr
);
636 scm_eval_0str (const char *expr
)
638 scm_c_issue_deprecation_warning
639 ("scm_eval_0str is deprecated. Use scm_c_eval_string instead.");
641 return scm_c_eval_string (expr
);
645 scm_strprint_obj (SCM obj
)
647 scm_c_issue_deprecation_warning
648 ("scm_strprint_obj is deprecated. Use scm_object_to_string instead.");
649 return scm_object_to_string (obj
, SCM_UNDEFINED
);
653 scm_sym2ovcell_soft (SCM sym
, SCM obarray
)
656 size_t hash
= scm_i_symbol_hash (sym
) % SCM_VECTOR_LENGTH (obarray
);
658 scm_c_issue_deprecation_warning ("`scm_sym2ovcell_soft' is deprecated. "
659 "Use hashtables instead.");
662 for (lsym
= SCM_VECTOR_REF (obarray
, hash
);
664 lsym
= SCM_CDR (lsym
))
667 if (scm_is_eq (SCM_CAR (z
), sym
))
679 scm_sym2ovcell (SCM sym
, SCM obarray
)
680 #define FUNC_NAME "scm_sym2ovcell"
684 scm_c_issue_deprecation_warning ("`scm_sym2ovcell' is deprecated. "
685 "Use hashtables instead.");
687 answer
= scm_sym2ovcell_soft (sym
, obarray
);
688 if (scm_is_true (answer
))
690 SCM_MISC_ERROR ("uninterned symbol: ~S", scm_list_1 (sym
));
691 return SCM_UNSPECIFIED
; /* not reached */
696 /* Intern a symbol whose name is the LEN characters at NAME in OBARRAY.
698 OBARRAY should be a vector of lists, indexed by the name's hash
699 value, modulo OBARRAY's length. Each list has the form
700 ((SYMBOL . VALUE) ...), where SYMBOL is a symbol, and VALUE is the
701 value associated with that symbol (in the current module? in the
704 To "intern" a symbol means: if OBARRAY already contains a symbol by
705 that name, return its (SYMBOL . VALUE) pair; otherwise, create a
706 new symbol, add the pair (SYMBOL . SCM_UNDEFINED) to the
707 appropriate list of the OBARRAY, and return the pair.
709 If softness is non-zero, don't create a symbol if it isn't already
710 in OBARRAY; instead, just return #f.
712 If OBARRAY is SCM_BOOL_F, create a symbol listed in no obarray and
713 return (SYMBOL . SCM_UNDEFINED). */
717 scm_intern_obarray_soft (const char *name
,size_t len
,SCM obarray
,unsigned int softness
)
719 SCM symbol
= scm_from_locale_symboln (name
, len
);
720 size_t raw_hash
= scm_i_symbol_hash (symbol
);
724 scm_c_issue_deprecation_warning ("`scm_intern_obarray_soft' is deprecated. "
725 "Use hashtables instead.");
727 if (scm_is_false (obarray
))
732 return scm_cons (symbol
, SCM_UNDEFINED
);
735 hash
= raw_hash
% SCM_VECTOR_LENGTH (obarray
);
737 for (lsym
= SCM_VECTOR_REF(obarray
, hash
);
738 SCM_NIMP (lsym
); lsym
= SCM_CDR (lsym
))
740 SCM a
= SCM_CAR (lsym
);
742 if (scm_is_eq (z
, symbol
))
752 SCM cell
= scm_cons (symbol
, SCM_UNDEFINED
);
753 SCM slot
= SCM_VECTOR_REF (obarray
, hash
);
755 SCM_VECTOR_SET (obarray
, hash
, scm_cons (cell
, slot
));
763 scm_intern_obarray (const char *name
,size_t len
,SCM obarray
)
765 scm_c_issue_deprecation_warning ("`scm_intern_obarray' is deprecated. "
766 "Use hashtables instead.");
768 return scm_intern_obarray_soft (name
, len
, obarray
, 0);
771 /* Lookup the value of the symbol named by the nul-terminated string
772 NAME in the current module. */
774 scm_symbol_value0 (const char *name
)
776 scm_c_issue_deprecation_warning ("`scm_symbol_value0' is deprecated. "
777 "Use `scm_lookup' instead.");
779 return scm_variable_ref (scm_c_lookup (name
));
782 SCM_DEFINE (scm_string_to_obarray_symbol
, "string->obarray-symbol", 2, 1, 0,
783 (SCM o
, SCM s
, SCM softp
),
784 "Intern a new symbol in @var{obarray}, a symbol table, with name\n"
786 "If @var{obarray} is @code{#f}, use the default system symbol table. If\n"
787 "@var{obarray} is @code{#t}, the symbol should not be interned in any\n"
788 "symbol table; merely return the pair (@var{symbol}\n"
789 ". @var{#<undefined>}).\n\n"
790 "The @var{soft?} argument determines whether new symbol table entries\n"
791 "should be created when the specified symbol is not already present in\n"
792 "@var{obarray}. If @var{soft?} is specified and is a true value, then\n"
793 "new entries should not be added for symbols not already present in the\n"
794 "table; instead, simply return @code{#f}.")
795 #define FUNC_NAME s_scm_string_to_obarray_symbol
801 SCM_VALIDATE_STRING (2, s
);
802 SCM_ASSERT (scm_is_bool (o
) || SCM_VECTORP (o
), o
, SCM_ARG1
, FUNC_NAME
);
804 scm_c_issue_deprecation_warning ("`string->obarray-symbol' is deprecated. "
805 "Use hashtables instead.");
807 softness
= (!SCM_UNBNDP (softp
) && scm_is_true(softp
));
808 /* iron out some screwy calling conventions */
809 if (scm_is_false (o
))
811 /* nothing interesting to do here. */
812 return scm_string_to_symbol (s
);
814 else if (scm_is_eq (o
, SCM_BOOL_T
))
817 vcell
= scm_intern_obarray_soft (scm_i_string_chars (s
),
818 scm_i_string_length (s
),
821 if (scm_is_false (vcell
))
823 answer
= SCM_CAR (vcell
);
828 SCM_DEFINE (scm_intern_symbol
, "intern-symbol", 2, 0, 0,
830 "Add a new symbol to @var{obarray} with name @var{string}, bound to an\n"
831 "unspecified initial value. The symbol table is not modified if a symbol\n"
832 "with this name is already present.")
833 #define FUNC_NAME s_scm_intern_symbol
836 SCM_VALIDATE_SYMBOL (2,s
);
837 if (scm_is_false (o
))
838 return SCM_UNSPECIFIED
;
840 scm_c_issue_deprecation_warning ("`intern-symbol' is deprecated. "
841 "Use hashtables instead.");
843 SCM_VALIDATE_VECTOR (1,o
);
844 hval
= scm_i_symbol_hash (s
) % SCM_VECTOR_LENGTH (o
);
845 /* If the symbol is already interned, simply return. */
850 for (lsym
= SCM_VECTOR_REF (o
, hval
);
852 lsym
= SCM_CDR (lsym
))
854 sym
= SCM_CAR (lsym
);
855 if (scm_is_eq (SCM_CAR (sym
), s
))
858 return SCM_UNSPECIFIED
;
861 SCM_VECTOR_SET (o
, hval
,
862 scm_acons (s
, SCM_UNDEFINED
,
863 SCM_VECTOR_REF (o
, hval
)));
866 return SCM_UNSPECIFIED
;
870 SCM_DEFINE (scm_unintern_symbol
, "unintern-symbol", 2, 0, 0,
872 "Remove the symbol with name @var{string} from @var{obarray}. This\n"
873 "function returns @code{#t} if the symbol was present and @code{#f}\n"
875 #define FUNC_NAME s_scm_unintern_symbol
879 scm_c_issue_deprecation_warning ("`unintern-symbol' is deprecated. "
880 "Use hashtables instead.");
882 SCM_VALIDATE_SYMBOL (2,s
);
883 if (scm_is_false (o
))
885 SCM_VALIDATE_VECTOR (1,o
);
886 hval
= scm_i_symbol_hash (s
) % SCM_VECTOR_LENGTH (o
);
892 for (lsym
= SCM_VECTOR_REF (o
, hval
), lsym_follow
= SCM_BOOL_F
;
894 lsym_follow
= lsym
, lsym
= SCM_CDR (lsym
))
896 sym
= SCM_CAR (lsym
);
897 if (scm_is_eq (SCM_CAR (sym
), s
))
899 /* Found the symbol to unintern. */
900 if (scm_is_false (lsym_follow
))
901 SCM_VECTOR_SET (o
, hval
, lsym
);
903 SCM_SETCDR (lsym_follow
, SCM_CDR(lsym
));
914 SCM_DEFINE (scm_symbol_binding
, "symbol-binding", 2, 0, 0,
916 "Look up in @var{obarray} the symbol whose name is @var{string}, and\n"
917 "return the value to which it is bound. If @var{obarray} is @code{#f},\n"
918 "use the global symbol table. If @var{string} is not interned in\n"
919 "@var{obarray}, an error is signalled.")
920 #define FUNC_NAME s_scm_symbol_binding
924 scm_c_issue_deprecation_warning ("`symbol-binding' is deprecated. "
925 "Use hashtables instead.");
927 SCM_VALIDATE_SYMBOL (2,s
);
928 if (scm_is_false (o
))
929 return scm_variable_ref (scm_lookup (s
));
930 SCM_VALIDATE_VECTOR (1,o
);
931 vcell
= scm_sym2ovcell (s
, o
);
932 return SCM_CDR(vcell
);
937 SCM_DEFINE (scm_symbol_interned_p
, "symbol-interned?", 2, 0, 0,
939 "Return @code{#t} if @var{obarray} contains a symbol with name\n"
940 "@var{string}, and @code{#f} otherwise.")
941 #define FUNC_NAME s_scm_symbol_interned_p
945 scm_c_issue_deprecation_warning ("`symbol-interned?' is deprecated. "
946 "Use hashtables instead.");
948 SCM_VALIDATE_SYMBOL (2,s
);
949 if (scm_is_false (o
))
951 SCM var
= scm_sym2var (s
, SCM_BOOL_F
, SCM_BOOL_F
);
952 if (var
!= SCM_BOOL_F
)
956 SCM_VALIDATE_VECTOR (1,o
);
957 vcell
= scm_sym2ovcell_soft (s
, o
);
958 return (SCM_NIMP(vcell
)
965 SCM_DEFINE (scm_symbol_bound_p
, "symbol-bound?", 2, 0, 0,
967 "Return @code{#t} if @var{obarray} contains a symbol with name\n"
968 "@var{string} bound to a defined value. This differs from\n"
969 "@var{symbol-interned?} in that the mere mention of a symbol\n"
970 "usually causes it to be interned; @code{symbol-bound?}\n"
971 "determines whether a symbol has been given any meaningful\n"
973 #define FUNC_NAME s_scm_symbol_bound_p
977 scm_c_issue_deprecation_warning ("`symbol-bound?' is deprecated. "
978 "Use hashtables instead.");
980 SCM_VALIDATE_SYMBOL (2,s
);
981 if (scm_is_false (o
))
983 SCM var
= scm_sym2var (s
, SCM_BOOL_F
, SCM_BOOL_F
);
984 if (SCM_VARIABLEP(var
) && !SCM_UNBNDP(SCM_VARIABLE_REF(var
)))
988 SCM_VALIDATE_VECTOR (1,o
);
989 vcell
= scm_sym2ovcell_soft (s
, o
);
990 return scm_from_bool (SCM_NIMP (vcell
) && !SCM_UNBNDP (SCM_CDR (vcell
)));
995 SCM_DEFINE (scm_symbol_set_x
, "symbol-set!", 3, 0, 0,
996 (SCM o
, SCM s
, SCM v
),
997 "Find the symbol in @var{obarray} whose name is @var{string}, and rebind\n"
998 "it to @var{value}. An error is signalled if @var{string} is not present\n"
1000 #define FUNC_NAME s_scm_symbol_set_x
1004 scm_c_issue_deprecation_warning ("`symbol-set!' is deprecated. "
1005 "Use the module system instead.");
1007 SCM_VALIDATE_SYMBOL (2,s
);
1008 if (scm_is_false (o
))
1011 return SCM_UNSPECIFIED
;
1013 SCM_VALIDATE_VECTOR (1,o
);
1014 vcell
= scm_sym2ovcell (s
, o
);
1015 SCM_SETCDR (vcell
, v
);
1016 return SCM_UNSPECIFIED
;
1020 #define MAX_PREFIX_LENGTH 30
1022 static int gentemp_counter
;
1024 SCM_DEFINE (scm_gentemp
, "gentemp", 0, 2, 0,
1025 (SCM prefix
, SCM obarray
),
1026 "Create a new symbol with a name unique in an obarray.\n"
1027 "The name is constructed from an optional string @var{prefix}\n"
1028 "and a counter value. The default prefix is @code{t}. The\n"
1029 "@var{obarray} is specified as a second optional argument.\n"
1030 "Default is the system obarray where all normal symbols are\n"
1031 "interned. The counter is increased by 1 at each\n"
1032 "call. There is no provision for resetting the counter.")
1033 #define FUNC_NAME s_scm_gentemp
1035 char buf
[MAX_PREFIX_LENGTH
+ SCM_INTBUFLEN
];
1039 scm_c_issue_deprecation_warning ("`gentemp' is deprecated. "
1040 "Use `gensym' instead.");
1042 if (SCM_UNBNDP (prefix
))
1049 SCM_VALIDATE_STRING (1, prefix
);
1050 len
= scm_i_string_length (prefix
);
1051 if (len
> MAX_PREFIX_LENGTH
)
1052 name
= SCM_MUST_MALLOC (MAX_PREFIX_LENGTH
+ SCM_INTBUFLEN
);
1053 strncpy (name
, scm_i_string_chars (prefix
), len
);
1056 if (SCM_UNBNDP (obarray
))
1057 return scm_gensym (prefix
);
1059 SCM_ASSERT ((SCM_VECTORP (obarray
) || SCM_WVECTP (obarray
)),
1064 n_digits
= scm_iint2str (gentemp_counter
++, 10, &name
[len
]);
1065 while (scm_is_true (scm_intern_obarray_soft (name
,
1070 SCM vcell
= scm_intern_obarray_soft (name
,
1075 scm_must_free (name
);
1076 return SCM_CAR (vcell
);
1082 SCM_MAKINUM (scm_t_signed_bits val
)
1084 scm_c_issue_deprecation_warning
1085 ("SCM_MAKINUM is deprecated. Use scm_from_int or similar instead.");
1086 return SCM_I_MAKINUM (val
);
1092 scm_c_issue_deprecation_warning
1093 ("SCM_INUMP is deprecated. Use scm_is_integer or similar instead.");
1094 return SCM_I_INUMP (obj
);
1100 scm_c_issue_deprecation_warning
1101 ("SCM_INUM is deprecated. Use scm_to_int or similar instead.");
1102 return scm_to_intmax (obj
);
1106 scm_c_string2str (SCM obj
, char *str
, size_t *lenp
)
1108 scm_c_issue_deprecation_warning
1109 ("scm_c_string2str is deprecated. Use scm_to_locale_stringbuf or similar instead.");
1113 char *result
= scm_to_locale_string (obj
);
1115 *lenp
= scm_i_string_length (obj
);
1120 /* Pray that STR is large enough.
1122 size_t len
= scm_to_locale_stringbuf (obj
, str
, SCM_I_SIZE_MAX
);
1131 scm_c_substring2str (SCM obj
, char *str
, size_t start
, size_t len
)
1133 scm_c_issue_deprecation_warning
1134 ("scm_c_substring2str is deprecated. Use scm_substring plus scm_to_locale_stringbuf instead.");
1137 obj
= scm_substring (obj
, scm_from_size_t (start
), SCM_UNDEFINED
);
1139 scm_to_locale_stringbuf (obj
, str
, len
);
1143 /* Converts the given Scheme symbol OBJ into a C string, containing a copy
1144 of OBJ's content with a trailing null byte. If LENP is non-NULL, set
1145 *LENP to the string's length.
1147 When STR is non-NULL it receives the copy and is returned by the function,
1148 otherwise new memory is allocated and the caller is responsible for
1149 freeing it via free(). If out of memory, NULL is returned.
1151 Note that Scheme symbols may contain arbitrary data, including null
1152 characters. This means that null termination is not a reliable way to
1153 determine the length of the returned value. However, the function always
1154 copies the complete contents of OBJ, and sets *LENP to the length of the
1155 scheme symbol (if LENP is non-null). */
1157 scm_c_symbol2str (SCM obj
, char *str
, size_t *lenp
)
1159 return scm_c_string2str (scm_symbol_to_string (obj
), str
, lenp
);
1163 scm_truncate (double x
)
1165 scm_c_issue_deprecation_warning
1166 ("scm_truncate is deprecated. Use scm_c_truncate instead.");
1167 return scm_c_truncate (x
);
1171 scm_round (double x
)
1173 scm_c_issue_deprecation_warning
1174 ("scm_round is deprecated. Use scm_c_round instead.");
1175 return scm_c_round (x
);
1179 SCM_SYMBOL_CHARS (SCM sym
)
1181 scm_c_issue_deprecation_warning
1182 ("SCM_SYMBOL_CHARS is deprecated. Use scm_symbol_to_string.");
1184 return (char *)scm_i_symbol_chars (sym
);
1188 SCM_SYMBOL_LENGTH (SCM sym
)
1190 scm_c_issue_deprecation_warning
1191 ("SCM_SYMBOL_LENGTH is deprecated. Use scm_symbol_to_string.");
1192 return scm_i_symbol_length (sym
);
1196 scm_i_init_deprecated ()
1198 #include "libguile/deprecated.x"