diff --git a/libguile/deprecated.c b/libguile/deprecated.c index 995ebf573..c3dbf26ce 100644 --- a/libguile/deprecated.c +++ b/libguile/deprecated.c @@ -36,6 +36,8 @@ #include "libguile/variable.h" #include "libguile/fluids.h" #include "libguile/ports.h" +#include "libguile/eq.h" +#include "libguile/read.h" #include #include @@ -326,6 +328,170 @@ SCM_DEFINE (scm_close_all_ports_except, "close-all-ports-except", 0, 0, 1, } #undef FUNC_NAME +SCM_DEFINE (scm_variable_set_name_hint, "variable-set-name-hint!", 2, 0, 0, + (SCM var, SCM hint), + "Do not use this function.") +#define FUNC_NAME s_scm_variable_set_name_hint +{ + SCM_VALIDATE_VARIABLE (1, var); + SCM_VALIDATE_SYMBOL (2, hint); + scm_c_issue_deprecation_warning + ("'variable-set-name-hint!' is deprecated. Do not use it."); + return SCM_UNSPECIFIED; +} +#undef FUNC_NAME + +SCM_DEFINE (scm_builtin_variable, "builtin-variable", 1, 0, 0, + (SCM name), + "Do not use this function.") +#define FUNC_NAME s_scm_builtin_variable +{ + SCM_VALIDATE_SYMBOL (1,name); + scm_c_issue_deprecation_warning ("`builtin-variable' is deprecated. " + "Use module system operations instead."); + return scm_sym2var (name, SCM_BOOL_F, SCM_BOOL_T); +} +#undef FUNC_NAME + +SCM +scm_makstr (size_t len, int dummy) +{ + scm_c_issue_deprecation_warning + ("'scm_makstr' is deprecated. Use 'scm_allocate_string' instead."); + return scm_allocate_string (len); +} + +SCM +scm_makfromstr (const char *src, size_t len, int dummy SCM_UNUSED) +{ + scm_c_issue_deprecation_warning ("`scm_makfromstr' is deprecated. " + "Use `scm_mem2string' instead."); + + return scm_mem2string (src, len); +} + +SCM +scm_internal_with_fluids (SCM fluids, SCM values, SCM (*cproc) (), void *cdata) +{ + scm_c_issue_deprecation_warning ("`scm_internal_with_fluids' is deprecated. " + "Use `scm_c_with_fluids' instead."); + + return scm_c_with_fluids (fluids, values, cproc, cdata); +} + +SCM +scm_make_gsubr (const char *name, int req, int opt, int rst, SCM (*fcn)()) +{ + scm_c_issue_deprecation_warning + ("`scm_make_gsubr' is deprecated. Use `scm_c_define_gsubr' instead."); + + return scm_c_define_gsubr (name, req, opt, rst, fcn); +} + +SCM +scm_make_gsubr_with_generic (const char *name, + int req, int opt, int rst, + SCM (*fcn)(), SCM *gf) +{ + scm_c_issue_deprecation_warning + ("`scm_make_gsubr_with_generic' is deprecated. " + "Use `scm_c_define_gsubr_with_generic' instead."); + + return scm_c_define_gsubr_with_generic (name, req, opt, rst, fcn, gf); +} + +SCM +scm_create_hook (const char *name, int n_args) +{ + scm_c_issue_deprecation_warning + ("'scm_create_hook' is deprecated. " + "Use 'scm_make_hook' and 'scm_c_define' instead."); + { + SCM hook = scm_make_hook (SCM_MAKINUM (n_args)); + scm_c_define (name, hook); + return scm_permanent_object (hook); + } +} + +SCM_DEFINE (scm_sloppy_memq, "sloppy-memq", 2, 0, 0, + (SCM x, SCM lst), + "This procedure behaves like @code{memq}, but does no type or error checking.\n" + "Its use is recommended only in writing Guile internals,\n" + "not for high-level Scheme programs.") +#define FUNC_NAME s_scm_sloppy_memq +{ + scm_c_issue_deprecation_warning + ("'sloppy-memq' is deprecated. Use 'memq' instead."); + + for(; SCM_CONSP (lst); lst = SCM_CDR(lst)) + { + if (SCM_EQ_P (SCM_CAR (lst), x)) + return lst; + } + return lst; +} +#undef FUNC_NAME + + +SCM_DEFINE (scm_sloppy_memv, "sloppy-memv", 2, 0, 0, + (SCM x, SCM lst), + "This procedure behaves like @code{memv}, but does no type or error checking.\n" + "Its use is recommended only in writing Guile internals,\n" + "not for high-level Scheme programs.") +#define FUNC_NAME s_scm_sloppy_memv +{ + scm_c_issue_deprecation_warning + ("'sloppy-memv' is deprecated. Use 'memv' instead."); + + for(; SCM_CONSP (lst); lst = SCM_CDR(lst)) + { + if (! SCM_FALSEP (scm_eqv_p (SCM_CAR (lst), x))) + return lst; + } + return lst; +} +#undef FUNC_NAME + + +SCM_DEFINE (scm_sloppy_member, "sloppy-member", 2, 0, 0, + (SCM x, SCM lst), + "This procedure behaves like @code{member}, but does no type or error checking.\n" + "Its use is recommended only in writing Guile internals,\n" + "not for high-level Scheme programs.") +#define FUNC_NAME s_scm_sloppy_member +{ + scm_c_issue_deprecation_warning + ("'sloppy-member' is deprecated. Use 'member' instead."); + + for(; SCM_CONSP (lst); lst = SCM_CDR(lst)) + { + if (! SCM_FALSEP (scm_equal_p (SCM_CAR (lst), x))) + return lst; + } + return lst; +} +#undef FUNC_NAME + +SCM_SYMBOL (scm_end_of_file_key, "end-of-file"); + +SCM_DEFINE (scm_read_and_eval_x, "read-and-eval!", 0, 1, 0, + (SCM port), + "Read a form from @var{port} (standard input by default), and evaluate it\n" + "(memoizing it in the process) in the top-level environment. If no data\n" + "is left to be read from @var{port}, an @code{end-of-file} error is\n" + "signalled.") +#define FUNC_NAME s_scm_read_and_eval_x +{ + scm_c_issue_deprecation_warning + ("'read-and-eval!' is deprecated. Use 'read' and 'eval' instead."); + + SCM form = scm_read (port); + if (SCM_EOF_OBJECT_P (form)) + scm_ithrow (scm_end_of_file_key, SCM_EOL, 1); + return scm_eval_x (form, scm_current_module ()); +} +#undef FUNC_NAME + void scm_i_init_deprecated () { diff --git a/libguile/deprecated.h b/libguile/deprecated.h index 1f00e7acb..f34f51d9c 100644 --- a/libguile/deprecated.h +++ b/libguile/deprecated.h @@ -86,6 +86,52 @@ SCM_API SCM scm_close_all_ports_except (SCM ports); #define scm_tc7_msymbol scm_tc7_symbol #define scm_tcs_symbols scm_tc7_symbol +SCM_API SCM scm_makstr (size_t len, int); +SCM_API SCM scm_makfromstr (const char *src, size_t len, int); + +SCM_API SCM scm_variable_set_name_hint (SCM var, SCM hint); +SCM_API SCM scm_builtin_variable (SCM name); + +SCM_API SCM scm_internal_with_fluids (SCM fluids, SCM vals, + SCM (*cproc)(void *), void *cdata); + +SCM_API SCM scm_make_gsubr (const char *name, int req, int opt, int rst, + SCM (*fcn)()); +SCM_API SCM scm_make_gsubr_with_generic (const char *name, + int req, + int opt, + int rst, + SCM (*fcn)(), + SCM *gf); + +extern SCM scm_create_hook (const char* name, int n_args); + +#define SCM_LIST0 SCM_EOL +#define SCM_LIST1(e0) scm_cons ((e0), SCM_EOL) +#define SCM_LIST2(e0, e1) scm_cons2 ((e0), (e1), SCM_EOL) +#define SCM_LIST3(e0, e1, e2) scm_cons ((e0), SCM_LIST2 ((e1), (e2))) +#define SCM_LIST4(e0, e1, e2, e3)\ + scm_cons2 ((e0), (e1), SCM_LIST2 ((e2), (e3))) +#define SCM_LIST5(e0, e1, e2, e3, e4)\ + scm_cons ((e0), SCM_LIST4 ((e1), (e2), (e3), (e4))) +#define SCM_LIST6(e0, e1, e2, e3, e4, e5)\ + scm_cons2 ((e0), (e1), SCM_LIST4 ((e2), (e3), (e4), (e5))) +#define SCM_LIST7(e0, e1, e2, e3, e4, e5, e6)\ + scm_cons ((e0), SCM_LIST6 ((e1), (e2), (e3), (e4), (e5), (e6))) +#define SCM_LIST8(e0, e1, e2, e3, e4, e5, e6, e7)\ + scm_cons2 ((e0), (e1), SCM_LIST6 ((e2), (e3), (e4), (e5), (e6), (e7))) +#define SCM_LIST9(e0, e1, e2, e3, e4, e5, e6, e7, e8)\ + scm_cons ((e0),\ + SCM_LIST8 ((e1), (e2), (e3), (e4), (e5), (e6), (e7), (e8))) + +#define scm_listify scm_list_n + +SCM_API SCM scm_sloppy_memq (SCM x, SCM lst); +SCM_API SCM scm_sloppy_memv (SCM x, SCM lst); +SCM_API SCM scm_sloppy_member (SCM x, SCM lst); + +SCM_API SCM scm_read_and_eval_x (SCM port); + void scm_i_init_deprecated (void); #endif @@ -95,37 +141,6 @@ void scm_i_init_deprecated (void); #if 0 /* TODO */ -scm_variable_set_name_hint -scm_builtin_variable -SCM_VARVCELL -SCM_UDVARIABLEP -SCM_DEFVARIABLEP -scm_internal_with_fluids - -scm_make_gsubr -scm_make_gsubr_with_generic -scm_create_hook -list* - -SCM_LIST0 -SCM_LIST1 -SCM_LIST2 -SCM_LIST3 -SCM_LIST4 -SCM_LIST5 -SCM_LIST6 -SCM_LIST7 -SCM_LIST8 -SCM_LIST9 - -scm_listify -scm_sloppy_memq -scm_sloppy_memv -scm_sloppy_member - -scm_end_of_file_key -scm_read_and_eval_x - scm_mkbig scm_big2inum scm_adjbig