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 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 #include "libguile/_scm.h"
28 #include "libguile/async.h"
29 #include "libguile/deprecated.h"
30 #include "libguile/discouraged.h"
31 #include "libguile/deprecation.h"
32 #include "libguile/snarf.h"
33 #include "libguile/validate.h"
34 #include "libguile/strings.h"
35 #include "libguile/srfi-13.h"
36 #include "libguile/modules.h"
37 #include "libguile/eval.h"
38 #include "libguile/smob.h"
39 #include "libguile/procprop.h"
40 #include "libguile/vectors.h"
41 #include "libguile/hashtab.h"
42 #include "libguile/struct.h"
43 #include "libguile/variable.h"
44 #include "libguile/fluids.h"
45 #include "libguile/ports.h"
46 #include "libguile/eq.h"
47 #include "libguile/read.h"
48 #include "libguile/strports.h"
49 #include "libguile/smob.h"
50 #include "libguile/alist.h"
51 #include "libguile/keywords.h"
52 #include "libguile/feature.h"
57 #if (SCM_ENABLE_DEPRECATED == 1)
59 /* From print.c: Internal symbol names of isyms. Deprecated in guile 1.7.0 on
61 char *scm_isymnames
[] =
67 /* From eval.c: Error messages of the evaluator. These were deprecated in
68 * guile 1.7.0 on 2003-06-02. */
69 const char scm_s_expression
[] = "missing or extra expression";
70 const char scm_s_test
[] = "bad test";
71 const char scm_s_body
[] = "bad body";
72 const char scm_s_bindings
[] = "bad bindings";
73 const char scm_s_variable
[] = "bad variable";
74 const char scm_s_clauses
[] = "bad or missing clauses";
75 const char scm_s_formals
[] = "bad formals";
78 SCM_REGISTER_PROC(s_substring_move_left_x
, "substring-move-left!", 5, 0, 0, scm_substring_move_x
);
80 SCM_REGISTER_PROC(s_substring_move_right_x
, "substring-move-right!", 5, 0, 0, scm_substring_move_x
);
83 scm_wta (SCM arg
, const char *pos
, const char *s_subr
)
85 if (!s_subr
|| !*s_subr
)
87 if ((~0x1fL
) & (long) pos
)
89 /* error string supplied. */
90 scm_misc_error (s_subr
, pos
, scm_list_1 (arg
));
94 /* numerical error code. */
95 scm_t_bits error
= (scm_t_bits
) pos
;
100 scm_wrong_type_arg (s_subr
, 0, arg
);
102 scm_wrong_type_arg (s_subr
, 1, arg
);
104 scm_wrong_type_arg (s_subr
, 2, arg
);
106 scm_wrong_type_arg (s_subr
, 3, arg
);
108 scm_wrong_type_arg (s_subr
, 4, arg
);
110 scm_wrong_type_arg (s_subr
, 5, arg
);
112 scm_wrong_type_arg (s_subr
, 6, arg
);
114 scm_wrong_type_arg (s_subr
, 7, arg
);
116 scm_wrong_num_args (arg
);
118 scm_out_of_range (s_subr
, arg
);
120 scm_memory_error (s_subr
);
122 /* this shouldn't happen. */
123 scm_misc_error (s_subr
, "Unknown error", SCM_EOL
);
126 return SCM_UNSPECIFIED
;
132 /* We can't use SCM objects here. One should be able to call
133 SCM_REGISTER_MODULE from a C++ constructor for a static
134 object. This happens before main and thus before libguile is
138 struct moddata
*link
;
143 static struct moddata
*registered_mods
= NULL
;
146 scm_register_module_xxx (char *module_name
, void *init_func
)
150 scm_c_issue_deprecation_warning
151 ("`scm_register_module_xxx' is deprecated. Use extensions instead.");
153 /* XXX - should we (and can we) DEFER_INTS here? */
155 for (md
= registered_mods
; md
; md
= md
->link
)
156 if (!strcmp (md
->module_name
, module_name
))
158 md
->init_func
= init_func
;
162 md
= (struct moddata
*) malloc (sizeof (struct moddata
));
166 "guile: can't register module (%s): not enough memory",
171 md
->module_name
= module_name
;
172 md
->init_func
= init_func
;
173 md
->link
= registered_mods
;
174 registered_mods
= md
;
177 SCM_DEFINE (scm_registered_modules
, "c-registered-modules", 0, 0, 0,
179 "Return a list of the object code modules that have been imported into\n"
180 "the current Guile process. Each element of the list is a pair whose\n"
181 "car is the name of the module, and whose cdr is the function handle\n"
182 "for that module's initializer function. The name is the string that\n"
183 "has been passed to scm_register_module_xxx.")
184 #define FUNC_NAME s_scm_registered_modules
190 for (md
= registered_mods
; md
; md
= md
->link
)
191 res
= scm_cons (scm_cons (scm_from_locale_string (md
->module_name
),
192 scm_from_ulong ((unsigned long) md
->init_func
)),
198 SCM_DEFINE (scm_clear_registered_modules
, "c-clear-registered-modules", 0, 0, 0,
200 "Destroy the list of modules registered with the current Guile process.\n"
201 "The return value is unspecified. @strong{Warning:} this function does\n"
202 "not actually unlink or deallocate these modules, but only destroys the\n"
203 "records of which modules have been loaded. It should therefore be used\n"
204 "only by module bookkeeping operations.")
205 #define FUNC_NAME s_scm_clear_registered_modules
207 struct moddata
*md1
, *md2
;
209 SCM_CRITICAL_SECTION_START
;
211 for (md1
= registered_mods
; md1
; md1
= md2
)
216 registered_mods
= NULL
;
218 SCM_CRITICAL_SECTION_END
;
219 return SCM_UNSPECIFIED
;
224 scm_remember (SCM
*ptr
)
226 scm_c_issue_deprecation_warning ("`scm_remember' is deprecated. "
227 "Use the `scm_remember_upto_here*' family of functions instead.");
231 scm_protect_object (SCM obj
)
233 scm_c_issue_deprecation_warning ("`scm_protect_object' is deprecated. "
234 "Use `scm_gc_protect_object' instead.");
235 return scm_gc_protect_object (obj
);
239 scm_unprotect_object (SCM obj
)
241 scm_c_issue_deprecation_warning ("`scm_unprotect_object' is deprecated. "
242 "Use `scm_gc_unprotect_object' instead.");
243 return scm_gc_unprotect_object (obj
);
246 SCM_SYMBOL (scm_sym_app
, "app");
247 SCM_SYMBOL (scm_sym_modules
, "modules");
248 static SCM module_prefix
= SCM_BOOL_F
;
249 static SCM make_modules_in_var
;
250 static SCM beautify_user_module_x_var
;
251 static SCM try_module_autoload_var
;
256 #define PERM(x) scm_permanent_object(x)
258 if (module_prefix
== SCM_BOOL_F
)
260 module_prefix
= PERM (scm_list_2 (scm_sym_app
, scm_sym_modules
));
261 make_modules_in_var
= PERM (scm_c_lookup ("make-modules-in"));
262 beautify_user_module_x_var
=
263 PERM (scm_c_lookup ("beautify-user-module!"));
264 try_module_autoload_var
= PERM (scm_c_lookup ("try-module-autoload"));
269 scm_the_root_module ()
271 init_module_stuff ();
272 scm_c_issue_deprecation_warning ("`scm_the_root_module' is deprecated. "
273 "Use `scm_c_resolve_module (\"guile\")' "
276 return scm_c_resolve_module ("guile");
280 scm_module_full_name (SCM name
)
282 init_module_stuff ();
283 if (scm_is_eq (SCM_CAR (name
), scm_sym_app
))
286 return scm_append (scm_list_2 (module_prefix
, name
));
290 scm_make_module (SCM name
)
292 init_module_stuff ();
293 scm_c_issue_deprecation_warning ("`scm_make_module' is deprecated. "
294 "Use `scm_c_define_module instead.");
296 return scm_call_2 (SCM_VARIABLE_REF (make_modules_in_var
),
297 scm_the_root_module (),
298 scm_module_full_name (name
));
302 scm_ensure_user_module (SCM module
)
304 init_module_stuff ();
305 scm_c_issue_deprecation_warning ("`scm_ensure_user_module' is deprecated. "
306 "Use `scm_c_define_module instead.");
308 scm_call_1 (SCM_VARIABLE_REF (beautify_user_module_x_var
), module
);
309 return SCM_UNSPECIFIED
;
313 scm_load_scheme_module (SCM name
)
315 init_module_stuff ();
316 scm_c_issue_deprecation_warning ("`scm_load_scheme_module' is deprecated. "
317 "Use `scm_c_resolve_module instead.");
319 return scm_call_1 (SCM_VARIABLE_REF (try_module_autoload_var
), name
);
322 /* This is implemented in C solely for SCM_COERCE_OUTPORT ... */
325 maybe_close_port (void *data
, SCM port
)
327 SCM except_set
= (SCM
) data
;
329 while (!scm_is_null (except_set
))
331 SCM p
= SCM_COERCE_OUTPORT (SCM_CAR (except_set
));
332 if (scm_is_eq (p
, port
))
334 except_set
= SCM_CDR (except_set
);
337 scm_close_port (port
);
340 SCM_DEFINE (scm_close_all_ports_except
, "close-all-ports-except", 0, 0, 1,
342 "[DEPRECATED] Close all open file ports used by the interpreter\n"
343 "except for those supplied as arguments. This procedure\n"
344 "was intended to be used before an exec call to close file descriptors\n"
345 "which are not needed in the new process. However it has the\n"
346 "undesirable side effect of flushing buffers, so it's deprecated.\n"
347 "Use port-for-each instead.")
348 #define FUNC_NAME s_scm_close_all_ports_except
351 SCM_VALIDATE_REST_ARGUMENT (ports
);
353 for (p
= ports
; !scm_is_null (p
); p
= SCM_CDR (p
))
354 SCM_VALIDATE_OPPORT (SCM_ARG1
, SCM_COERCE_OUTPORT (SCM_CAR (p
)));
356 scm_c_port_for_each (maybe_close_port
, ports
);
358 return SCM_UNSPECIFIED
;
362 SCM_DEFINE (scm_variable_set_name_hint
, "variable-set-name-hint!", 2, 0, 0,
364 "Do not use this function.")
365 #define FUNC_NAME s_scm_variable_set_name_hint
367 SCM_VALIDATE_VARIABLE (1, var
);
368 SCM_VALIDATE_SYMBOL (2, hint
);
369 scm_c_issue_deprecation_warning
370 ("'variable-set-name-hint!' is deprecated. Do not use it.");
371 return SCM_UNSPECIFIED
;
375 SCM_DEFINE (scm_builtin_variable
, "builtin-variable", 1, 0, 0,
377 "Do not use this function.")
378 #define FUNC_NAME s_scm_builtin_variable
380 SCM_VALIDATE_SYMBOL (1,name
);
381 scm_c_issue_deprecation_warning ("`builtin-variable' is deprecated. "
382 "Use module system operations instead.");
383 return scm_sym2var (name
, SCM_BOOL_F
, SCM_BOOL_T
);
388 scm_makstr (size_t len
, int dummy
)
390 scm_c_issue_deprecation_warning
391 ("'scm_makstr' is deprecated. Use 'scm_c_make_string' instead.");
392 return scm_c_make_string (len
, SCM_UNDEFINED
);
396 scm_makfromstr (const char *src
, size_t len
, int dummy SCM_UNUSED
)
398 scm_c_issue_deprecation_warning ("`scm_makfromstr' is deprecated. "
399 "Use `scm_from_locale_stringn' instead.");
401 return scm_from_locale_stringn (src
, len
);
405 scm_internal_with_fluids (SCM fluids
, SCM values
, SCM (*cproc
) (), void *cdata
)
407 scm_c_issue_deprecation_warning ("`scm_internal_with_fluids' is deprecated. "
408 "Use `scm_c_with_fluids' instead.");
410 return scm_c_with_fluids (fluids
, values
, cproc
, cdata
);
414 scm_make_gsubr (const char *name
, int req
, int opt
, int rst
, SCM (*fcn
)())
416 scm_c_issue_deprecation_warning
417 ("`scm_make_gsubr' is deprecated. Use `scm_c_define_gsubr' instead.");
419 return scm_c_define_gsubr (name
, req
, opt
, rst
, fcn
);
423 scm_make_gsubr_with_generic (const char *name
,
424 int req
, int opt
, int rst
,
425 SCM (*fcn
)(), SCM
*gf
)
427 scm_c_issue_deprecation_warning
428 ("`scm_make_gsubr_with_generic' is deprecated. "
429 "Use `scm_c_define_gsubr_with_generic' instead.");
431 return scm_c_define_gsubr_with_generic (name
, req
, opt
, rst
, fcn
, gf
);
435 scm_create_hook (const char *name
, int n_args
)
437 scm_c_issue_deprecation_warning
438 ("'scm_create_hook' is deprecated. "
439 "Use 'scm_make_hook' and 'scm_c_define' instead.");
441 SCM hook
= scm_make_hook (scm_from_int (n_args
));
442 scm_c_define (name
, hook
);
443 return scm_permanent_object (hook
);
447 SCM_DEFINE (scm_sloppy_memq
, "sloppy-memq", 2, 0, 0,
449 "This procedure behaves like @code{memq}, but does no type or error checking.\n"
450 "Its use is recommended only in writing Guile internals,\n"
451 "not for high-level Scheme programs.")
452 #define FUNC_NAME s_scm_sloppy_memq
454 scm_c_issue_deprecation_warning
455 ("'sloppy-memq' is deprecated. Use 'memq' instead.");
457 for(; scm_is_pair (lst
); lst
= SCM_CDR(lst
))
459 if (scm_is_eq (SCM_CAR (lst
), x
))
467 SCM_DEFINE (scm_sloppy_memv
, "sloppy-memv", 2, 0, 0,
469 "This procedure behaves like @code{memv}, but does no type or error checking.\n"
470 "Its use is recommended only in writing Guile internals,\n"
471 "not for high-level Scheme programs.")
472 #define FUNC_NAME s_scm_sloppy_memv
474 scm_c_issue_deprecation_warning
475 ("'sloppy-memv' is deprecated. Use 'memv' instead.");
477 for(; scm_is_pair (lst
); lst
= SCM_CDR(lst
))
479 if (! scm_is_false (scm_eqv_p (SCM_CAR (lst
), x
)))
487 SCM_DEFINE (scm_sloppy_member
, "sloppy-member", 2, 0, 0,
489 "This procedure behaves like @code{member}, but does no type or error checking.\n"
490 "Its use is recommended only in writing Guile internals,\n"
491 "not for high-level Scheme programs.")
492 #define FUNC_NAME s_scm_sloppy_member
494 scm_c_issue_deprecation_warning
495 ("'sloppy-member' is deprecated. Use 'member' instead.");
497 for(; scm_is_pair (lst
); lst
= SCM_CDR(lst
))
499 if (! scm_is_false (scm_equal_p (SCM_CAR (lst
), x
)))
506 SCM_SYMBOL (scm_end_of_file_key
, "end-of-file");
508 SCM_DEFINE (scm_read_and_eval_x
, "read-and-eval!", 0, 1, 0,
510 "Read a form from @var{port} (standard input by default), and evaluate it\n"
511 "(memoizing it in the process) in the top-level environment. If no data\n"
512 "is left to be read from @var{port}, an @code{end-of-file} error is\n"
514 #define FUNC_NAME s_scm_read_and_eval_x
518 scm_c_issue_deprecation_warning
519 ("'read-and-eval!' is deprecated. Use 'read' and 'eval' instead.");
521 form
= scm_read (port
);
522 if (SCM_EOF_OBJECT_P (form
))
523 scm_ithrow (scm_end_of_file_key
, SCM_EOL
, 1);
524 return scm_eval_x (form
, scm_current_module ());
529 scm_make_subr_opt (const char *name
, int type
, SCM (*fcn
) (), int set
)
531 scm_c_issue_deprecation_warning
532 ("`scm_make_subr_opt' is deprecated. Use `scm_c_make_subr' or "
533 "`scm_c_define_subr' instead.");
536 return scm_c_define_subr (name
, type
, fcn
);
538 return scm_c_make_subr (name
, type
, fcn
);
542 scm_make_subr (const char *name
, int type
, SCM (*fcn
) ())
544 scm_c_issue_deprecation_warning
545 ("`scm_make_subr' is deprecated. Use `scm_c_define_subr' instead.");
547 return scm_c_define_subr (name
, type
, fcn
);
551 scm_make_subr_with_generic (const char *name
, int type
, SCM (*fcn
) (), SCM
*gf
)
553 scm_c_issue_deprecation_warning
554 ("`scm_make_subr_with_generic' is deprecated. Use "
555 "`scm_c_define_subr_with_generic' instead.");
557 return scm_c_define_subr_with_generic (name
, type
, fcn
, gf
);
560 /* Call thunk(closure) underneath a top-level error handler.
561 * If an error occurs, pass the exitval through err_filter and return it.
562 * If no error occurs, return the value of thunk.
566 typedef int setjmp_type
;
568 typedef long setjmp_type
;
571 struct cce_handler_data
{
572 SCM (*err_filter
) ();
577 invoke_err_filter (void *d
, SCM tag
, SCM args
)
579 struct cce_handler_data
*data
= (struct cce_handler_data
*)d
;
580 return data
->err_filter (SCM_BOOL_F
, data
->closure
);
584 scm_call_catching_errors (SCM (*thunk
)(), SCM (*err_filter
)(), void *closure
)
586 scm_c_issue_deprecation_warning
587 ("'scm_call_catching_errors' is deprecated. "
588 "Use 'scm_internal_catch' instead.");
591 struct cce_handler_data data
;
592 data
.err_filter
= err_filter
;
593 data
.closure
= closure
;
594 return scm_internal_catch (SCM_BOOL_T
,
595 (scm_t_catch_body
)thunk
, closure
,
596 (scm_t_catch_handler
)invoke_err_filter
, &data
);
601 scm_make_smob_type_mfpe (char *name
, size_t size
,
603 size_t (*free
) (SCM
),
604 int (*print
) (SCM
, SCM
, scm_print_state
*),
605 SCM (*equalp
) (SCM
, SCM
))
607 scm_c_issue_deprecation_warning
608 ("'scm_make_smob_type_mfpe' is deprecated. "
609 "Use 'scm_make_smob_type' plus 'scm_set_smob_*' instead.");
612 long answer
= scm_make_smob_type (name
, size
);
613 scm_set_smob_mfpe (answer
, mark
, free
, print
, equalp
);
619 scm_set_smob_mfpe (long tc
,
621 size_t (*free
) (SCM
),
622 int (*print
) (SCM
, SCM
, scm_print_state
*),
623 SCM (*equalp
) (SCM
, SCM
))
625 scm_c_issue_deprecation_warning
626 ("'scm_set_smob_mfpe' is deprecated. "
627 "Use 'scm_set_smob_mark' instead, for example.");
629 if (mark
) scm_set_smob_mark (tc
, mark
);
630 if (free
) scm_set_smob_free (tc
, free
);
631 if (print
) scm_set_smob_print (tc
, print
);
632 if (equalp
) scm_set_smob_equalp (tc
, equalp
);
636 scm_read_0str (char *expr
)
638 scm_c_issue_deprecation_warning
639 ("scm_read_0str is deprecated. Use scm_c_read_string instead.");
641 return scm_c_read_string (expr
);
645 scm_eval_0str (const char *expr
)
647 scm_c_issue_deprecation_warning
648 ("scm_eval_0str is deprecated. Use scm_c_eval_string instead.");
650 return scm_c_eval_string (expr
);
654 scm_strprint_obj (SCM obj
)
656 scm_c_issue_deprecation_warning
657 ("scm_strprint_obj is deprecated. Use scm_object_to_string instead.");
658 return scm_object_to_string (obj
, SCM_UNDEFINED
);
662 scm_i_object_chars (SCM obj
)
664 scm_c_issue_deprecation_warning
665 ("SCM_CHARS is deprecated. See the manual for alternatives.");
666 if (SCM_STRINGP (obj
))
667 return SCM_STRING_CHARS (obj
);
668 if (SCM_SYMBOLP (obj
))
669 return SCM_SYMBOL_CHARS (obj
);
674 scm_i_object_length (SCM obj
)
676 scm_c_issue_deprecation_warning
677 ("SCM_LENGTH is deprecated. "
678 "Use scm_c_string_length instead, for example, or see the manual.");
679 if (SCM_STRINGP (obj
))
680 return SCM_STRING_LENGTH (obj
);
681 if (SCM_SYMBOLP (obj
))
682 return SCM_SYMBOL_LENGTH (obj
);
683 if (SCM_VECTORP (obj
))
684 return SCM_VECTOR_LENGTH (obj
);
689 scm_sym2ovcell_soft (SCM sym
, SCM obarray
)
692 size_t hash
= scm_i_symbol_hash (sym
) % SCM_VECTOR_LENGTH (obarray
);
694 scm_c_issue_deprecation_warning ("`scm_sym2ovcell_soft' is deprecated. "
695 "Use hashtables instead.");
697 SCM_CRITICAL_SECTION_START
;
698 for (lsym
= SCM_VECTOR_REF (obarray
, hash
);
700 lsym
= SCM_CDR (lsym
))
703 if (scm_is_eq (SCM_CAR (z
), sym
))
705 SCM_CRITICAL_SECTION_END
;
709 SCM_CRITICAL_SECTION_END
;
715 scm_sym2ovcell (SCM sym
, SCM obarray
)
716 #define FUNC_NAME "scm_sym2ovcell"
720 scm_c_issue_deprecation_warning ("`scm_sym2ovcell' is deprecated. "
721 "Use hashtables instead.");
723 answer
= scm_sym2ovcell_soft (sym
, obarray
);
724 if (scm_is_true (answer
))
726 SCM_MISC_ERROR ("uninterned symbol: ~S", scm_list_1 (sym
));
727 return SCM_UNSPECIFIED
; /* not reached */
732 /* Intern a symbol whose name is the LEN characters at NAME in OBARRAY.
734 OBARRAY should be a vector of lists, indexed by the name's hash
735 value, modulo OBARRAY's length. Each list has the form
736 ((SYMBOL . VALUE) ...), where SYMBOL is a symbol, and VALUE is the
737 value associated with that symbol (in the current module? in the
740 To "intern" a symbol means: if OBARRAY already contains a symbol by
741 that name, return its (SYMBOL . VALUE) pair; otherwise, create a
742 new symbol, add the pair (SYMBOL . SCM_UNDEFINED) to the
743 appropriate list of the OBARRAY, and return the pair.
745 If softness is non-zero, don't create a symbol if it isn't already
746 in OBARRAY; instead, just return #f.
748 If OBARRAY is SCM_BOOL_F, create a symbol listed in no obarray and
749 return (SYMBOL . SCM_UNDEFINED). */
753 scm_intern_obarray_soft (const char *name
,size_t len
,SCM obarray
,unsigned int softness
)
755 SCM symbol
= scm_from_locale_symboln (name
, len
);
756 size_t raw_hash
= scm_i_symbol_hash (symbol
);
760 scm_c_issue_deprecation_warning ("`scm_intern_obarray_soft' is deprecated. "
761 "Use hashtables instead.");
763 if (scm_is_false (obarray
))
768 return scm_cons (symbol
, SCM_UNDEFINED
);
771 hash
= raw_hash
% SCM_VECTOR_LENGTH (obarray
);
773 for (lsym
= SCM_VECTOR_REF(obarray
, hash
);
774 SCM_NIMP (lsym
); lsym
= SCM_CDR (lsym
))
776 SCM a
= SCM_CAR (lsym
);
778 if (scm_is_eq (z
, symbol
))
788 SCM cell
= scm_cons (symbol
, SCM_UNDEFINED
);
789 SCM slot
= SCM_VECTOR_REF (obarray
, hash
);
791 SCM_VECTOR_SET (obarray
, hash
, scm_cons (cell
, slot
));
799 scm_intern_obarray (const char *name
,size_t len
,SCM obarray
)
801 scm_c_issue_deprecation_warning ("`scm_intern_obarray' is deprecated. "
802 "Use hashtables instead.");
804 return scm_intern_obarray_soft (name
, len
, obarray
, 0);
807 /* Lookup the value of the symbol named by the nul-terminated string
808 NAME in the current module. */
810 scm_symbol_value0 (const char *name
)
812 scm_c_issue_deprecation_warning ("`scm_symbol_value0' is deprecated. "
813 "Use `scm_lookup' instead.");
815 return scm_variable_ref (scm_c_lookup (name
));
818 SCM_DEFINE (scm_string_to_obarray_symbol
, "string->obarray-symbol", 2, 1, 0,
819 (SCM o
, SCM s
, SCM softp
),
820 "Intern a new symbol in @var{obarray}, a symbol table, with name\n"
822 "If @var{obarray} is @code{#f}, use the default system symbol table. If\n"
823 "@var{obarray} is @code{#t}, the symbol should not be interned in any\n"
824 "symbol table; merely return the pair (@var{symbol}\n"
825 ". @var{#<undefined>}).\n\n"
826 "The @var{soft?} argument determines whether new symbol table entries\n"
827 "should be created when the specified symbol is not already present in\n"
828 "@var{obarray}. If @var{soft?} is specified and is a true value, then\n"
829 "new entries should not be added for symbols not already present in the\n"
830 "table; instead, simply return @code{#f}.")
831 #define FUNC_NAME s_scm_string_to_obarray_symbol
837 SCM_VALIDATE_STRING (2, s
);
838 SCM_ASSERT (scm_is_bool (o
) || SCM_VECTORP (o
), o
, SCM_ARG1
, FUNC_NAME
);
840 scm_c_issue_deprecation_warning ("`string->obarray-symbol' is deprecated. "
841 "Use hashtables instead.");
843 softness
= (!SCM_UNBNDP (softp
) && scm_is_true(softp
));
844 /* iron out some screwy calling conventions */
845 if (scm_is_false (o
))
847 /* nothing interesting to do here. */
848 return scm_string_to_symbol (s
);
850 else if (scm_is_eq (o
, SCM_BOOL_T
))
853 vcell
= scm_intern_obarray_soft (scm_i_string_chars (s
),
854 scm_i_string_length (s
),
857 if (scm_is_false (vcell
))
859 answer
= SCM_CAR (vcell
);
864 SCM_DEFINE (scm_intern_symbol
, "intern-symbol", 2, 0, 0,
866 "Add a new symbol to @var{obarray} with name @var{string}, bound to an\n"
867 "unspecified initial value. The symbol table is not modified if a symbol\n"
868 "with this name is already present.")
869 #define FUNC_NAME s_scm_intern_symbol
872 SCM_VALIDATE_SYMBOL (2,s
);
873 if (scm_is_false (o
))
874 return SCM_UNSPECIFIED
;
876 scm_c_issue_deprecation_warning ("`intern-symbol' is deprecated. "
877 "Use hashtables instead.");
879 SCM_VALIDATE_VECTOR (1,o
);
880 hval
= scm_i_symbol_hash (s
) % SCM_VECTOR_LENGTH (o
);
881 /* If the symbol is already interned, simply return. */
882 SCM_CRITICAL_SECTION_START
;
886 for (lsym
= SCM_VECTOR_REF (o
, hval
);
888 lsym
= SCM_CDR (lsym
))
890 sym
= SCM_CAR (lsym
);
891 if (scm_is_eq (SCM_CAR (sym
), s
))
893 SCM_CRITICAL_SECTION_END
;
894 return SCM_UNSPECIFIED
;
897 SCM_VECTOR_SET (o
, hval
,
898 scm_acons (s
, SCM_UNDEFINED
,
899 SCM_VECTOR_REF (o
, hval
)));
901 SCM_CRITICAL_SECTION_END
;
902 return SCM_UNSPECIFIED
;
906 SCM_DEFINE (scm_unintern_symbol
, "unintern-symbol", 2, 0, 0,
908 "Remove the symbol with name @var{string} from @var{obarray}. This\n"
909 "function returns @code{#t} if the symbol was present and @code{#f}\n"
911 #define FUNC_NAME s_scm_unintern_symbol
915 scm_c_issue_deprecation_warning ("`unintern-symbol' is deprecated. "
916 "Use hashtables instead.");
918 SCM_VALIDATE_SYMBOL (2,s
);
919 if (scm_is_false (o
))
921 SCM_VALIDATE_VECTOR (1,o
);
922 hval
= scm_i_symbol_hash (s
) % SCM_VECTOR_LENGTH (o
);
923 SCM_CRITICAL_SECTION_START
;
928 for (lsym
= SCM_VECTOR_REF (o
, hval
), lsym_follow
= SCM_BOOL_F
;
930 lsym_follow
= lsym
, lsym
= SCM_CDR (lsym
))
932 sym
= SCM_CAR (lsym
);
933 if (scm_is_eq (SCM_CAR (sym
), s
))
935 /* Found the symbol to unintern. */
936 if (scm_is_false (lsym_follow
))
937 SCM_VECTOR_SET (o
, hval
, lsym
);
939 SCM_SETCDR (lsym_follow
, SCM_CDR(lsym
));
940 SCM_CRITICAL_SECTION_END
;
945 SCM_CRITICAL_SECTION_END
;
950 SCM_DEFINE (scm_symbol_binding
, "symbol-binding", 2, 0, 0,
952 "Look up in @var{obarray} the symbol whose name is @var{string}, and\n"
953 "return the value to which it is bound. If @var{obarray} is @code{#f},\n"
954 "use the global symbol table. If @var{string} is not interned in\n"
955 "@var{obarray}, an error is signalled.")
956 #define FUNC_NAME s_scm_symbol_binding
960 scm_c_issue_deprecation_warning ("`symbol-binding' is deprecated. "
961 "Use hashtables instead.");
963 SCM_VALIDATE_SYMBOL (2,s
);
964 if (scm_is_false (o
))
965 return scm_variable_ref (scm_lookup (s
));
966 SCM_VALIDATE_VECTOR (1,o
);
967 vcell
= scm_sym2ovcell (s
, o
);
968 return SCM_CDR(vcell
);
973 SCM_DEFINE (scm_symbol_interned_p
, "symbol-interned?", 2, 0, 0,
975 "Return @code{#t} if @var{obarray} contains a symbol with name\n"
976 "@var{string}, and @code{#f} otherwise.")
977 #define FUNC_NAME s_scm_symbol_interned_p
981 scm_c_issue_deprecation_warning ("`symbol-interned?' is deprecated. "
982 "Use hashtables instead.");
984 SCM_VALIDATE_SYMBOL (2,s
);
985 if (scm_is_false (o
))
987 SCM var
= scm_sym2var (s
, SCM_BOOL_F
, SCM_BOOL_F
);
988 if (var
!= SCM_BOOL_F
)
992 SCM_VALIDATE_VECTOR (1,o
);
993 vcell
= scm_sym2ovcell_soft (s
, o
);
994 return (SCM_NIMP(vcell
)
1001 SCM_DEFINE (scm_symbol_bound_p
, "symbol-bound?", 2, 0, 0,
1003 "Return @code{#t} if @var{obarray} contains a symbol with name\n"
1004 "@var{string} bound to a defined value. This differs from\n"
1005 "@var{symbol-interned?} in that the mere mention of a symbol\n"
1006 "usually causes it to be interned; @code{symbol-bound?}\n"
1007 "determines whether a symbol has been given any meaningful\n"
1009 #define FUNC_NAME s_scm_symbol_bound_p
1013 scm_c_issue_deprecation_warning ("`symbol-bound?' is deprecated. "
1014 "Use hashtables instead.");
1016 SCM_VALIDATE_SYMBOL (2,s
);
1017 if (scm_is_false (o
))
1019 SCM var
= scm_sym2var (s
, SCM_BOOL_F
, SCM_BOOL_F
);
1020 if (SCM_VARIABLEP(var
) && !SCM_UNBNDP(SCM_VARIABLE_REF(var
)))
1024 SCM_VALIDATE_VECTOR (1,o
);
1025 vcell
= scm_sym2ovcell_soft (s
, o
);
1026 return scm_from_bool (SCM_NIMP (vcell
) && !SCM_UNBNDP (SCM_CDR (vcell
)));
1031 SCM_DEFINE (scm_symbol_set_x
, "symbol-set!", 3, 0, 0,
1032 (SCM o
, SCM s
, SCM v
),
1033 "Find the symbol in @var{obarray} whose name is @var{string}, and rebind\n"
1034 "it to @var{value}. An error is signalled if @var{string} is not present\n"
1035 "in @var{obarray}.")
1036 #define FUNC_NAME s_scm_symbol_set_x
1040 scm_c_issue_deprecation_warning ("`symbol-set!' is deprecated. "
1041 "Use the module system instead.");
1043 SCM_VALIDATE_SYMBOL (2,s
);
1044 if (scm_is_false (o
))
1047 return SCM_UNSPECIFIED
;
1049 SCM_VALIDATE_VECTOR (1,o
);
1050 vcell
= scm_sym2ovcell (s
, o
);
1051 SCM_SETCDR (vcell
, v
);
1052 return SCM_UNSPECIFIED
;
1056 #define MAX_PREFIX_LENGTH 30
1058 static int gentemp_counter
;
1060 SCM_DEFINE (scm_gentemp
, "gentemp", 0, 2, 0,
1061 (SCM prefix
, SCM obarray
),
1062 "Create a new symbol with a name unique in an obarray.\n"
1063 "The name is constructed from an optional string @var{prefix}\n"
1064 "and a counter value. The default prefix is @code{t}. The\n"
1065 "@var{obarray} is specified as a second optional argument.\n"
1066 "Default is the system obarray where all normal symbols are\n"
1067 "interned. The counter is increased by 1 at each\n"
1068 "call. There is no provision for resetting the counter.")
1069 #define FUNC_NAME s_scm_gentemp
1071 char buf
[MAX_PREFIX_LENGTH
+ SCM_INTBUFLEN
];
1075 scm_c_issue_deprecation_warning ("`gentemp' is deprecated. "
1076 "Use `gensym' instead.");
1078 if (SCM_UNBNDP (prefix
))
1085 SCM_VALIDATE_STRING (1, prefix
);
1086 len
= scm_i_string_length (prefix
);
1087 if (len
> MAX_PREFIX_LENGTH
)
1088 name
= SCM_MUST_MALLOC (MAX_PREFIX_LENGTH
+ SCM_INTBUFLEN
);
1089 strncpy (name
, scm_i_string_chars (prefix
), len
);
1092 if (SCM_UNBNDP (obarray
))
1093 return scm_gensym (prefix
);
1095 SCM_ASSERT ((scm_is_vector (obarray
) || SCM_I_WVECTP (obarray
)),
1100 n_digits
= scm_iint2str (gentemp_counter
++, 10, &name
[len
]);
1101 while (scm_is_true (scm_intern_obarray_soft (name
,
1106 SCM vcell
= scm_intern_obarray_soft (name
,
1111 scm_must_free (name
);
1112 return SCM_CAR (vcell
);
1118 scm_i_makinum (scm_t_signed_bits val
)
1120 scm_c_issue_deprecation_warning
1121 ("SCM_MAKINUM is deprecated. Use scm_from_int or similar instead.");
1122 return SCM_I_MAKINUM (val
);
1126 scm_i_inump (SCM obj
)
1128 scm_c_issue_deprecation_warning
1129 ("SCM_INUMP is deprecated. Use scm_is_integer or similar instead.");
1130 return SCM_I_INUMP (obj
);
1134 scm_i_inum (SCM obj
)
1136 scm_c_issue_deprecation_warning
1137 ("SCM_INUM is deprecated. Use scm_to_int or similar instead.");
1138 return scm_to_intmax (obj
);
1142 scm_c_string2str (SCM obj
, char *str
, size_t *lenp
)
1144 scm_c_issue_deprecation_warning
1145 ("scm_c_string2str is deprecated. Use scm_to_locale_stringbuf or similar instead.");
1149 char *result
= scm_to_locale_string (obj
);
1151 *lenp
= scm_i_string_length (obj
);
1156 /* Pray that STR is large enough.
1158 size_t len
= scm_to_locale_stringbuf (obj
, str
, SCM_I_SIZE_MAX
);
1167 scm_c_substring2str (SCM obj
, char *str
, size_t start
, size_t len
)
1169 scm_c_issue_deprecation_warning
1170 ("scm_c_substring2str is deprecated. Use scm_substring plus scm_to_locale_stringbuf instead.");
1173 obj
= scm_substring (obj
, scm_from_size_t (start
), SCM_UNDEFINED
);
1175 scm_to_locale_stringbuf (obj
, str
, len
);
1179 /* Converts the given Scheme symbol OBJ into a C string, containing a copy
1180 of OBJ's content with a trailing null byte. If LENP is non-NULL, set
1181 *LENP to the string's length.
1183 When STR is non-NULL it receives the copy and is returned by the function,
1184 otherwise new memory is allocated and the caller is responsible for
1185 freeing it via free(). If out of memory, NULL is returned.
1187 Note that Scheme symbols may contain arbitrary data, including null
1188 characters. This means that null termination is not a reliable way to
1189 determine the length of the returned value. However, the function always
1190 copies the complete contents of OBJ, and sets *LENP to the length of the
1191 scheme symbol (if LENP is non-null). */
1193 scm_c_symbol2str (SCM obj
, char *str
, size_t *lenp
)
1195 return scm_c_string2str (scm_symbol_to_string (obj
), str
, lenp
);
1199 scm_truncate (double x
)
1201 scm_c_issue_deprecation_warning
1202 ("scm_truncate is deprecated. Use scm_c_truncate instead.");
1203 return scm_c_truncate (x
);
1207 scm_round (double x
)
1209 scm_c_issue_deprecation_warning
1210 ("scm_round is deprecated. Use scm_c_round instead.");
1211 return scm_c_round (x
);
1215 scm_i_deprecated_symbol_chars (SCM sym
)
1217 scm_c_issue_deprecation_warning
1218 ("SCM_SYMBOL_CHARS is deprecated. Use scm_symbol_to_string.");
1220 return (char *)scm_i_symbol_chars (sym
);
1224 scm_i_deprecated_symbol_length (SCM sym
)
1226 scm_c_issue_deprecation_warning
1227 ("SCM_SYMBOL_LENGTH is deprecated. Use scm_symbol_to_string.");
1228 return scm_i_symbol_length (sym
);
1232 scm_i_keywordp (SCM obj
)
1234 scm_c_issue_deprecation_warning
1235 ("SCM_KEYWORDP is deprecated. Use scm_is_keyword instead.");
1236 return scm_is_keyword (obj
);
1240 scm_i_keywordsym (SCM keyword
)
1242 scm_c_issue_deprecation_warning
1243 ("SCM_KEYWORDSYM is deprecated. See scm_keyword_to_symbol instead.");
1244 return scm_keyword_dash_symbol (keyword
);
1248 scm_i_vectorp (SCM x
)
1250 scm_c_issue_deprecation_warning
1251 ("SCM_VECTORP is deprecated. Use scm_is_vector instead.");
1252 return SCM_I_IS_VECTOR (x
);
1256 scm_i_vector_length (SCM x
)
1258 scm_c_issue_deprecation_warning
1259 ("SCM_VECTOR_LENGTH is deprecated. Use scm_c_vector_length instead.");
1260 return SCM_I_VECTOR_LENGTH (x
);
1266 scm_c_issue_deprecation_warning
1267 ("SCM_VELTS is deprecated. Use scm_vector_elements instead.");
1268 return SCM_I_VECTOR_ELTS (x
);
1272 scm_i_writable_velts (SCM x
)
1274 scm_c_issue_deprecation_warning
1275 ("SCM_WRITABLE_VELTS is deprecated. "
1276 "Use scm_vector_writable_elements instead.");
1277 return SCM_I_VECTOR_WELTS (x
);
1281 scm_i_vector_ref (SCM x
, size_t idx
)
1283 scm_c_issue_deprecation_warning
1284 ("SCM_VECTOR_REF is deprecated. "
1285 "Use scm_c_vector_ref or scm_vector_elements instead.");
1286 return scm_c_vector_ref (x
, idx
);
1290 scm_i_vector_set (SCM x
, size_t idx
, SCM val
)
1292 scm_c_issue_deprecation_warning
1293 ("SCM_VECTOR_SET is deprecated. "
1294 "Use scm_c_vector_set_x or scm_vector_writable_elements instead.");
1295 scm_c_vector_set_x (x
, idx
, val
);
1299 scm_vector_equal_p (SCM x
, SCM y
)
1301 scm_c_issue_deprecation_warning
1302 ("scm_vector_euqal_p is deprecated. "
1303 "Use scm_equal_p instead.");
1304 return scm_equal_p (x
, y
);
1308 scm_i_arrayp (SCM a
)
1310 scm_c_issue_deprecation_warning
1311 ("SCM_ARRAYP is deprecated. Use scm_is_array instead.");
1312 return SCM_I_ARRAYP(a
);
1316 scm_i_array_ndim (SCM a
)
1318 scm_c_issue_deprecation_warning
1319 ("SCM_ARRAY_NDIM is deprecated. "
1320 "Use scm_c_array_rank or scm_array_handle_rank instead.");
1321 return scm_c_array_rank (a
);
1325 scm_i_array_contp (SCM a
)
1327 scm_c_issue_deprecation_warning
1328 ("SCM_ARRAY_CONTP is deprecated. Do not use it.");
1329 return SCM_I_ARRAY_CONTP (a
);
1333 scm_i_array_mem (SCM a
)
1335 scm_c_issue_deprecation_warning
1336 ("SCM_ARRAY_MEM is deprecated. Do not use it.");
1337 return (scm_t_array
*)SCM_I_ARRAY_MEM (a
);
1341 scm_i_array_v (SCM a
)
1343 /* We could use scm_shared_array_root here, but it is better to move
1344 them away from expecting vectors as the basic storage for arrays.
1346 scm_c_issue_deprecation_warning
1347 ("SCM_ARRAY_V is deprecated. Do not use it.");
1348 return SCM_I_ARRAY_V (a
);
1352 scm_i_array_base (SCM a
)
1354 scm_c_issue_deprecation_warning
1355 ("SCM_ARRAY_BASE is deprecated. Do not use it.");
1356 return SCM_I_ARRAY_BASE (a
);
1360 scm_i_array_dims (SCM a
)
1362 scm_c_issue_deprecation_warning
1363 ("SCM_ARRAY_DIMS is deprecated. Use scm_array_handle_dims instead.");
1364 return SCM_I_ARRAY_DIMS (a
);
1368 scm_i_cur_inp (void)
1370 scm_c_issue_deprecation_warning
1371 ("scm_cur_inp is deprecated. Use scm_current_input_port instead.");
1372 return scm_current_input_port ();
1376 scm_i_cur_outp (void)
1378 scm_c_issue_deprecation_warning
1379 ("scm_cur_outp is deprecated. Use scm_current_output_port instead.");
1380 return scm_current_output_port ();
1384 scm_i_cur_errp (void)
1386 scm_c_issue_deprecation_warning
1387 ("scm_cur_errp is deprecated. Use scm_current_error_port instead.");
1388 return scm_current_error_port ();
1392 scm_i_cur_loadp (void)
1394 scm_c_issue_deprecation_warning
1395 ("scm_cur_loadp is deprecated. Use scm_current_load_port instead.");
1396 return scm_current_load_port ();
1400 scm_i_progargs (void)
1402 scm_c_issue_deprecation_warning
1403 ("scm_progargs is deprecated. Use scm_program_arguments instead.");
1404 return scm_program_arguments ();
1408 scm_i_deprecated_dynwinds (void)
1410 scm_c_issue_deprecation_warning
1411 ("scm_dynwinds is deprecated. Do not use it.");
1412 return scm_i_dynwinds ();
1416 scm_i_deprecated_last_debug_frame (void)
1418 scm_c_issue_deprecation_warning
1419 ("scm_last_debug_frame is deprecated. Do not use it.");
1420 return scm_i_last_debug_frame ();
1424 scm_i_stack_base (void)
1426 scm_c_issue_deprecation_warning
1427 ("scm_stack_base is deprecated. Do not use it.");
1428 return SCM_I_CURRENT_THREAD
->base
;
1432 scm_i_fluidp (SCM x
)
1434 scm_c_issue_deprecation_warning
1435 ("SCM_FLUIDP is deprecated. Use scm_is_fluid instead.");
1436 return scm_is_fluid (x
);
1440 scm_i_defer_ints_etc ()
1442 scm_c_issue_deprecation_warning
1443 ("SCM_DEFER_INTS etc are deprecated. "
1444 "Use a mutex instead if appropriate.");
1448 scm_guard (SCM guardian
, SCM obj
, int throw_p
)
1450 scm_c_issue_deprecation_warning
1451 ("scm_guard is deprecated. Use scm_call_1 instead.");
1453 return scm_call_1 (guardian
, obj
);
1457 scm_get_one_zombie (SCM guardian
)
1459 scm_c_issue_deprecation_warning
1460 ("scm_guard is deprecated. Use scm_call_0 instead.");
1462 return scm_call_0 (guardian
);
1465 SCM_DEFINE (scm_guardian_destroyed_p
, "guardian-destroyed?", 1, 0, 0,
1467 "Return @code{#t} if @var{guardian} has been destroyed, otherwise @code{#f}.")
1468 #define FUNC_NAME s_scm_guardian_destroyed_p
1470 scm_c_issue_deprecation_warning
1471 ("'guardian-destroyed?' is deprecated.");
1476 SCM_DEFINE (scm_guardian_greedy_p
, "guardian-greedy?", 1, 0, 0,
1478 "Return @code{#t} if @var{guardian} is a greedy guardian, otherwise @code{#f}.")
1479 #define FUNC_NAME s_scm_guardian_greedy_p
1481 scm_c_issue_deprecation_warning
1482 ("'guardian-greedy?' is deprecated.");
1487 SCM_DEFINE (scm_destroy_guardian_x
, "destroy-guardian!", 1, 0, 0,
1489 "Destroys @var{guardian}, by making it impossible to put any more\n"
1490 "objects in it or get any objects from it. It also unguards any\n"
1491 "objects guarded by @var{guardian}.")
1492 #define FUNC_NAME s_scm_destroy_guardian_x
1494 scm_c_issue_deprecation_warning
1495 ("'destroy-guardian!' is deprecated and ineffective.");
1496 return SCM_UNSPECIFIED
;
1501 scm_i_init_deprecated ()
1503 #include "libguile/deprecated.x"