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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
22 #include "libguile/_scm.h"
23 #include "libguile/async.h"
24 #include "libguile/deprecated.h"
25 #include "libguile/discouraged.h"
26 #include "libguile/deprecation.h"
27 #include "libguile/snarf.h"
28 #include "libguile/validate.h"
29 #include "libguile/strings.h"
30 #include "libguile/srfi-13.h"
31 #include "libguile/modules.h"
32 #include "libguile/eval.h"
33 #include "libguile/smob.h"
34 #include "libguile/procprop.h"
35 #include "libguile/vectors.h"
36 #include "libguile/hashtab.h"
37 #include "libguile/struct.h"
38 #include "libguile/variable.h"
39 #include "libguile/fluids.h"
40 #include "libguile/ports.h"
41 #include "libguile/eq.h"
42 #include "libguile/read.h"
43 #include "libguile/strports.h"
44 #include "libguile/smob.h"
45 #include "libguile/alist.h"
46 #include "libguile/keywords.h"
47 #include "libguile/feature.h"
52 #if (SCM_ENABLE_DEPRECATED == 1)
54 /* From print.c: Internal symbol names of isyms. Deprecated in guile 1.7.0 on
56 char *scm_isymnames
[] =
62 /* From eval.c: Error messages of the evaluator. These were deprecated in
63 * guile 1.7.0 on 2003-06-02. */
64 const char scm_s_expression
[] = "missing or extra expression";
65 const char scm_s_test
[] = "bad test";
66 const char scm_s_body
[] = "bad body";
67 const char scm_s_bindings
[] = "bad bindings";
68 const char scm_s_variable
[] = "bad variable";
69 const char scm_s_clauses
[] = "bad or missing clauses";
70 const char scm_s_formals
[] = "bad formals";
73 SCM_REGISTER_PROC(s_substring_move_left_x
, "substring-move-left!", 5, 0, 0, scm_substring_move_x
);
75 SCM_REGISTER_PROC(s_substring_move_right_x
, "substring-move-right!", 5, 0, 0, scm_substring_move_x
);
78 scm_wta (SCM arg
, const char *pos
, const char *s_subr
)
80 if (!s_subr
|| !*s_subr
)
82 if ((~0x1fL
) & (long) pos
)
84 /* error string supplied. */
85 scm_misc_error (s_subr
, pos
, scm_list_1 (arg
));
89 /* numerical error code. */
90 scm_t_bits error
= (scm_t_bits
) pos
;
95 scm_wrong_type_arg (s_subr
, 0, arg
);
97 scm_wrong_type_arg (s_subr
, 1, arg
);
99 scm_wrong_type_arg (s_subr
, 2, arg
);
101 scm_wrong_type_arg (s_subr
, 3, arg
);
103 scm_wrong_type_arg (s_subr
, 4, arg
);
105 scm_wrong_type_arg (s_subr
, 5, arg
);
107 scm_wrong_type_arg (s_subr
, 6, arg
);
109 scm_wrong_type_arg (s_subr
, 7, arg
);
111 scm_wrong_num_args (arg
);
113 scm_out_of_range (s_subr
, arg
);
115 scm_memory_error (s_subr
);
117 /* this shouldn't happen. */
118 scm_misc_error (s_subr
, "Unknown error", SCM_EOL
);
121 return SCM_UNSPECIFIED
;
127 /* We can't use SCM objects here. One should be able to call
128 SCM_REGISTER_MODULE from a C++ constructor for a static
129 object. This happens before main and thus before libguile is
133 struct moddata
*link
;
138 static struct moddata
*registered_mods
= NULL
;
141 scm_register_module_xxx (char *module_name
, void *init_func
)
145 scm_c_issue_deprecation_warning
146 ("`scm_register_module_xxx' is deprecated. Use extensions instead.");
148 /* XXX - should we (and can we) DEFER_INTS here? */
150 for (md
= registered_mods
; md
; md
= md
->link
)
151 if (!strcmp (md
->module_name
, module_name
))
153 md
->init_func
= init_func
;
157 md
= (struct moddata
*) malloc (sizeof (struct moddata
));
161 "guile: can't register module (%s): not enough memory",
166 md
->module_name
= module_name
;
167 md
->init_func
= init_func
;
168 md
->link
= registered_mods
;
169 registered_mods
= md
;
172 SCM_DEFINE (scm_registered_modules
, "c-registered-modules", 0, 0, 0,
174 "Return a list of the object code modules that have been imported into\n"
175 "the current Guile process. Each element of the list is a pair whose\n"
176 "car is the name of the module, and whose cdr is the function handle\n"
177 "for that module's initializer function. The name is the string that\n"
178 "has been passed to scm_register_module_xxx.")
179 #define FUNC_NAME s_scm_registered_modules
185 for (md
= registered_mods
; md
; md
= md
->link
)
186 res
= scm_cons (scm_cons (scm_from_locale_string (md
->module_name
),
187 scm_from_ulong ((unsigned long) md
->init_func
)),
193 SCM_DEFINE (scm_clear_registered_modules
, "c-clear-registered-modules", 0, 0, 0,
195 "Destroy the list of modules registered with the current Guile process.\n"
196 "The return value is unspecified. @strong{Warning:} this function does\n"
197 "not actually unlink or deallocate these modules, but only destroys the\n"
198 "records of which modules have been loaded. It should therefore be used\n"
199 "only by module bookkeeping operations.")
200 #define FUNC_NAME s_scm_clear_registered_modules
202 struct moddata
*md1
, *md2
;
204 SCM_CRITICAL_SECTION_START
;
206 for (md1
= registered_mods
; md1
; md1
= md2
)
211 registered_mods
= NULL
;
213 SCM_CRITICAL_SECTION_END
;
214 return SCM_UNSPECIFIED
;
219 scm_remember (SCM
*ptr
)
221 scm_c_issue_deprecation_warning ("`scm_remember' is deprecated. "
222 "Use the `scm_remember_upto_here*' family of functions instead.");
226 scm_protect_object (SCM obj
)
228 scm_c_issue_deprecation_warning ("`scm_protect_object' is deprecated. "
229 "Use `scm_gc_protect_object' instead.");
230 return scm_gc_protect_object (obj
);
234 scm_unprotect_object (SCM obj
)
236 scm_c_issue_deprecation_warning ("`scm_unprotect_object' is deprecated. "
237 "Use `scm_gc_unprotect_object' instead.");
238 return scm_gc_unprotect_object (obj
);
241 SCM_SYMBOL (scm_sym_app
, "app");
242 SCM_SYMBOL (scm_sym_modules
, "modules");
243 static SCM module_prefix
= SCM_BOOL_F
;
244 static SCM make_modules_in_var
;
245 static SCM beautify_user_module_x_var
;
246 static SCM try_module_autoload_var
;
251 #define PERM(x) scm_permanent_object(x)
253 if (module_prefix
== SCM_BOOL_F
)
255 module_prefix
= PERM (scm_list_2 (scm_sym_app
, scm_sym_modules
));
256 make_modules_in_var
= PERM (scm_c_lookup ("make-modules-in"));
257 beautify_user_module_x_var
=
258 PERM (scm_c_lookup ("beautify-user-module!"));
259 try_module_autoload_var
= PERM (scm_c_lookup ("try-module-autoload"));
264 scm_the_root_module ()
266 init_module_stuff ();
267 scm_c_issue_deprecation_warning ("`scm_the_root_module' is deprecated. "
268 "Use `scm_c_resolve_module (\"guile\")' "
271 return scm_c_resolve_module ("guile");
275 scm_module_full_name (SCM name
)
277 init_module_stuff ();
278 if (scm_is_eq (SCM_CAR (name
), scm_sym_app
))
281 return scm_append (scm_list_2 (module_prefix
, name
));
285 scm_make_module (SCM name
)
287 init_module_stuff ();
288 scm_c_issue_deprecation_warning ("`scm_make_module' is deprecated. "
289 "Use `scm_c_define_module instead.");
291 return scm_call_2 (SCM_VARIABLE_REF (make_modules_in_var
),
292 scm_the_root_module (),
293 scm_module_full_name (name
));
297 scm_ensure_user_module (SCM module
)
299 init_module_stuff ();
300 scm_c_issue_deprecation_warning ("`scm_ensure_user_module' is deprecated. "
301 "Use `scm_c_define_module instead.");
303 scm_call_1 (SCM_VARIABLE_REF (beautify_user_module_x_var
), module
);
304 return SCM_UNSPECIFIED
;
308 scm_load_scheme_module (SCM name
)
310 init_module_stuff ();
311 scm_c_issue_deprecation_warning ("`scm_load_scheme_module' is deprecated. "
312 "Use `scm_c_resolve_module instead.");
314 return scm_call_1 (SCM_VARIABLE_REF (try_module_autoload_var
), name
);
317 /* This is implemented in C solely for SCM_COERCE_OUTPORT ... */
320 maybe_close_port (void *data
, SCM port
)
322 SCM except
= (SCM
)data
;
324 while (!scm_is_null (except
))
326 SCM p
= SCM_COERCE_OUTPORT (SCM_CAR (except
));
327 if (scm_is_eq (p
, port
))
329 except
= SCM_CDR (except
);
332 scm_close_port (port
);
335 SCM_DEFINE (scm_close_all_ports_except
, "close-all-ports-except", 0, 0, 1,
337 "[DEPRECATED] Close all open file ports used by the interpreter\n"
338 "except for those supplied as arguments. This procedure\n"
339 "was intended to be used before an exec call to close file descriptors\n"
340 "which are not needed in the new process. However it has the\n"
341 "undesirable side effect of flushing buffers, so it's deprecated.\n"
342 "Use port-for-each instead.")
343 #define FUNC_NAME s_scm_close_all_ports_except
346 SCM_VALIDATE_REST_ARGUMENT (ports
);
348 for (p
= ports
; !scm_is_null (p
); p
= SCM_CDR (p
))
349 SCM_VALIDATE_OPPORT (SCM_ARG1
, SCM_COERCE_OUTPORT (SCM_CAR (p
)));
351 scm_c_port_for_each (maybe_close_port
, ports
);
353 return SCM_UNSPECIFIED
;
357 SCM_DEFINE (scm_variable_set_name_hint
, "variable-set-name-hint!", 2, 0, 0,
359 "Do not use this function.")
360 #define FUNC_NAME s_scm_variable_set_name_hint
362 SCM_VALIDATE_VARIABLE (1, var
);
363 SCM_VALIDATE_SYMBOL (2, hint
);
364 scm_c_issue_deprecation_warning
365 ("'variable-set-name-hint!' is deprecated. Do not use it.");
366 return SCM_UNSPECIFIED
;
370 SCM_DEFINE (scm_builtin_variable
, "builtin-variable", 1, 0, 0,
372 "Do not use this function.")
373 #define FUNC_NAME s_scm_builtin_variable
375 SCM_VALIDATE_SYMBOL (1,name
);
376 scm_c_issue_deprecation_warning ("`builtin-variable' is deprecated. "
377 "Use module system operations instead.");
378 return scm_sym2var (name
, SCM_BOOL_F
, SCM_BOOL_T
);
383 scm_makstr (size_t len
, int dummy
)
385 scm_c_issue_deprecation_warning
386 ("'scm_makstr' is deprecated. Use 'scm_c_make_string' instead.");
387 return scm_c_make_string (len
, SCM_UNDEFINED
);
391 scm_makfromstr (const char *src
, size_t len
, int dummy SCM_UNUSED
)
393 scm_c_issue_deprecation_warning ("`scm_makfromstr' is deprecated. "
394 "Use `scm_from_locale_stringn' instead.");
396 return scm_from_locale_stringn (src
, len
);
400 scm_internal_with_fluids (SCM fluids
, SCM values
, SCM (*cproc
) (), void *cdata
)
402 scm_c_issue_deprecation_warning ("`scm_internal_with_fluids' is deprecated. "
403 "Use `scm_c_with_fluids' instead.");
405 return scm_c_with_fluids (fluids
, values
, cproc
, cdata
);
409 scm_make_gsubr (const char *name
, int req
, int opt
, int rst
, SCM (*fcn
)())
411 scm_c_issue_deprecation_warning
412 ("`scm_make_gsubr' is deprecated. Use `scm_c_define_gsubr' instead.");
414 return scm_c_define_gsubr (name
, req
, opt
, rst
, fcn
);
418 scm_make_gsubr_with_generic (const char *name
,
419 int req
, int opt
, int rst
,
420 SCM (*fcn
)(), SCM
*gf
)
422 scm_c_issue_deprecation_warning
423 ("`scm_make_gsubr_with_generic' is deprecated. "
424 "Use `scm_c_define_gsubr_with_generic' instead.");
426 return scm_c_define_gsubr_with_generic (name
, req
, opt
, rst
, fcn
, gf
);
430 scm_create_hook (const char *name
, int n_args
)
432 scm_c_issue_deprecation_warning
433 ("'scm_create_hook' is deprecated. "
434 "Use 'scm_make_hook' and 'scm_c_define' instead.");
436 SCM hook
= scm_make_hook (scm_from_int (n_args
));
437 scm_c_define (name
, hook
);
438 return scm_permanent_object (hook
);
442 SCM_DEFINE (scm_sloppy_memq
, "sloppy-memq", 2, 0, 0,
444 "This procedure behaves like @code{memq}, but does no type or error checking.\n"
445 "Its use is recommended only in writing Guile internals,\n"
446 "not for high-level Scheme programs.")
447 #define FUNC_NAME s_scm_sloppy_memq
449 scm_c_issue_deprecation_warning
450 ("'sloppy-memq' is deprecated. Use 'memq' instead.");
452 for(; scm_is_pair (lst
); lst
= SCM_CDR(lst
))
454 if (scm_is_eq (SCM_CAR (lst
), x
))
462 SCM_DEFINE (scm_sloppy_memv
, "sloppy-memv", 2, 0, 0,
464 "This procedure behaves like @code{memv}, but does no type or error checking.\n"
465 "Its use is recommended only in writing Guile internals,\n"
466 "not for high-level Scheme programs.")
467 #define FUNC_NAME s_scm_sloppy_memv
469 scm_c_issue_deprecation_warning
470 ("'sloppy-memv' is deprecated. Use 'memv' instead.");
472 for(; scm_is_pair (lst
); lst
= SCM_CDR(lst
))
474 if (! scm_is_false (scm_eqv_p (SCM_CAR (lst
), x
)))
482 SCM_DEFINE (scm_sloppy_member
, "sloppy-member", 2, 0, 0,
484 "This procedure behaves like @code{member}, but does no type or error checking.\n"
485 "Its use is recommended only in writing Guile internals,\n"
486 "not for high-level Scheme programs.")
487 #define FUNC_NAME s_scm_sloppy_member
489 scm_c_issue_deprecation_warning
490 ("'sloppy-member' is deprecated. Use 'member' instead.");
492 for(; scm_is_pair (lst
); lst
= SCM_CDR(lst
))
494 if (! scm_is_false (scm_equal_p (SCM_CAR (lst
), x
)))
501 SCM_SYMBOL (scm_end_of_file_key
, "end-of-file");
503 SCM_DEFINE (scm_read_and_eval_x
, "read-and-eval!", 0, 1, 0,
505 "Read a form from @var{port} (standard input by default), and evaluate it\n"
506 "(memoizing it in the process) in the top-level environment. If no data\n"
507 "is left to be read from @var{port}, an @code{end-of-file} error is\n"
509 #define FUNC_NAME s_scm_read_and_eval_x
513 scm_c_issue_deprecation_warning
514 ("'read-and-eval!' is deprecated. Use 'read' and 'eval' instead.");
516 form
= scm_read (port
);
517 if (SCM_EOF_OBJECT_P (form
))
518 scm_ithrow (scm_end_of_file_key
, SCM_EOL
, 1);
519 return scm_eval_x (form
, scm_current_module ());
524 scm_make_subr_opt (const char *name
, int type
, SCM (*fcn
) (), int set
)
526 scm_c_issue_deprecation_warning
527 ("`scm_make_subr_opt' is deprecated. Use `scm_c_make_subr' or "
528 "`scm_c_define_subr' instead.");
531 return scm_c_define_subr (name
, type
, fcn
);
533 return scm_c_make_subr (name
, type
, fcn
);
537 scm_make_subr (const char *name
, int type
, SCM (*fcn
) ())
539 scm_c_issue_deprecation_warning
540 ("`scm_make_subr' is deprecated. Use `scm_c_define_subr' instead.");
542 return scm_c_define_subr (name
, type
, fcn
);
546 scm_make_subr_with_generic (const char *name
, int type
, SCM (*fcn
) (), SCM
*gf
)
548 scm_c_issue_deprecation_warning
549 ("`scm_make_subr_with_generic' is deprecated. Use "
550 "`scm_c_define_subr_with_generic' instead.");
552 return scm_c_define_subr_with_generic (name
, type
, fcn
, gf
);
555 /* Call thunk(closure) underneath a top-level error handler.
556 * If an error occurs, pass the exitval through err_filter and return it.
557 * If no error occurs, return the value of thunk.
561 typedef int setjmp_type
;
563 typedef long setjmp_type
;
566 struct cce_handler_data
{
567 SCM (*err_filter
) ();
572 invoke_err_filter (void *d
, SCM tag
, SCM args
)
574 struct cce_handler_data
*data
= (struct cce_handler_data
*)d
;
575 return data
->err_filter (SCM_BOOL_F
, data
->closure
);
579 scm_call_catching_errors (SCM (*thunk
)(), SCM (*err_filter
)(), void *closure
)
581 scm_c_issue_deprecation_warning
582 ("'scm_call_catching_errors' is deprecated. "
583 "Use 'scm_internal_catch' instead.");
586 struct cce_handler_data data
;
587 data
.err_filter
= err_filter
;
588 data
.closure
= closure
;
589 return scm_internal_catch (SCM_BOOL_T
,
590 (scm_t_catch_body
)thunk
, closure
,
591 (scm_t_catch_handler
)invoke_err_filter
, &data
);
596 scm_make_smob_type_mfpe (char *name
, size_t size
,
598 size_t (*free
) (SCM
),
599 int (*print
) (SCM
, SCM
, scm_print_state
*),
600 SCM (*equalp
) (SCM
, SCM
))
602 scm_c_issue_deprecation_warning
603 ("'scm_make_smob_type_mfpe' is deprecated. "
604 "Use 'scm_make_smob_type' plus 'scm_set_smob_*' instead.");
607 long answer
= scm_make_smob_type (name
, size
);
608 scm_set_smob_mfpe (answer
, mark
, free
, print
, equalp
);
614 scm_set_smob_mfpe (long tc
,
616 size_t (*free
) (SCM
),
617 int (*print
) (SCM
, SCM
, scm_print_state
*),
618 SCM (*equalp
) (SCM
, SCM
))
620 scm_c_issue_deprecation_warning
621 ("'scm_set_smob_mfpe' is deprecated. "
622 "Use 'scm_set_smob_mark' instead, for example.");
624 if (mark
) scm_set_smob_mark (tc
, mark
);
625 if (free
) scm_set_smob_free (tc
, free
);
626 if (print
) scm_set_smob_print (tc
, print
);
627 if (equalp
) scm_set_smob_equalp (tc
, equalp
);
631 scm_read_0str (char *expr
)
633 scm_c_issue_deprecation_warning
634 ("scm_read_0str is deprecated. Use scm_c_read_string instead.");
636 return scm_c_read_string (expr
);
640 scm_eval_0str (const char *expr
)
642 scm_c_issue_deprecation_warning
643 ("scm_eval_0str is deprecated. Use scm_c_eval_string instead.");
645 return scm_c_eval_string (expr
);
649 scm_strprint_obj (SCM obj
)
651 scm_c_issue_deprecation_warning
652 ("scm_strprint_obj is deprecated. Use scm_object_to_string instead.");
653 return scm_object_to_string (obj
, SCM_UNDEFINED
);
657 scm_i_object_chars (SCM obj
)
659 scm_c_issue_deprecation_warning
660 ("SCM_CHARS is deprecated. See the manual for alternatives.");
661 if (SCM_STRINGP (obj
))
662 return SCM_STRING_CHARS (obj
);
663 if (SCM_SYMBOLP (obj
))
664 return SCM_SYMBOL_CHARS (obj
);
669 scm_i_object_length (SCM obj
)
671 scm_c_issue_deprecation_warning
672 ("SCM_LENGTH is deprecated. "
673 "Use scm_c_string_length instead, for example, or see the manual.");
674 if (SCM_STRINGP (obj
))
675 return SCM_STRING_LENGTH (obj
);
676 if (SCM_SYMBOLP (obj
))
677 return SCM_SYMBOL_LENGTH (obj
);
678 if (SCM_VECTORP (obj
))
679 return SCM_VECTOR_LENGTH (obj
);
684 scm_sym2ovcell_soft (SCM sym
, SCM obarray
)
687 size_t hash
= scm_i_symbol_hash (sym
) % SCM_VECTOR_LENGTH (obarray
);
689 scm_c_issue_deprecation_warning ("`scm_sym2ovcell_soft' is deprecated. "
690 "Use hashtables instead.");
692 SCM_CRITICAL_SECTION_START
;
693 for (lsym
= SCM_VECTOR_REF (obarray
, hash
);
695 lsym
= SCM_CDR (lsym
))
698 if (scm_is_eq (SCM_CAR (z
), sym
))
700 SCM_CRITICAL_SECTION_END
;
704 SCM_CRITICAL_SECTION_END
;
710 scm_sym2ovcell (SCM sym
, SCM obarray
)
711 #define FUNC_NAME "scm_sym2ovcell"
715 scm_c_issue_deprecation_warning ("`scm_sym2ovcell' is deprecated. "
716 "Use hashtables instead.");
718 answer
= scm_sym2ovcell_soft (sym
, obarray
);
719 if (scm_is_true (answer
))
721 SCM_MISC_ERROR ("uninterned symbol: ~S", scm_list_1 (sym
));
722 return SCM_UNSPECIFIED
; /* not reached */
727 /* Intern a symbol whose name is the LEN characters at NAME in OBARRAY.
729 OBARRAY should be a vector of lists, indexed by the name's hash
730 value, modulo OBARRAY's length. Each list has the form
731 ((SYMBOL . VALUE) ...), where SYMBOL is a symbol, and VALUE is the
732 value associated with that symbol (in the current module? in the
735 To "intern" a symbol means: if OBARRAY already contains a symbol by
736 that name, return its (SYMBOL . VALUE) pair; otherwise, create a
737 new symbol, add the pair (SYMBOL . SCM_UNDEFINED) to the
738 appropriate list of the OBARRAY, and return the pair.
740 If softness is non-zero, don't create a symbol if it isn't already
741 in OBARRAY; instead, just return #f.
743 If OBARRAY is SCM_BOOL_F, create a symbol listed in no obarray and
744 return (SYMBOL . SCM_UNDEFINED). */
748 scm_intern_obarray_soft (const char *name
,size_t len
,SCM obarray
,unsigned int softness
)
750 SCM symbol
= scm_from_locale_symboln (name
, len
);
751 size_t raw_hash
= scm_i_symbol_hash (symbol
);
755 scm_c_issue_deprecation_warning ("`scm_intern_obarray_soft' is deprecated. "
756 "Use hashtables instead.");
758 if (scm_is_false (obarray
))
763 return scm_cons (symbol
, SCM_UNDEFINED
);
766 hash
= raw_hash
% SCM_VECTOR_LENGTH (obarray
);
768 for (lsym
= SCM_VECTOR_REF(obarray
, hash
);
769 SCM_NIMP (lsym
); lsym
= SCM_CDR (lsym
))
771 SCM a
= SCM_CAR (lsym
);
773 if (scm_is_eq (z
, symbol
))
783 SCM cell
= scm_cons (symbol
, SCM_UNDEFINED
);
784 SCM slot
= SCM_VECTOR_REF (obarray
, hash
);
786 SCM_VECTOR_SET (obarray
, hash
, scm_cons (cell
, slot
));
794 scm_intern_obarray (const char *name
,size_t len
,SCM obarray
)
796 scm_c_issue_deprecation_warning ("`scm_intern_obarray' is deprecated. "
797 "Use hashtables instead.");
799 return scm_intern_obarray_soft (name
, len
, obarray
, 0);
802 /* Lookup the value of the symbol named by the nul-terminated string
803 NAME in the current module. */
805 scm_symbol_value0 (const char *name
)
807 scm_c_issue_deprecation_warning ("`scm_symbol_value0' is deprecated. "
808 "Use `scm_lookup' instead.");
810 return scm_variable_ref (scm_c_lookup (name
));
813 SCM_DEFINE (scm_string_to_obarray_symbol
, "string->obarray-symbol", 2, 1, 0,
814 (SCM o
, SCM s
, SCM softp
),
815 "Intern a new symbol in @var{obarray}, a symbol table, with name\n"
817 "If @var{obarray} is @code{#f}, use the default system symbol table. If\n"
818 "@var{obarray} is @code{#t}, the symbol should not be interned in any\n"
819 "symbol table; merely return the pair (@var{symbol}\n"
820 ". @var{#<undefined>}).\n\n"
821 "The @var{soft?} argument determines whether new symbol table entries\n"
822 "should be created when the specified symbol is not already present in\n"
823 "@var{obarray}. If @var{soft?} is specified and is a true value, then\n"
824 "new entries should not be added for symbols not already present in the\n"
825 "table; instead, simply return @code{#f}.")
826 #define FUNC_NAME s_scm_string_to_obarray_symbol
832 SCM_VALIDATE_STRING (2, s
);
833 SCM_ASSERT (scm_is_bool (o
) || SCM_VECTORP (o
), o
, SCM_ARG1
, FUNC_NAME
);
835 scm_c_issue_deprecation_warning ("`string->obarray-symbol' is deprecated. "
836 "Use hashtables instead.");
838 softness
= (!SCM_UNBNDP (softp
) && scm_is_true(softp
));
839 /* iron out some screwy calling conventions */
840 if (scm_is_false (o
))
842 /* nothing interesting to do here. */
843 return scm_string_to_symbol (s
);
845 else if (scm_is_eq (o
, SCM_BOOL_T
))
848 vcell
= scm_intern_obarray_soft (scm_i_string_chars (s
),
849 scm_i_string_length (s
),
852 if (scm_is_false (vcell
))
854 answer
= SCM_CAR (vcell
);
859 SCM_DEFINE (scm_intern_symbol
, "intern-symbol", 2, 0, 0,
861 "Add a new symbol to @var{obarray} with name @var{string}, bound to an\n"
862 "unspecified initial value. The symbol table is not modified if a symbol\n"
863 "with this name is already present.")
864 #define FUNC_NAME s_scm_intern_symbol
867 SCM_VALIDATE_SYMBOL (2,s
);
868 if (scm_is_false (o
))
869 return SCM_UNSPECIFIED
;
871 scm_c_issue_deprecation_warning ("`intern-symbol' is deprecated. "
872 "Use hashtables instead.");
874 SCM_VALIDATE_VECTOR (1,o
);
875 hval
= scm_i_symbol_hash (s
) % SCM_VECTOR_LENGTH (o
);
876 /* If the symbol is already interned, simply return. */
877 SCM_CRITICAL_SECTION_START
;
881 for (lsym
= SCM_VECTOR_REF (o
, hval
);
883 lsym
= SCM_CDR (lsym
))
885 sym
= SCM_CAR (lsym
);
886 if (scm_is_eq (SCM_CAR (sym
), s
))
888 SCM_CRITICAL_SECTION_END
;
889 return SCM_UNSPECIFIED
;
892 SCM_VECTOR_SET (o
, hval
,
893 scm_acons (s
, SCM_UNDEFINED
,
894 SCM_VECTOR_REF (o
, hval
)));
896 SCM_CRITICAL_SECTION_END
;
897 return SCM_UNSPECIFIED
;
901 SCM_DEFINE (scm_unintern_symbol
, "unintern-symbol", 2, 0, 0,
903 "Remove the symbol with name @var{string} from @var{obarray}. This\n"
904 "function returns @code{#t} if the symbol was present and @code{#f}\n"
906 #define FUNC_NAME s_scm_unintern_symbol
910 scm_c_issue_deprecation_warning ("`unintern-symbol' is deprecated. "
911 "Use hashtables instead.");
913 SCM_VALIDATE_SYMBOL (2,s
);
914 if (scm_is_false (o
))
916 SCM_VALIDATE_VECTOR (1,o
);
917 hval
= scm_i_symbol_hash (s
) % SCM_VECTOR_LENGTH (o
);
918 SCM_CRITICAL_SECTION_START
;
923 for (lsym
= SCM_VECTOR_REF (o
, hval
), lsym_follow
= SCM_BOOL_F
;
925 lsym_follow
= lsym
, lsym
= SCM_CDR (lsym
))
927 sym
= SCM_CAR (lsym
);
928 if (scm_is_eq (SCM_CAR (sym
), s
))
930 /* Found the symbol to unintern. */
931 if (scm_is_false (lsym_follow
))
932 SCM_VECTOR_SET (o
, hval
, lsym
);
934 SCM_SETCDR (lsym_follow
, SCM_CDR(lsym
));
935 SCM_CRITICAL_SECTION_END
;
940 SCM_CRITICAL_SECTION_END
;
945 SCM_DEFINE (scm_symbol_binding
, "symbol-binding", 2, 0, 0,
947 "Look up in @var{obarray} the symbol whose name is @var{string}, and\n"
948 "return the value to which it is bound. If @var{obarray} is @code{#f},\n"
949 "use the global symbol table. If @var{string} is not interned in\n"
950 "@var{obarray}, an error is signalled.")
951 #define FUNC_NAME s_scm_symbol_binding
955 scm_c_issue_deprecation_warning ("`symbol-binding' is deprecated. "
956 "Use hashtables instead.");
958 SCM_VALIDATE_SYMBOL (2,s
);
959 if (scm_is_false (o
))
960 return scm_variable_ref (scm_lookup (s
));
961 SCM_VALIDATE_VECTOR (1,o
);
962 vcell
= scm_sym2ovcell (s
, o
);
963 return SCM_CDR(vcell
);
968 SCM_DEFINE (scm_symbol_interned_p
, "symbol-interned?", 2, 0, 0,
970 "Return @code{#t} if @var{obarray} contains a symbol with name\n"
971 "@var{string}, and @code{#f} otherwise.")
972 #define FUNC_NAME s_scm_symbol_interned_p
976 scm_c_issue_deprecation_warning ("`symbol-interned?' is deprecated. "
977 "Use hashtables instead.");
979 SCM_VALIDATE_SYMBOL (2,s
);
980 if (scm_is_false (o
))
982 SCM var
= scm_sym2var (s
, SCM_BOOL_F
, SCM_BOOL_F
);
983 if (var
!= SCM_BOOL_F
)
987 SCM_VALIDATE_VECTOR (1,o
);
988 vcell
= scm_sym2ovcell_soft (s
, o
);
989 return (SCM_NIMP(vcell
)
996 SCM_DEFINE (scm_symbol_bound_p
, "symbol-bound?", 2, 0, 0,
998 "Return @code{#t} if @var{obarray} contains a symbol with name\n"
999 "@var{string} bound to a defined value. This differs from\n"
1000 "@var{symbol-interned?} in that the mere mention of a symbol\n"
1001 "usually causes it to be interned; @code{symbol-bound?}\n"
1002 "determines whether a symbol has been given any meaningful\n"
1004 #define FUNC_NAME s_scm_symbol_bound_p
1008 scm_c_issue_deprecation_warning ("`symbol-bound?' is deprecated. "
1009 "Use hashtables instead.");
1011 SCM_VALIDATE_SYMBOL (2,s
);
1012 if (scm_is_false (o
))
1014 SCM var
= scm_sym2var (s
, SCM_BOOL_F
, SCM_BOOL_F
);
1015 if (SCM_VARIABLEP(var
) && !SCM_UNBNDP(SCM_VARIABLE_REF(var
)))
1019 SCM_VALIDATE_VECTOR (1,o
);
1020 vcell
= scm_sym2ovcell_soft (s
, o
);
1021 return scm_from_bool (SCM_NIMP (vcell
) && !SCM_UNBNDP (SCM_CDR (vcell
)));
1026 SCM_DEFINE (scm_symbol_set_x
, "symbol-set!", 3, 0, 0,
1027 (SCM o
, SCM s
, SCM v
),
1028 "Find the symbol in @var{obarray} whose name is @var{string}, and rebind\n"
1029 "it to @var{value}. An error is signalled if @var{string} is not present\n"
1030 "in @var{obarray}.")
1031 #define FUNC_NAME s_scm_symbol_set_x
1035 scm_c_issue_deprecation_warning ("`symbol-set!' is deprecated. "
1036 "Use the module system instead.");
1038 SCM_VALIDATE_SYMBOL (2,s
);
1039 if (scm_is_false (o
))
1042 return SCM_UNSPECIFIED
;
1044 SCM_VALIDATE_VECTOR (1,o
);
1045 vcell
= scm_sym2ovcell (s
, o
);
1046 SCM_SETCDR (vcell
, v
);
1047 return SCM_UNSPECIFIED
;
1051 #define MAX_PREFIX_LENGTH 30
1053 static int gentemp_counter
;
1055 SCM_DEFINE (scm_gentemp
, "gentemp", 0, 2, 0,
1056 (SCM prefix
, SCM obarray
),
1057 "Create a new symbol with a name unique in an obarray.\n"
1058 "The name is constructed from an optional string @var{prefix}\n"
1059 "and a counter value. The default prefix is @code{t}. The\n"
1060 "@var{obarray} is specified as a second optional argument.\n"
1061 "Default is the system obarray where all normal symbols are\n"
1062 "interned. The counter is increased by 1 at each\n"
1063 "call. There is no provision for resetting the counter.")
1064 #define FUNC_NAME s_scm_gentemp
1066 char buf
[MAX_PREFIX_LENGTH
+ SCM_INTBUFLEN
];
1070 scm_c_issue_deprecation_warning ("`gentemp' is deprecated. "
1071 "Use `gensym' instead.");
1073 if (SCM_UNBNDP (prefix
))
1080 SCM_VALIDATE_STRING (1, prefix
);
1081 len
= scm_i_string_length (prefix
);
1082 if (len
> MAX_PREFIX_LENGTH
)
1083 name
= SCM_MUST_MALLOC (MAX_PREFIX_LENGTH
+ SCM_INTBUFLEN
);
1084 strncpy (name
, scm_i_string_chars (prefix
), len
);
1087 if (SCM_UNBNDP (obarray
))
1088 return scm_gensym (prefix
);
1090 SCM_ASSERT ((scm_is_vector (obarray
) || SCM_I_WVECTP (obarray
)),
1095 n_digits
= scm_iint2str (gentemp_counter
++, 10, &name
[len
]);
1096 while (scm_is_true (scm_intern_obarray_soft (name
,
1101 SCM vcell
= scm_intern_obarray_soft (name
,
1106 scm_must_free (name
);
1107 return SCM_CAR (vcell
);
1113 scm_i_makinum (scm_t_signed_bits val
)
1115 scm_c_issue_deprecation_warning
1116 ("SCM_MAKINUM is deprecated. Use scm_from_int or similar instead.");
1117 return SCM_I_MAKINUM (val
);
1121 scm_i_inump (SCM obj
)
1123 scm_c_issue_deprecation_warning
1124 ("SCM_INUMP is deprecated. Use scm_is_integer or similar instead.");
1125 return SCM_I_INUMP (obj
);
1129 scm_i_inum (SCM obj
)
1131 scm_c_issue_deprecation_warning
1132 ("SCM_INUM is deprecated. Use scm_to_int or similar instead.");
1133 return scm_to_intmax (obj
);
1137 scm_c_string2str (SCM obj
, char *str
, size_t *lenp
)
1139 scm_c_issue_deprecation_warning
1140 ("scm_c_string2str is deprecated. Use scm_to_locale_stringbuf or similar instead.");
1144 char *result
= scm_to_locale_string (obj
);
1146 *lenp
= scm_i_string_length (obj
);
1151 /* Pray that STR is large enough.
1153 size_t len
= scm_to_locale_stringbuf (obj
, str
, SCM_I_SIZE_MAX
);
1162 scm_c_substring2str (SCM obj
, char *str
, size_t start
, size_t len
)
1164 scm_c_issue_deprecation_warning
1165 ("scm_c_substring2str is deprecated. Use scm_substring plus scm_to_locale_stringbuf instead.");
1168 obj
= scm_substring (obj
, scm_from_size_t (start
), SCM_UNDEFINED
);
1170 scm_to_locale_stringbuf (obj
, str
, len
);
1174 /* Converts the given Scheme symbol OBJ into a C string, containing a copy
1175 of OBJ's content with a trailing null byte. If LENP is non-NULL, set
1176 *LENP to the string's length.
1178 When STR is non-NULL it receives the copy and is returned by the function,
1179 otherwise new memory is allocated and the caller is responsible for
1180 freeing it via free(). If out of memory, NULL is returned.
1182 Note that Scheme symbols may contain arbitrary data, including null
1183 characters. This means that null termination is not a reliable way to
1184 determine the length of the returned value. However, the function always
1185 copies the complete contents of OBJ, and sets *LENP to the length of the
1186 scheme symbol (if LENP is non-null). */
1188 scm_c_symbol2str (SCM obj
, char *str
, size_t *lenp
)
1190 return scm_c_string2str (scm_symbol_to_string (obj
), str
, lenp
);
1194 scm_truncate (double x
)
1196 scm_c_issue_deprecation_warning
1197 ("scm_truncate is deprecated. Use scm_c_truncate instead.");
1198 return scm_c_truncate (x
);
1202 scm_round (double x
)
1204 scm_c_issue_deprecation_warning
1205 ("scm_round is deprecated. Use scm_c_round instead.");
1206 return scm_c_round (x
);
1210 scm_i_deprecated_symbol_chars (SCM sym
)
1212 scm_c_issue_deprecation_warning
1213 ("SCM_SYMBOL_CHARS is deprecated. Use scm_symbol_to_string.");
1215 return (char *)scm_i_symbol_chars (sym
);
1219 scm_i_deprecated_symbol_length (SCM sym
)
1221 scm_c_issue_deprecation_warning
1222 ("SCM_SYMBOL_LENGTH is deprecated. Use scm_symbol_to_string.");
1223 return scm_i_symbol_length (sym
);
1227 scm_i_keywordp (SCM obj
)
1229 scm_c_issue_deprecation_warning
1230 ("SCM_KEYWORDP is deprecated. Use scm_is_keyword instead.");
1231 return scm_is_keyword (obj
);
1235 scm_i_keywordsym (SCM keyword
)
1237 scm_c_issue_deprecation_warning
1238 ("SCM_KEYWORDSYM is deprecated. See scm_keyword_to_symbol instead.");
1239 return scm_keyword_dash_symbol (keyword
);
1243 scm_i_vectorp (SCM x
)
1245 scm_c_issue_deprecation_warning
1246 ("SCM_VECTORP is deprecated. Use scm_is_vector instead.");
1247 return SCM_I_IS_VECTOR (x
);
1251 scm_i_vector_length (SCM x
)
1253 scm_c_issue_deprecation_warning
1254 ("SCM_VECTOR_LENGTH is deprecated. Use scm_c_vector_length instead.");
1255 return SCM_I_VECTOR_LENGTH (x
);
1261 scm_c_issue_deprecation_warning
1262 ("SCM_VELTS is deprecated. Use scm_vector_elements instead.");
1263 return SCM_I_VECTOR_ELTS (x
);
1267 scm_i_writable_velts (SCM x
)
1269 scm_c_issue_deprecation_warning
1270 ("SCM_WRITABLE_VELTS is deprecated. "
1271 "Use scm_vector_writable_elements instead.");
1272 return SCM_I_VECTOR_WELTS (x
);
1276 scm_i_vector_ref (SCM x
, size_t idx
)
1278 scm_c_issue_deprecation_warning
1279 ("SCM_VECTOR_REF is deprecated. "
1280 "Use scm_c_vector_ref or scm_vector_elements instead.");
1281 return scm_c_vector_ref (x
, idx
);
1285 scm_i_vector_set (SCM x
, size_t idx
, SCM val
)
1287 scm_c_issue_deprecation_warning
1288 ("SCM_VECTOR_SET is deprecated. "
1289 "Use scm_c_vector_set_x or scm_vector_writable_elements instead.");
1290 scm_c_vector_set_x (x
, idx
, val
);
1294 scm_vector_equal_p (SCM x
, SCM y
)
1296 scm_c_issue_deprecation_warning
1297 ("scm_vector_euqal_p is deprecated. "
1298 "Use scm_equal_p instead.");
1299 return scm_equal_p (x
, y
);
1303 scm_i_arrayp (SCM a
)
1305 scm_c_issue_deprecation_warning
1306 ("SCM_ARRAYP is deprecated. Use scm_is_array instead.");
1307 return SCM_I_ARRAYP(a
) || SCM_I_ENCLOSED_ARRAYP(a
);
1311 scm_i_array_ndim (SCM a
)
1313 scm_c_issue_deprecation_warning
1314 ("SCM_ARRAY_NDIM is deprecated. "
1315 "Use scm_c_array_rank or scm_array_handle_rank instead.");
1316 return scm_c_array_rank (a
);
1320 scm_i_array_contp (SCM a
)
1322 scm_c_issue_deprecation_warning
1323 ("SCM_ARRAY_CONTP is deprecated. Do not use it.");
1324 return SCM_I_ARRAY_CONTP (a
);
1328 scm_i_array_mem (SCM a
)
1330 scm_c_issue_deprecation_warning
1331 ("SCM_ARRAY_MEM is deprecated. Do not use it.");
1332 return (scm_t_array
*)SCM_I_ARRAY_MEM (a
);
1336 scm_i_array_v (SCM a
)
1338 /* We could use scm_shared_array_root here, but it is better to move
1339 them away from expecting vectors as the basic storage for arrays.
1341 scm_c_issue_deprecation_warning
1342 ("SCM_ARRAY_V is deprecated. Do not use it.");
1343 return SCM_I_ARRAY_V (a
);
1347 scm_i_array_base (SCM a
)
1349 scm_c_issue_deprecation_warning
1350 ("SCM_ARRAY_BASE is deprecated. Do not use it.");
1351 return SCM_I_ARRAY_BASE (a
);
1355 scm_i_array_dims (SCM a
)
1357 scm_c_issue_deprecation_warning
1358 ("SCM_ARRAY_DIMS is deprecated. Use scm_array_handle_dims instead.");
1359 return SCM_I_ARRAY_DIMS (a
);
1363 scm_i_cur_inp (void)
1365 scm_c_issue_deprecation_warning
1366 ("scm_cur_inp is deprecated. Use scm_current_input_port instead.");
1367 return scm_current_input_port ();
1371 scm_i_cur_outp (void)
1373 scm_c_issue_deprecation_warning
1374 ("scm_cur_outp is deprecated. Use scm_current_output_port instead.");
1375 return scm_current_output_port ();
1379 scm_i_cur_errp (void)
1381 scm_c_issue_deprecation_warning
1382 ("scm_cur_errp is deprecated. Use scm_current_error_port instead.");
1383 return scm_current_error_port ();
1387 scm_i_cur_loadp (void)
1389 scm_c_issue_deprecation_warning
1390 ("scm_cur_loadp is deprecated. Use scm_current_load_port instead.");
1391 return scm_current_load_port ();
1395 scm_i_progargs (void)
1397 scm_c_issue_deprecation_warning
1398 ("scm_progargs is deprecated. Use scm_program_arguments instead.");
1399 return scm_program_arguments ();
1403 scm_i_deprecated_dynwinds (void)
1405 scm_c_issue_deprecation_warning
1406 ("scm_dynwinds is deprecated. Do not use it.");
1407 return scm_i_dynwinds ();
1411 scm_i_deprecated_last_debug_frame (void)
1413 scm_c_issue_deprecation_warning
1414 ("scm_last_debug_frame is deprecated. Do not use it.");
1415 return scm_i_last_debug_frame ();
1419 scm_i_stack_base (void)
1421 scm_c_issue_deprecation_warning
1422 ("scm_stack_base is deprecated. Do not use it.");
1423 return SCM_I_CURRENT_THREAD
->base
;
1427 scm_i_fluidp (SCM x
)
1429 scm_c_issue_deprecation_warning
1430 ("SCM_FLUIDP is deprecated. Use scm_is_fluid instead.");
1431 return scm_is_fluid (x
);
1435 scm_i_defer_ints_etc ()
1437 scm_c_issue_deprecation_warning
1438 ("SCM_CRITICAL_SECTION_START etc are deprecated. "
1439 "Use a mutex instead if appropriate.");
1443 scm_guard (SCM guardian
, SCM obj
, int throw_p
)
1445 scm_c_issue_deprecation_warning
1446 ("scm_guard is deprecated. Use scm_call_1 instead.");
1448 return scm_call_1 (guardian
, obj
);
1452 scm_get_one_zombie (SCM guardian
)
1454 scm_c_issue_deprecation_warning
1455 ("scm_guard is deprecated. Use scm_call_0 instead.");
1457 return scm_call_0 (guardian
);
1460 SCM_DEFINE (scm_guardian_destroyed_p
, "guardian-destroyed?", 1, 0, 0,
1462 "Return @code{#t} if @var{guardian} has been destroyed, otherwise @code{#f}.")
1463 #define FUNC_NAME s_scm_guardian_destroyed_p
1465 scm_c_issue_deprecation_warning
1466 ("'guardian-destroyed?' is deprecated.");
1471 SCM_DEFINE (scm_guardian_greedy_p
, "guardian-greedy?", 1, 0, 0,
1473 "Return @code{#t} if @var{guardian} is a greedy guardian, otherwise @code{#f}.")
1474 #define FUNC_NAME s_scm_guardian_greedy_p
1476 scm_c_issue_deprecation_warning
1477 ("'guardian-greedy?' is deprecated.");
1482 SCM_DEFINE (scm_destroy_guardian_x
, "destroy-guardian!", 1, 0, 0,
1484 "Destroys @var{guardian}, by making it impossible to put any more\n"
1485 "objects in it or get any objects from it. It also unguards any\n"
1486 "objects guarded by @var{guardian}.")
1487 #define FUNC_NAME s_scm_destroy_guardian_x
1489 scm_c_issue_deprecation_warning
1490 ("'destroy-guardian!' is deprecated and ineffective.");
1491 return SCM_UNSPECIFIED
;
1496 scm_i_init_deprecated ()
1498 #include "libguile/deprecated.x"