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, 2006, 2008, 2009 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 License
9 * as published by the Free Software Foundation; either version 3 of
10 * the License, or (at your option) any later version.
12 * This library is distributed in the hope that it will be useful, but
13 * 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
27 #define SCM_BUILDING_DEPRECATED_CODE
29 #include "libguile/_scm.h"
30 #include "libguile/async.h"
31 #include "libguile/deprecated.h"
32 #include "libguile/discouraged.h"
33 #include "libguile/deprecation.h"
34 #include "libguile/snarf.h"
35 #include "libguile/validate.h"
36 #include "libguile/strings.h"
37 #include "libguile/srfi-13.h"
38 #include "libguile/modules.h"
39 #include "libguile/generalized-arrays.h"
40 #include "libguile/eval.h"
41 #include "libguile/smob.h"
42 #include "libguile/procprop.h"
43 #include "libguile/vectors.h"
44 #include "libguile/hashtab.h"
45 #include "libguile/struct.h"
46 #include "libguile/variable.h"
47 #include "libguile/fluids.h"
48 #include "libguile/ports.h"
49 #include "libguile/eq.h"
50 #include "libguile/read.h"
51 #include "libguile/strports.h"
52 #include "libguile/smob.h"
53 #include "libguile/alist.h"
54 #include "libguile/keywords.h"
55 #include "libguile/feature.h"
60 #if (SCM_ENABLE_DEPRECATED == 1)
62 /* From print.c: Internal symbol names of isyms. Deprecated in guile 1.7.0 on
64 char *scm_isymnames
[] =
70 /* From eval.c: Error messages of the evaluator. These were deprecated in
71 * guile 1.7.0 on 2003-06-02. */
72 const char scm_s_expression
[] = "missing or extra expression";
73 const char scm_s_test
[] = "bad test";
74 const char scm_s_body
[] = "bad body";
75 const char scm_s_bindings
[] = "bad bindings";
76 const char scm_s_variable
[] = "bad variable";
77 const char scm_s_clauses
[] = "bad or missing clauses";
78 const char scm_s_formals
[] = "bad formals";
81 SCM_REGISTER_PROC(s_substring_move_left_x
, "substring-move-left!", 5, 0, 0, scm_substring_move_x
);
83 SCM_REGISTER_PROC(s_substring_move_right_x
, "substring-move-right!", 5, 0, 0, scm_substring_move_x
);
86 scm_wta (SCM arg
, const char *pos
, const char *s_subr
)
88 if (!s_subr
|| !*s_subr
)
90 if ((~0x1fL
) & (long) pos
)
92 /* error string supplied. */
93 scm_misc_error (s_subr
, pos
, scm_list_1 (arg
));
97 /* numerical error code. */
98 scm_t_bits error
= (scm_t_bits
) pos
;
103 scm_wrong_type_arg (s_subr
, 0, arg
);
105 scm_wrong_type_arg (s_subr
, 1, arg
);
107 scm_wrong_type_arg (s_subr
, 2, arg
);
109 scm_wrong_type_arg (s_subr
, 3, arg
);
111 scm_wrong_type_arg (s_subr
, 4, arg
);
113 scm_wrong_type_arg (s_subr
, 5, arg
);
115 scm_wrong_type_arg (s_subr
, 6, arg
);
117 scm_wrong_type_arg (s_subr
, 7, arg
);
119 scm_wrong_num_args (arg
);
121 scm_out_of_range (s_subr
, arg
);
123 scm_memory_error (s_subr
);
125 /* this shouldn't happen. */
126 scm_misc_error (s_subr
, "Unknown error", SCM_EOL
);
129 return SCM_UNSPECIFIED
;
135 /* We can't use SCM objects here. One should be able to call
136 SCM_REGISTER_MODULE from a C++ constructor for a static
137 object. This happens before main and thus before libguile is
141 struct moddata
*link
;
146 static struct moddata
*registered_mods
= NULL
;
149 scm_register_module_xxx (char *module_name
, void *init_func
)
153 scm_c_issue_deprecation_warning
154 ("`scm_register_module_xxx' is deprecated. Use extensions instead.");
156 /* XXX - should we (and can we) DEFER_INTS here? */
158 for (md
= registered_mods
; md
; md
= md
->link
)
159 if (!strcmp (md
->module_name
, module_name
))
161 md
->init_func
= init_func
;
165 md
= (struct moddata
*) malloc (sizeof (struct moddata
));
169 "guile: can't register module (%s): not enough memory",
174 md
->module_name
= module_name
;
175 md
->init_func
= init_func
;
176 md
->link
= registered_mods
;
177 registered_mods
= md
;
180 SCM_DEFINE (scm_registered_modules
, "c-registered-modules", 0, 0, 0,
182 "Return a list of the object code modules that have been imported into\n"
183 "the current Guile process. Each element of the list is a pair whose\n"
184 "car is the name of the module, and whose cdr is the function handle\n"
185 "for that module's initializer function. The name is the string that\n"
186 "has been passed to scm_register_module_xxx.")
187 #define FUNC_NAME s_scm_registered_modules
193 for (md
= registered_mods
; md
; md
= md
->link
)
194 res
= scm_cons (scm_cons (scm_from_locale_string (md
->module_name
),
195 scm_from_ulong ((unsigned long) md
->init_func
)),
201 SCM_DEFINE (scm_clear_registered_modules
, "c-clear-registered-modules", 0, 0, 0,
203 "Destroy the list of modules registered with the current Guile process.\n"
204 "The return value is unspecified. @strong{Warning:} this function does\n"
205 "not actually unlink or deallocate these modules, but only destroys the\n"
206 "records of which modules have been loaded. It should therefore be used\n"
207 "only by module bookkeeping operations.")
208 #define FUNC_NAME s_scm_clear_registered_modules
210 struct moddata
*md1
, *md2
;
212 SCM_CRITICAL_SECTION_START
;
214 for (md1
= registered_mods
; md1
; md1
= md2
)
219 registered_mods
= NULL
;
221 SCM_CRITICAL_SECTION_END
;
222 return SCM_UNSPECIFIED
;
227 scm_remember (SCM
*ptr
)
229 scm_c_issue_deprecation_warning ("`scm_remember' is deprecated. "
230 "Use the `scm_remember_upto_here*' family of functions instead.");
234 scm_protect_object (SCM obj
)
236 scm_c_issue_deprecation_warning ("`scm_protect_object' is deprecated. "
237 "Use `scm_gc_protect_object' instead.");
238 return scm_gc_protect_object (obj
);
242 scm_unprotect_object (SCM obj
)
244 scm_c_issue_deprecation_warning ("`scm_unprotect_object' is deprecated. "
245 "Use `scm_gc_unprotect_object' instead.");
246 return scm_gc_unprotect_object (obj
);
249 SCM_SYMBOL (scm_sym_app
, "app");
250 SCM_SYMBOL (scm_sym_modules
, "modules");
251 static SCM module_prefix
= SCM_BOOL_F
;
252 static SCM make_modules_in_var
;
253 static SCM beautify_user_module_x_var
;
254 static SCM try_module_autoload_var
;
259 #define PERM(x) scm_permanent_object(x)
261 if (module_prefix
== SCM_BOOL_F
)
263 module_prefix
= PERM (scm_list_2 (scm_sym_app
, scm_sym_modules
));
264 make_modules_in_var
= PERM (scm_c_lookup ("make-modules-in"));
265 beautify_user_module_x_var
=
266 PERM (scm_c_lookup ("beautify-user-module!"));
267 try_module_autoload_var
= PERM (scm_c_lookup ("try-module-autoload"));
272 scm_the_root_module ()
274 init_module_stuff ();
275 scm_c_issue_deprecation_warning ("`scm_the_root_module' is deprecated. "
276 "Use `scm_c_resolve_module (\"guile\")' "
279 return scm_c_resolve_module ("guile");
283 scm_module_full_name (SCM name
)
285 init_module_stuff ();
286 if (scm_is_eq (SCM_CAR (name
), scm_sym_app
))
289 return scm_append (scm_list_2 (module_prefix
, name
));
293 scm_make_module (SCM name
)
295 init_module_stuff ();
296 scm_c_issue_deprecation_warning ("`scm_make_module' is deprecated. "
297 "Use `scm_c_define_module instead.");
299 return scm_call_2 (SCM_VARIABLE_REF (make_modules_in_var
),
300 scm_the_root_module (),
301 scm_module_full_name (name
));
305 scm_ensure_user_module (SCM module
)
307 init_module_stuff ();
308 scm_c_issue_deprecation_warning ("`scm_ensure_user_module' is deprecated. "
309 "Use `scm_c_define_module instead.");
311 scm_call_1 (SCM_VARIABLE_REF (beautify_user_module_x_var
), module
);
312 return SCM_UNSPECIFIED
;
316 scm_load_scheme_module (SCM name
)
318 init_module_stuff ();
319 scm_c_issue_deprecation_warning ("`scm_load_scheme_module' is deprecated. "
320 "Use `scm_c_resolve_module instead.");
322 return scm_call_1 (SCM_VARIABLE_REF (try_module_autoload_var
), name
);
325 /* This is implemented in C solely for SCM_COERCE_OUTPORT ... */
328 maybe_close_port (void *data
, SCM port
)
330 SCM except_set
= (SCM
) data
;
332 while (!scm_is_null (except_set
))
334 SCM p
= SCM_COERCE_OUTPORT (SCM_CAR (except_set
));
335 if (scm_is_eq (p
, port
))
337 except_set
= SCM_CDR (except_set
);
340 scm_close_port (port
);
343 SCM_DEFINE (scm_close_all_ports_except
, "close-all-ports-except", 0, 0, 1,
345 "[DEPRECATED] Close all open file ports used by the interpreter\n"
346 "except for those supplied as arguments. This procedure\n"
347 "was intended to be used before an exec call to close file descriptors\n"
348 "which are not needed in the new process. However it has the\n"
349 "undesirable side effect of flushing buffers, so it's deprecated.\n"
350 "Use port-for-each instead.")
351 #define FUNC_NAME s_scm_close_all_ports_except
354 SCM_VALIDATE_REST_ARGUMENT (ports
);
356 for (p
= ports
; !scm_is_null (p
); p
= SCM_CDR (p
))
357 SCM_VALIDATE_OPPORT (SCM_ARG1
, SCM_COERCE_OUTPORT (SCM_CAR (p
)));
359 scm_c_port_for_each (maybe_close_port
, ports
);
361 return SCM_UNSPECIFIED
;
365 SCM_DEFINE (scm_variable_set_name_hint
, "variable-set-name-hint!", 2, 0, 0,
367 "Do not use this function.")
368 #define FUNC_NAME s_scm_variable_set_name_hint
370 SCM_VALIDATE_VARIABLE (1, var
);
371 SCM_VALIDATE_SYMBOL (2, hint
);
372 scm_c_issue_deprecation_warning
373 ("'variable-set-name-hint!' is deprecated. Do not use it.");
374 return SCM_UNSPECIFIED
;
378 SCM_DEFINE (scm_builtin_variable
, "builtin-variable", 1, 0, 0,
380 "Do not use this function.")
381 #define FUNC_NAME s_scm_builtin_variable
383 SCM_VALIDATE_SYMBOL (1,name
);
384 scm_c_issue_deprecation_warning ("`builtin-variable' is deprecated. "
385 "Use module system operations instead.");
386 return scm_sym2var (name
, SCM_BOOL_F
, SCM_BOOL_T
);
391 scm_makstr (size_t len
, int dummy
)
393 scm_c_issue_deprecation_warning
394 ("'scm_makstr' is deprecated. Use 'scm_c_make_string' instead.");
395 return scm_c_make_string (len
, SCM_UNDEFINED
);
399 scm_makfromstr (const char *src
, size_t len
, int dummy SCM_UNUSED
)
401 scm_c_issue_deprecation_warning ("`scm_makfromstr' is deprecated. "
402 "Use `scm_from_locale_stringn' instead.");
404 return scm_from_locale_stringn (src
, len
);
408 scm_internal_with_fluids (SCM fluids
, SCM values
, SCM (*cproc
) (), void *cdata
)
410 scm_c_issue_deprecation_warning ("`scm_internal_with_fluids' is deprecated. "
411 "Use `scm_c_with_fluids' instead.");
413 return scm_c_with_fluids (fluids
, values
, cproc
, cdata
);
417 scm_make_gsubr (const char *name
, int req
, int opt
, int rst
, SCM (*fcn
)())
419 scm_c_issue_deprecation_warning
420 ("`scm_make_gsubr' is deprecated. Use `scm_c_define_gsubr' instead.");
422 return scm_c_define_gsubr (name
, req
, opt
, rst
, fcn
);
426 scm_make_gsubr_with_generic (const char *name
,
427 int req
, int opt
, int rst
,
428 SCM (*fcn
)(), SCM
*gf
)
430 scm_c_issue_deprecation_warning
431 ("`scm_make_gsubr_with_generic' is deprecated. "
432 "Use `scm_c_define_gsubr_with_generic' instead.");
434 return scm_c_define_gsubr_with_generic (name
, req
, opt
, rst
, fcn
, gf
);
438 scm_create_hook (const char *name
, int n_args
)
440 scm_c_issue_deprecation_warning
441 ("'scm_create_hook' is deprecated. "
442 "Use 'scm_make_hook' and 'scm_c_define' instead.");
444 SCM hook
= scm_make_hook (scm_from_int (n_args
));
445 scm_c_define (name
, hook
);
446 return scm_permanent_object (hook
);
450 SCM_DEFINE (scm_sloppy_memq
, "sloppy-memq", 2, 0, 0,
452 "This procedure behaves like @code{memq}, but does no type or error checking.\n"
453 "Its use is recommended only in writing Guile internals,\n"
454 "not for high-level Scheme programs.")
455 #define FUNC_NAME s_scm_sloppy_memq
457 scm_c_issue_deprecation_warning
458 ("'sloppy-memq' is deprecated. Use 'memq' instead.");
460 for(; scm_is_pair (lst
); lst
= SCM_CDR(lst
))
462 if (scm_is_eq (SCM_CAR (lst
), x
))
470 SCM_DEFINE (scm_sloppy_memv
, "sloppy-memv", 2, 0, 0,
472 "This procedure behaves like @code{memv}, but does no type or error checking.\n"
473 "Its use is recommended only in writing Guile internals,\n"
474 "not for high-level Scheme programs.")
475 #define FUNC_NAME s_scm_sloppy_memv
477 scm_c_issue_deprecation_warning
478 ("'sloppy-memv' is deprecated. Use 'memv' instead.");
480 for(; scm_is_pair (lst
); lst
= SCM_CDR(lst
))
482 if (! scm_is_false (scm_eqv_p (SCM_CAR (lst
), x
)))
490 SCM_DEFINE (scm_sloppy_member
, "sloppy-member", 2, 0, 0,
492 "This procedure behaves like @code{member}, but does no type or error checking.\n"
493 "Its use is recommended only in writing Guile internals,\n"
494 "not for high-level Scheme programs.")
495 #define FUNC_NAME s_scm_sloppy_member
497 scm_c_issue_deprecation_warning
498 ("'sloppy-member' is deprecated. Use 'member' instead.");
500 for(; scm_is_pair (lst
); lst
= SCM_CDR(lst
))
502 if (! scm_is_false (scm_equal_p (SCM_CAR (lst
), x
)))
509 SCM_SYMBOL (scm_end_of_file_key
, "end-of-file");
511 SCM_DEFINE (scm_read_and_eval_x
, "read-and-eval!", 0, 1, 0,
513 "Read a form from @var{port} (standard input by default), and evaluate it\n"
514 "(memoizing it in the process) in the top-level environment. If no data\n"
515 "is left to be read from @var{port}, an @code{end-of-file} error is\n"
517 #define FUNC_NAME s_scm_read_and_eval_x
521 scm_c_issue_deprecation_warning
522 ("'read-and-eval!' is deprecated. Use 'read' and 'eval' instead.");
524 form
= scm_read (port
);
525 if (SCM_EOF_OBJECT_P (form
))
526 scm_ithrow (scm_end_of_file_key
, SCM_EOL
, 1);
527 return scm_eval_x (form
, scm_current_module ());
532 scm_make_subr_opt (const char *name
, int type
, SCM (*fcn
) (), int set
)
534 scm_c_issue_deprecation_warning
535 ("`scm_make_subr_opt' is deprecated. Use `scm_c_make_subr' or "
536 "`scm_c_define_subr' instead.");
539 return scm_c_define_subr (name
, type
, fcn
);
541 return scm_c_make_subr (name
, type
, fcn
);
545 scm_make_subr (const char *name
, int type
, SCM (*fcn
) ())
547 scm_c_issue_deprecation_warning
548 ("`scm_make_subr' is deprecated. Use `scm_c_define_subr' instead.");
550 return scm_c_define_subr (name
, type
, fcn
);
554 scm_make_subr_with_generic (const char *name
, int type
, SCM (*fcn
) (), SCM
*gf
)
556 scm_c_issue_deprecation_warning
557 ("`scm_make_subr_with_generic' is deprecated. Use "
558 "`scm_c_define_subr_with_generic' instead.");
560 return scm_c_define_subr_with_generic (name
, type
, fcn
, gf
);
563 /* Call thunk(closure) underneath a top-level error handler.
564 * If an error occurs, pass the exitval through err_filter and return it.
565 * If no error occurs, return the value of thunk.
569 typedef int setjmp_type
;
571 typedef long setjmp_type
;
574 struct cce_handler_data
{
575 SCM (*err_filter
) ();
580 invoke_err_filter (void *d
, SCM tag
, SCM args
)
582 struct cce_handler_data
*data
= (struct cce_handler_data
*)d
;
583 return data
->err_filter (SCM_BOOL_F
, data
->closure
);
587 scm_call_catching_errors (SCM (*thunk
)(), SCM (*err_filter
)(), void *closure
)
589 scm_c_issue_deprecation_warning
590 ("'scm_call_catching_errors' is deprecated. "
591 "Use 'scm_internal_catch' instead.");
594 struct cce_handler_data data
;
595 data
.err_filter
= err_filter
;
596 data
.closure
= closure
;
597 return scm_internal_catch (SCM_BOOL_T
,
598 (scm_t_catch_body
)thunk
, closure
,
599 (scm_t_catch_handler
)invoke_err_filter
, &data
);
604 scm_make_smob_type_mfpe (char *name
, size_t size
,
606 size_t (*free
) (SCM
),
607 int (*print
) (SCM
, SCM
, scm_print_state
*),
608 SCM (*equalp
) (SCM
, SCM
))
610 scm_c_issue_deprecation_warning
611 ("'scm_make_smob_type_mfpe' is deprecated. "
612 "Use 'scm_make_smob_type' plus 'scm_set_smob_*' instead.");
615 long answer
= scm_make_smob_type (name
, size
);
616 scm_set_smob_mfpe (answer
, mark
, free
, print
, equalp
);
622 scm_set_smob_mfpe (long tc
,
624 size_t (*free
) (SCM
),
625 int (*print
) (SCM
, SCM
, scm_print_state
*),
626 SCM (*equalp
) (SCM
, SCM
))
628 scm_c_issue_deprecation_warning
629 ("'scm_set_smob_mfpe' is deprecated. "
630 "Use 'scm_set_smob_mark' instead, for example.");
632 if (mark
) scm_set_smob_mark (tc
, mark
);
633 if (free
) scm_set_smob_free (tc
, free
);
634 if (print
) scm_set_smob_print (tc
, print
);
635 if (equalp
) scm_set_smob_equalp (tc
, equalp
);
639 scm_smob_free (SCM obj
)
641 long n
= SCM_SMOBNUM (obj
);
643 scm_c_issue_deprecation_warning
644 ("`scm_smob_free' is deprecated. "
645 "It is no longer needed.");
647 if (scm_smobs
[n
].size
> 0)
648 scm_gc_free ((void *) SCM_CELL_WORD_1 (obj
),
649 scm_smobs
[n
].size
, SCM_SMOBNAME (n
));
654 scm_read_0str (char *expr
)
656 scm_c_issue_deprecation_warning
657 ("scm_read_0str is deprecated. Use scm_c_read_string instead.");
659 return scm_c_read_string (expr
);
663 scm_eval_0str (const char *expr
)
665 scm_c_issue_deprecation_warning
666 ("scm_eval_0str is deprecated. Use scm_c_eval_string instead.");
668 return scm_c_eval_string (expr
);
672 scm_strprint_obj (SCM obj
)
674 scm_c_issue_deprecation_warning
675 ("scm_strprint_obj is deprecated. Use scm_object_to_string instead.");
676 return scm_object_to_string (obj
, SCM_UNDEFINED
);
680 scm_i_object_chars (SCM obj
)
682 scm_c_issue_deprecation_warning
683 ("SCM_CHARS is deprecated. See the manual for alternatives.");
684 if (SCM_STRINGP (obj
))
685 return SCM_STRING_CHARS (obj
);
686 if (SCM_SYMBOLP (obj
))
687 return SCM_SYMBOL_CHARS (obj
);
692 scm_i_object_length (SCM obj
)
694 scm_c_issue_deprecation_warning
695 ("SCM_LENGTH is deprecated. "
696 "Use scm_c_string_length instead, for example, or see the manual.");
697 if (SCM_STRINGP (obj
))
698 return SCM_STRING_LENGTH (obj
);
699 if (SCM_SYMBOLP (obj
))
700 return SCM_SYMBOL_LENGTH (obj
);
701 if (SCM_VECTORP (obj
))
702 return SCM_VECTOR_LENGTH (obj
);
707 scm_sym2ovcell_soft (SCM sym
, SCM obarray
)
710 size_t hash
= scm_i_symbol_hash (sym
) % SCM_VECTOR_LENGTH (obarray
);
712 scm_c_issue_deprecation_warning ("`scm_sym2ovcell_soft' is deprecated. "
713 "Use hashtables instead.");
715 SCM_CRITICAL_SECTION_START
;
716 for (lsym
= SCM_VECTOR_REF (obarray
, hash
);
718 lsym
= SCM_CDR (lsym
))
721 if (scm_is_eq (SCM_CAR (z
), sym
))
723 SCM_CRITICAL_SECTION_END
;
727 SCM_CRITICAL_SECTION_END
;
733 scm_sym2ovcell (SCM sym
, SCM obarray
)
734 #define FUNC_NAME "scm_sym2ovcell"
738 scm_c_issue_deprecation_warning ("`scm_sym2ovcell' is deprecated. "
739 "Use hashtables instead.");
741 answer
= scm_sym2ovcell_soft (sym
, obarray
);
742 if (scm_is_true (answer
))
744 SCM_MISC_ERROR ("uninterned symbol: ~S", scm_list_1 (sym
));
745 return SCM_UNSPECIFIED
; /* not reached */
750 /* Intern a symbol whose name is the LEN characters at NAME in OBARRAY.
752 OBARRAY should be a vector of lists, indexed by the name's hash
753 value, modulo OBARRAY's length. Each list has the form
754 ((SYMBOL . VALUE) ...), where SYMBOL is a symbol, and VALUE is the
755 value associated with that symbol (in the current module? in the
758 To "intern" a symbol means: if OBARRAY already contains a symbol by
759 that name, return its (SYMBOL . VALUE) pair; otherwise, create a
760 new symbol, add the pair (SYMBOL . SCM_UNDEFINED) to the
761 appropriate list of the OBARRAY, and return the pair.
763 If softness is non-zero, don't create a symbol if it isn't already
764 in OBARRAY; instead, just return #f.
766 If OBARRAY is SCM_BOOL_F, create a symbol listed in no obarray and
767 return (SYMBOL . SCM_UNDEFINED). */
771 intern_obarray_soft (SCM symbol
, SCM obarray
, unsigned int softness
)
773 size_t raw_hash
= scm_i_symbol_hash (symbol
);
777 if (scm_is_false (obarray
))
782 return scm_cons (symbol
, SCM_UNDEFINED
);
785 hash
= raw_hash
% SCM_VECTOR_LENGTH (obarray
);
787 for (lsym
= SCM_VECTOR_REF(obarray
, hash
);
788 SCM_NIMP (lsym
); lsym
= SCM_CDR (lsym
))
790 SCM a
= SCM_CAR (lsym
);
792 if (scm_is_eq (z
, symbol
))
802 SCM cell
= scm_cons (symbol
, SCM_UNDEFINED
);
803 SCM slot
= SCM_VECTOR_REF (obarray
, hash
);
805 SCM_VECTOR_SET (obarray
, hash
, scm_cons (cell
, slot
));
813 scm_intern_obarray_soft (const char *name
, size_t len
, SCM obarray
,
814 unsigned int softness
)
816 SCM symbol
= scm_from_locale_symboln (name
, len
);
818 scm_c_issue_deprecation_warning ("`scm_intern_obarray_soft' is deprecated. "
819 "Use hashtables instead.");
821 return intern_obarray_soft (symbol
, obarray
, softness
);
825 scm_intern_obarray (const char *name
,size_t len
,SCM obarray
)
827 scm_c_issue_deprecation_warning ("`scm_intern_obarray' is deprecated. "
828 "Use hashtables instead.");
830 return scm_intern_obarray_soft (name
, len
, obarray
, 0);
833 /* Lookup the value of the symbol named by the nul-terminated string
834 NAME in the current module. */
836 scm_symbol_value0 (const char *name
)
838 scm_c_issue_deprecation_warning ("`scm_symbol_value0' is deprecated. "
839 "Use `scm_lookup' instead.");
841 return scm_variable_ref (scm_c_lookup (name
));
844 SCM_DEFINE (scm_string_to_obarray_symbol
, "string->obarray-symbol", 2, 1, 0,
845 (SCM o
, SCM s
, SCM softp
),
846 "Intern a new symbol in @var{obarray}, a symbol table, with name\n"
848 "If @var{obarray} is @code{#f}, use the default system symbol table. If\n"
849 "@var{obarray} is @code{#t}, the symbol should not be interned in any\n"
850 "symbol table; merely return the pair (@var{symbol}\n"
851 ". @var{#<undefined>}).\n\n"
852 "The @var{soft?} argument determines whether new symbol table entries\n"
853 "should be created when the specified symbol is not already present in\n"
854 "@var{obarray}. If @var{soft?} is specified and is a true value, then\n"
855 "new entries should not be added for symbols not already present in the\n"
856 "table; instead, simply return @code{#f}.")
857 #define FUNC_NAME s_scm_string_to_obarray_symbol
863 SCM_VALIDATE_STRING (2, s
);
864 SCM_ASSERT (scm_is_bool (o
) || SCM_VECTORP (o
), o
, SCM_ARG1
, FUNC_NAME
);
866 scm_c_issue_deprecation_warning ("`string->obarray-symbol' is deprecated. "
867 "Use hashtables instead.");
869 softness
= (!SCM_UNBNDP (softp
) && scm_is_true(softp
));
870 /* iron out some screwy calling conventions */
871 if (scm_is_false (o
))
873 /* nothing interesting to do here. */
874 return scm_string_to_symbol (s
);
876 else if (scm_is_eq (o
, SCM_BOOL_T
))
879 vcell
= intern_obarray_soft (scm_string_to_symbol (s
), o
, softness
);
880 if (scm_is_false (vcell
))
882 answer
= SCM_CAR (vcell
);
887 SCM_DEFINE (scm_intern_symbol
, "intern-symbol", 2, 0, 0,
889 "Add a new symbol to @var{obarray} with name @var{string}, bound to an\n"
890 "unspecified initial value. The symbol table is not modified if a symbol\n"
891 "with this name is already present.")
892 #define FUNC_NAME s_scm_intern_symbol
895 SCM_VALIDATE_SYMBOL (2,s
);
896 if (scm_is_false (o
))
897 return SCM_UNSPECIFIED
;
899 scm_c_issue_deprecation_warning ("`intern-symbol' is deprecated. "
900 "Use hashtables instead.");
902 SCM_VALIDATE_VECTOR (1,o
);
903 hval
= scm_i_symbol_hash (s
) % SCM_VECTOR_LENGTH (o
);
904 /* If the symbol is already interned, simply return. */
905 SCM_CRITICAL_SECTION_START
;
909 for (lsym
= SCM_VECTOR_REF (o
, hval
);
911 lsym
= SCM_CDR (lsym
))
913 sym
= SCM_CAR (lsym
);
914 if (scm_is_eq (SCM_CAR (sym
), s
))
916 SCM_CRITICAL_SECTION_END
;
917 return SCM_UNSPECIFIED
;
920 SCM_VECTOR_SET (o
, hval
,
921 scm_acons (s
, SCM_UNDEFINED
,
922 SCM_VECTOR_REF (o
, hval
)));
924 SCM_CRITICAL_SECTION_END
;
925 return SCM_UNSPECIFIED
;
929 SCM_DEFINE (scm_unintern_symbol
, "unintern-symbol", 2, 0, 0,
931 "Remove the symbol with name @var{string} from @var{obarray}. This\n"
932 "function returns @code{#t} if the symbol was present and @code{#f}\n"
934 #define FUNC_NAME s_scm_unintern_symbol
938 scm_c_issue_deprecation_warning ("`unintern-symbol' is deprecated. "
939 "Use hashtables instead.");
941 SCM_VALIDATE_SYMBOL (2,s
);
942 if (scm_is_false (o
))
944 SCM_VALIDATE_VECTOR (1,o
);
945 hval
= scm_i_symbol_hash (s
) % SCM_VECTOR_LENGTH (o
);
946 SCM_CRITICAL_SECTION_START
;
951 for (lsym
= SCM_VECTOR_REF (o
, hval
), lsym_follow
= SCM_BOOL_F
;
953 lsym_follow
= lsym
, lsym
= SCM_CDR (lsym
))
955 sym
= SCM_CAR (lsym
);
956 if (scm_is_eq (SCM_CAR (sym
), s
))
958 /* Found the symbol to unintern. */
959 if (scm_is_false (lsym_follow
))
960 SCM_VECTOR_SET (o
, hval
, lsym
);
962 SCM_SETCDR (lsym_follow
, SCM_CDR(lsym
));
963 SCM_CRITICAL_SECTION_END
;
968 SCM_CRITICAL_SECTION_END
;
973 SCM_DEFINE (scm_symbol_binding
, "symbol-binding", 2, 0, 0,
975 "Look up in @var{obarray} the symbol whose name is @var{string}, and\n"
976 "return the value to which it is bound. If @var{obarray} is @code{#f},\n"
977 "use the global symbol table. If @var{string} is not interned in\n"
978 "@var{obarray}, an error is signalled.")
979 #define FUNC_NAME s_scm_symbol_binding
983 scm_c_issue_deprecation_warning ("`symbol-binding' is deprecated. "
984 "Use hashtables instead.");
986 SCM_VALIDATE_SYMBOL (2,s
);
987 if (scm_is_false (o
))
988 return scm_variable_ref (scm_lookup (s
));
989 SCM_VALIDATE_VECTOR (1,o
);
990 vcell
= scm_sym2ovcell (s
, o
);
991 return SCM_CDR(vcell
);
996 SCM_DEFINE (scm_symbol_interned_p
, "symbol-interned?", 2, 0, 0,
998 "Return @code{#t} if @var{obarray} contains a symbol with name\n"
999 "@var{string}, and @code{#f} otherwise.")
1000 #define FUNC_NAME s_scm_symbol_interned_p
1004 scm_c_issue_deprecation_warning ("`symbol-interned?' is deprecated. "
1005 "Use hashtables instead.");
1007 SCM_VALIDATE_SYMBOL (2,s
);
1008 if (scm_is_false (o
))
1010 SCM var
= scm_sym2var (s
, SCM_BOOL_F
, SCM_BOOL_F
);
1011 if (var
!= SCM_BOOL_F
)
1015 SCM_VALIDATE_VECTOR (1,o
);
1016 vcell
= scm_sym2ovcell_soft (s
, o
);
1017 return (SCM_NIMP(vcell
)
1024 SCM_DEFINE (scm_symbol_bound_p
, "symbol-bound?", 2, 0, 0,
1026 "Return @code{#t} if @var{obarray} contains a symbol with name\n"
1027 "@var{string} bound to a defined value. This differs from\n"
1028 "@var{symbol-interned?} in that the mere mention of a symbol\n"
1029 "usually causes it to be interned; @code{symbol-bound?}\n"
1030 "determines whether a symbol has been given any meaningful\n"
1032 #define FUNC_NAME s_scm_symbol_bound_p
1036 scm_c_issue_deprecation_warning ("`symbol-bound?' is deprecated. "
1037 "Use hashtables instead.");
1039 SCM_VALIDATE_SYMBOL (2,s
);
1040 if (scm_is_false (o
))
1042 SCM var
= scm_sym2var (s
, SCM_BOOL_F
, SCM_BOOL_F
);
1043 if (SCM_VARIABLEP(var
) && !SCM_UNBNDP(SCM_VARIABLE_REF(var
)))
1047 SCM_VALIDATE_VECTOR (1,o
);
1048 vcell
= scm_sym2ovcell_soft (s
, o
);
1049 return scm_from_bool (SCM_NIMP (vcell
) && !SCM_UNBNDP (SCM_CDR (vcell
)));
1054 SCM_DEFINE (scm_symbol_set_x
, "symbol-set!", 3, 0, 0,
1055 (SCM o
, SCM s
, SCM v
),
1056 "Find the symbol in @var{obarray} whose name is @var{string}, and rebind\n"
1057 "it to @var{value}. An error is signalled if @var{string} is not present\n"
1058 "in @var{obarray}.")
1059 #define FUNC_NAME s_scm_symbol_set_x
1063 scm_c_issue_deprecation_warning ("`symbol-set!' is deprecated. "
1064 "Use the module system instead.");
1066 SCM_VALIDATE_SYMBOL (2,s
);
1067 if (scm_is_false (o
))
1070 return SCM_UNSPECIFIED
;
1072 SCM_VALIDATE_VECTOR (1,o
);
1073 vcell
= scm_sym2ovcell (s
, o
);
1074 SCM_SETCDR (vcell
, v
);
1075 return SCM_UNSPECIFIED
;
1079 #define MAX_PREFIX_LENGTH 30
1081 static int gentemp_counter
;
1083 SCM_DEFINE (scm_gentemp
, "gentemp", 0, 2, 0,
1084 (SCM prefix
, SCM obarray
),
1085 "Create a new symbol with a name unique in an obarray.\n"
1086 "The name is constructed from an optional string @var{prefix}\n"
1087 "and a counter value. The default prefix is @code{t}. The\n"
1088 "@var{obarray} is specified as a second optional argument.\n"
1089 "Default is the system obarray where all normal symbols are\n"
1090 "interned. The counter is increased by 1 at each\n"
1091 "call. There is no provision for resetting the counter.")
1092 #define FUNC_NAME s_scm_gentemp
1094 char buf
[MAX_PREFIX_LENGTH
+ SCM_INTBUFLEN
];
1099 scm_c_issue_deprecation_warning ("`gentemp' is deprecated. "
1100 "Use `gensym' instead.");
1102 if (SCM_UNBNDP (prefix
))
1109 SCM_VALIDATE_STRING (1, prefix
);
1110 len
= scm_i_string_length (prefix
);
1111 name
= scm_to_locale_stringn (prefix
, &len
);
1112 name
= scm_realloc (name
, len
+ SCM_INTBUFLEN
);
1115 if (SCM_UNBNDP (obarray
))
1116 return scm_gensym (prefix
);
1118 SCM_ASSERT ((scm_is_vector (obarray
) || SCM_I_WVECTP (obarray
)),
1123 n_digits
= scm_iint2str (gentemp_counter
++, 10, &name
[len
]);
1124 while (scm_is_true (scm_intern_obarray_soft (name
,
1129 SCM vcell
= scm_intern_obarray_soft (name
,
1135 return SCM_CAR (vcell
);
1141 scm_i_makinum (scm_t_signed_bits val
)
1143 scm_c_issue_deprecation_warning
1144 ("SCM_MAKINUM is deprecated. Use scm_from_int or similar instead.");
1145 return SCM_I_MAKINUM (val
);
1149 scm_i_inump (SCM obj
)
1151 scm_c_issue_deprecation_warning
1152 ("SCM_INUMP is deprecated. Use scm_is_integer or similar instead.");
1153 return SCM_I_INUMP (obj
);
1157 scm_i_inum (SCM obj
)
1159 scm_c_issue_deprecation_warning
1160 ("SCM_INUM is deprecated. Use scm_to_int or similar instead.");
1161 return scm_to_intmax (obj
);
1165 scm_c_string2str (SCM obj
, char *str
, size_t *lenp
)
1167 scm_c_issue_deprecation_warning
1168 ("scm_c_string2str is deprecated. Use scm_to_locale_stringbuf or similar instead.");
1172 char *result
= scm_to_locale_string (obj
);
1174 *lenp
= scm_i_string_length (obj
);
1179 /* Pray that STR is large enough.
1181 size_t len
= scm_to_locale_stringbuf (obj
, str
, SCM_I_SIZE_MAX
);
1190 scm_c_substring2str (SCM obj
, char *str
, size_t start
, size_t len
)
1192 scm_c_issue_deprecation_warning
1193 ("scm_c_substring2str is deprecated. Use scm_substring plus scm_to_locale_stringbuf instead.");
1196 obj
= scm_substring (obj
, scm_from_size_t (start
), SCM_UNDEFINED
);
1198 scm_to_locale_stringbuf (obj
, str
, len
);
1202 /* Converts the given Scheme symbol OBJ into a C string, containing a copy
1203 of OBJ's content with a trailing null byte. If LENP is non-NULL, set
1204 *LENP to the string's length.
1206 When STR is non-NULL it receives the copy and is returned by the function,
1207 otherwise new memory is allocated and the caller is responsible for
1208 freeing it via free(). If out of memory, NULL is returned.
1210 Note that Scheme symbols may contain arbitrary data, including null
1211 characters. This means that null termination is not a reliable way to
1212 determine the length of the returned value. However, the function always
1213 copies the complete contents of OBJ, and sets *LENP to the length of the
1214 scheme symbol (if LENP is non-null). */
1216 scm_c_symbol2str (SCM obj
, char *str
, size_t *lenp
)
1218 return scm_c_string2str (scm_symbol_to_string (obj
), str
, lenp
);
1222 scm_truncate (double x
)
1224 scm_c_issue_deprecation_warning
1225 ("scm_truncate is deprecated. Use scm_c_truncate instead.");
1226 return scm_c_truncate (x
);
1230 scm_round (double x
)
1232 scm_c_issue_deprecation_warning
1233 ("scm_round is deprecated. Use scm_c_round instead.");
1234 return scm_c_round (x
);
1238 scm_i_deprecated_symbol_chars (SCM sym
)
1240 scm_c_issue_deprecation_warning
1241 ("SCM_SYMBOL_CHARS is deprecated. Use scm_symbol_to_string.");
1243 return (char *)scm_i_symbol_chars (sym
);
1247 scm_i_deprecated_symbol_length (SCM sym
)
1249 scm_c_issue_deprecation_warning
1250 ("SCM_SYMBOL_LENGTH is deprecated. Use scm_symbol_to_string.");
1251 return scm_i_symbol_length (sym
);
1255 scm_i_keywordp (SCM obj
)
1257 scm_c_issue_deprecation_warning
1258 ("SCM_KEYWORDP is deprecated. Use scm_is_keyword instead.");
1259 return scm_is_keyword (obj
);
1263 scm_i_keywordsym (SCM keyword
)
1265 scm_c_issue_deprecation_warning
1266 ("SCM_KEYWORDSYM is deprecated. See scm_keyword_to_symbol instead.");
1267 return scm_keyword_dash_symbol (keyword
);
1271 scm_i_vectorp (SCM x
)
1273 scm_c_issue_deprecation_warning
1274 ("SCM_VECTORP is deprecated. Use scm_is_vector instead.");
1275 return SCM_I_IS_VECTOR (x
);
1279 scm_i_vector_length (SCM x
)
1281 scm_c_issue_deprecation_warning
1282 ("SCM_VECTOR_LENGTH is deprecated. Use scm_c_vector_length instead.");
1283 return SCM_I_VECTOR_LENGTH (x
);
1289 scm_c_issue_deprecation_warning
1290 ("SCM_VELTS is deprecated. Use scm_vector_elements instead.");
1291 return SCM_I_VECTOR_ELTS (x
);
1295 scm_i_writable_velts (SCM x
)
1297 scm_c_issue_deprecation_warning
1298 ("SCM_WRITABLE_VELTS is deprecated. "
1299 "Use scm_vector_writable_elements instead.");
1300 return SCM_I_VECTOR_WELTS (x
);
1304 scm_i_vector_ref (SCM x
, size_t idx
)
1306 scm_c_issue_deprecation_warning
1307 ("SCM_VECTOR_REF is deprecated. "
1308 "Use scm_c_vector_ref or scm_vector_elements instead.");
1309 return scm_c_vector_ref (x
, idx
);
1313 scm_i_vector_set (SCM x
, size_t idx
, SCM val
)
1315 scm_c_issue_deprecation_warning
1316 ("SCM_VECTOR_SET is deprecated. "
1317 "Use scm_c_vector_set_x or scm_vector_writable_elements instead.");
1318 scm_c_vector_set_x (x
, idx
, val
);
1322 scm_vector_equal_p (SCM x
, SCM y
)
1324 scm_c_issue_deprecation_warning
1325 ("scm_vector_euqal_p is deprecated. "
1326 "Use scm_equal_p instead.");
1327 return scm_equal_p (x
, y
);
1331 scm_i_arrayp (SCM a
)
1333 scm_c_issue_deprecation_warning
1334 ("SCM_ARRAYP is deprecated. Use scm_is_array instead.");
1335 return SCM_I_ARRAYP(a
);
1339 scm_i_array_ndim (SCM a
)
1341 scm_c_issue_deprecation_warning
1342 ("SCM_ARRAY_NDIM is deprecated. "
1343 "Use scm_c_array_rank or scm_array_handle_rank instead.");
1344 return scm_c_array_rank (a
);
1348 scm_i_array_contp (SCM a
)
1350 scm_c_issue_deprecation_warning
1351 ("SCM_ARRAY_CONTP is deprecated. Do not use it.");
1352 return SCM_I_ARRAY_CONTP (a
);
1356 scm_i_array_mem (SCM a
)
1358 scm_c_issue_deprecation_warning
1359 ("SCM_ARRAY_MEM is deprecated. Do not use it.");
1360 return (scm_t_array
*)SCM_I_ARRAY_MEM (a
);
1364 scm_i_array_v (SCM a
)
1366 /* We could use scm_shared_array_root here, but it is better to move
1367 them away from expecting vectors as the basic storage for arrays.
1369 scm_c_issue_deprecation_warning
1370 ("SCM_ARRAY_V is deprecated. Do not use it.");
1371 return SCM_I_ARRAY_V (a
);
1375 scm_i_array_base (SCM a
)
1377 scm_c_issue_deprecation_warning
1378 ("SCM_ARRAY_BASE is deprecated. Do not use it.");
1379 return SCM_I_ARRAY_BASE (a
);
1383 scm_i_array_dims (SCM a
)
1385 scm_c_issue_deprecation_warning
1386 ("SCM_ARRAY_DIMS is deprecated. Use scm_array_handle_dims instead.");
1387 return SCM_I_ARRAY_DIMS (a
);
1391 scm_i_cur_inp (void)
1393 scm_c_issue_deprecation_warning
1394 ("scm_cur_inp is deprecated. Use scm_current_input_port instead.");
1395 return scm_current_input_port ();
1399 scm_i_cur_outp (void)
1401 scm_c_issue_deprecation_warning
1402 ("scm_cur_outp is deprecated. Use scm_current_output_port instead.");
1403 return scm_current_output_port ();
1407 scm_i_cur_errp (void)
1409 scm_c_issue_deprecation_warning
1410 ("scm_cur_errp is deprecated. Use scm_current_error_port instead.");
1411 return scm_current_error_port ();
1415 scm_i_cur_loadp (void)
1417 scm_c_issue_deprecation_warning
1418 ("scm_cur_loadp is deprecated. Use scm_current_load_port instead.");
1419 return scm_current_load_port ();
1423 scm_i_progargs (void)
1425 scm_c_issue_deprecation_warning
1426 ("scm_progargs is deprecated. Use scm_program_arguments instead.");
1427 return scm_program_arguments ();
1431 scm_i_deprecated_dynwinds (void)
1433 scm_c_issue_deprecation_warning
1434 ("scm_dynwinds is deprecated. Do not use it.");
1435 return scm_i_dynwinds ();
1439 scm_i_deprecated_last_debug_frame (void)
1441 scm_c_issue_deprecation_warning
1442 ("scm_last_debug_frame is deprecated. Do not use it.");
1443 return scm_i_last_debug_frame ();
1447 scm_i_stack_base (void)
1449 scm_c_issue_deprecation_warning
1450 ("scm_stack_base is deprecated. Do not use it.");
1451 return SCM_I_CURRENT_THREAD
->base
;
1455 scm_i_fluidp (SCM x
)
1457 scm_c_issue_deprecation_warning
1458 ("SCM_FLUIDP is deprecated. Use scm_is_fluid instead.");
1459 return scm_is_fluid (x
);
1463 scm_i_defer_ints_etc ()
1465 scm_c_issue_deprecation_warning
1466 ("SCM_DEFER_INTS etc are deprecated. "
1467 "Use a mutex instead if appropriate.");
1471 scm_guard (SCM guardian
, SCM obj
, int throw_p
)
1473 scm_c_issue_deprecation_warning
1474 ("scm_guard is deprecated. Use scm_call_1 instead.");
1476 return scm_call_1 (guardian
, obj
);
1480 scm_get_one_zombie (SCM guardian
)
1482 scm_c_issue_deprecation_warning
1483 ("scm_guard is deprecated. Use scm_call_0 instead.");
1485 return scm_call_0 (guardian
);
1488 SCM_DEFINE (scm_guardian_destroyed_p
, "guardian-destroyed?", 1, 0, 0,
1490 "Return @code{#t} if @var{guardian} has been destroyed, otherwise @code{#f}.")
1491 #define FUNC_NAME s_scm_guardian_destroyed_p
1493 scm_c_issue_deprecation_warning
1494 ("'guardian-destroyed?' is deprecated.");
1499 SCM_DEFINE (scm_guardian_greedy_p
, "guardian-greedy?", 1, 0, 0,
1501 "Return @code{#t} if @var{guardian} is a greedy guardian, otherwise @code{#f}.")
1502 #define FUNC_NAME s_scm_guardian_greedy_p
1504 scm_c_issue_deprecation_warning
1505 ("'guardian-greedy?' is deprecated.");
1510 SCM_DEFINE (scm_destroy_guardian_x
, "destroy-guardian!", 1, 0, 0,
1512 "Destroys @var{guardian}, by making it impossible to put any more\n"
1513 "objects in it or get any objects from it. It also unguards any\n"
1514 "objects guarded by @var{guardian}.")
1515 #define FUNC_NAME s_scm_destroy_guardian_x
1517 scm_c_issue_deprecation_warning
1518 ("'destroy-guardian!' is deprecated and ineffective.");
1519 return SCM_UNSPECIFIED
;
1524 /* GC-related things. */
1526 unsigned long scm_mallocated
, scm_mtrigger
;
1527 size_t scm_max_segment_size
;
1529 #if defined (GUILE_DEBUG) || defined (GUILE_DEBUG_FREELIST)
1531 scm_map_free_list (void)
1537 #if defined (GUILE_DEBUG_FREELIST)
1539 scm_gc_set_debug_check_freelist_x (SCM flag
)
1541 return SCM_UNSPECIFIED
;
1547 scm_i_init_deprecated ()
1549 #include "libguile/deprecated.x"