diff --git a/libguile/backtrace.c b/libguile/backtrace.c index 495a68bad..6eb7454ce 100644 --- a/libguile/backtrace.c +++ b/libguile/backtrace.c @@ -170,19 +170,6 @@ SCM_DEFINE (scm_display_error, "display-error", 6, 0, 0, { SCM_VALIDATE_OUTPUT_PORT (2, port); -#if SCM_ENABLE_DEPRECATED - if (SCM_STACKP (frame)) - { - scm_c_issue_deprecation_warning - ("Passing a stack as the first argument to `scm_display_error' is " - "deprecated. Pass a frame instead."); - if (SCM_STACK_LENGTH (frame)) - frame = scm_stack_ref (frame, SCM_INUM0); - else - frame = SCM_BOOL_F; - } -#endif - scm_i_display_error (frame, port, subr, message, args, rest); return SCM_UNSPECIFIED; diff --git a/libguile/deprecated.c b/libguile/deprecated.c index cee6b1d74..acf9b198f 100644 --- a/libguile/deprecated.c +++ b/libguile/deprecated.c @@ -1,8 +1,4 @@ -/* This file contains definitions for deprecated features. When you - deprecate something, move it here when that is feasible. -*/ - -/* Copyright (C) 2003, 2004, 2006, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015 Free Software Foundation, Inc. +/* Copyright (C) 2003-2004, 2006, 2008-2017 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -26,9 +22,6 @@ #define SCM_BUILDING_DEPRECATED_CODE -#include -#include - #include "libguile/_scm.h" #include "libguile/deprecation.h" @@ -36,934 +29,14 @@ -SCM -scm_internal_dynamic_wind (scm_t_guard before, - scm_t_inner inner, - scm_t_guard after, - void *inner_data, - void *guard_data) -{ - SCM ans; - - scm_c_issue_deprecation_warning - ("`scm_internal_dynamic_wind' is deprecated. " - "Use the `scm_dynwind_begin' / `scm_dynwind_end' API instead."); - - scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE); - scm_dynwind_rewind_handler (before, guard_data, SCM_F_WIND_EXPLICITLY); - scm_dynwind_unwind_handler (after, guard_data, SCM_F_WIND_EXPLICITLY); - ans = inner (inner_data); - scm_dynwind_end (); - return ans; -} - - - -SCM -scm_immutable_cell (scm_t_bits car, scm_t_bits cdr) -{ - scm_c_issue_deprecation_warning - ("scm_immutable_cell is deprecated. Use scm_cell instead."); - - return scm_cell (car, cdr); -} - -SCM -scm_immutable_double_cell (scm_t_bits car, scm_t_bits cbr, - scm_t_bits ccr, scm_t_bits cdr) -{ - scm_c_issue_deprecation_warning - ("scm_immutable_double_cell is deprecated. Use scm_double_cell instead."); - - return scm_double_cell (car, cbr, ccr, cdr); -} - - - - -SCM_GLOBAL_SYMBOL (scm_memory_alloc_key, "memory-allocation-error"); -void -scm_memory_error (const char *subr) -{ - scm_c_issue_deprecation_warning - ("scm_memory_error is deprecated. Use scm_report_out_of_memory to raise " - "an exception, or abort() to cause the program to exit."); - - fprintf (stderr, "FATAL: memory error in %s\n", subr); - abort (); -} - - - - -static SCM var_slot_ref_using_class = SCM_BOOL_F; -static SCM var_slot_set_using_class_x = SCM_BOOL_F; -static SCM var_slot_bound_using_class_p = SCM_BOOL_F; -static SCM var_slot_exists_using_class_p = SCM_BOOL_F; - -SCM scm_no_applicable_method = SCM_BOOL_F; - -SCM var_get_keyword = SCM_BOOL_F; - -SCM scm_class_boolean, scm_class_char, scm_class_pair; -SCM scm_class_procedure, scm_class_string, scm_class_symbol; -SCM scm_class_primitive_generic; -SCM scm_class_vector, scm_class_null; -SCM scm_class_integer, scm_class_real, scm_class_complex, scm_class_fraction; -SCM scm_class_unknown; -SCM scm_class_top, scm_class_object, scm_class_class; -SCM scm_class_applicable; -SCM scm_class_applicable_struct, scm_class_applicable_struct_with_setter; -SCM scm_class_generic, scm_class_generic_with_setter; -SCM scm_class_accessor; -SCM scm_class_extended_generic, scm_class_extended_generic_with_setter; -SCM scm_class_extended_accessor; -SCM scm_class_method; -SCM scm_class_accessor_method; -SCM scm_class_procedure_class; -SCM scm_class_applicable_struct_class; -SCM scm_class_number, scm_class_list; -SCM scm_class_keyword; -SCM scm_class_port, scm_class_input_output_port; -SCM scm_class_input_port, scm_class_output_port; -SCM scm_class_foreign_slot; -SCM scm_class_self, scm_class_protected; -SCM scm_class_hidden, scm_class_opaque, scm_class_read_only; -SCM scm_class_protected_hidden, scm_class_protected_opaque, scm_class_protected_read_only; -SCM scm_class_scm; -SCM scm_class_int, scm_class_float, scm_class_double; - -SCM *scm_port_class, *scm_smob_class; - -void -scm_init_deprecated_goops (void) -{ - var_slot_ref_using_class = scm_c_lookup ("slot-ref-using-class"); - var_slot_set_using_class_x = scm_c_lookup ("slot-set-using-class!"); - var_slot_bound_using_class_p = scm_c_lookup ("slot-bound-using-class?"); - var_slot_exists_using_class_p = scm_c_lookup ("slot-exists-using-class?"); - - scm_no_applicable_method = - scm_variable_ref (scm_c_lookup ("no-applicable-method")); - - var_get_keyword = scm_c_lookup ("get-keyword"); - - scm_class_class = scm_variable_ref (scm_c_lookup ("")); - scm_class_top = scm_variable_ref (scm_c_lookup ("")); - scm_class_object = scm_variable_ref (scm_c_lookup ("")); - - scm_class_foreign_slot = scm_variable_ref (scm_c_lookup ("")); - scm_class_protected = scm_variable_ref (scm_c_lookup ("")); - scm_class_hidden = scm_variable_ref (scm_c_lookup ("")); - scm_class_opaque = scm_variable_ref (scm_c_lookup ("")); - scm_class_read_only = scm_variable_ref (scm_c_lookup ("")); - scm_class_self = scm_variable_ref (scm_c_lookup ("")); - scm_class_protected_opaque = scm_variable_ref (scm_c_lookup ("")); - scm_class_protected_hidden = scm_variable_ref (scm_c_lookup ("")); - scm_class_protected_read_only = scm_variable_ref (scm_c_lookup ("")); - scm_class_scm = scm_variable_ref (scm_c_lookup ("")); - scm_class_int = scm_variable_ref (scm_c_lookup ("")); - scm_class_float = scm_variable_ref (scm_c_lookup ("")); - scm_class_double = scm_variable_ref (scm_c_lookup ("")); - - /* scm_class_generic functions classes */ - scm_class_procedure_class = scm_variable_ref (scm_c_lookup ("")); - scm_class_applicable_struct_class = scm_variable_ref (scm_c_lookup ("")); - - scm_class_method = scm_variable_ref (scm_c_lookup ("")); - scm_class_accessor_method = scm_variable_ref (scm_c_lookup ("")); - scm_class_applicable = scm_variable_ref (scm_c_lookup ("")); - scm_class_applicable_struct = scm_variable_ref (scm_c_lookup ("")); - scm_class_applicable_struct_with_setter = scm_variable_ref (scm_c_lookup ("")); - scm_class_generic = scm_variable_ref (scm_c_lookup ("")); - scm_class_extended_generic = scm_variable_ref (scm_c_lookup ("")); - scm_class_generic_with_setter = scm_variable_ref (scm_c_lookup ("")); - scm_class_accessor = scm_variable_ref (scm_c_lookup ("")); - scm_class_extended_generic_with_setter = scm_variable_ref (scm_c_lookup ("")); - scm_class_extended_accessor = scm_variable_ref (scm_c_lookup ("")); - - /* Primitive types classes */ - scm_class_boolean = scm_variable_ref (scm_c_lookup ("")); - scm_class_char = scm_variable_ref (scm_c_lookup ("")); - scm_class_list = scm_variable_ref (scm_c_lookup ("")); - scm_class_pair = scm_variable_ref (scm_c_lookup ("")); - scm_class_null = scm_variable_ref (scm_c_lookup ("")); - scm_class_string = scm_variable_ref (scm_c_lookup ("")); - scm_class_symbol = scm_variable_ref (scm_c_lookup ("")); - scm_class_vector = scm_variable_ref (scm_c_lookup ("")); - scm_class_number = scm_variable_ref (scm_c_lookup ("")); - scm_class_complex = scm_variable_ref (scm_c_lookup ("")); - scm_class_real = scm_variable_ref (scm_c_lookup ("")); - scm_class_integer = scm_variable_ref (scm_c_lookup ("")); - scm_class_fraction = scm_variable_ref (scm_c_lookup ("")); - scm_class_keyword = scm_variable_ref (scm_c_lookup ("")); - scm_class_unknown = scm_variable_ref (scm_c_lookup ("")); - scm_class_procedure = scm_variable_ref (scm_c_lookup ("")); - scm_class_primitive_generic = scm_variable_ref (scm_c_lookup ("")); - scm_class_port = scm_variable_ref (scm_c_lookup ("")); - scm_class_input_port = scm_variable_ref (scm_c_lookup ("")); - scm_class_output_port = scm_variable_ref (scm_c_lookup ("")); - scm_class_input_output_port = scm_variable_ref (scm_c_lookup ("")); - - scm_smob_class = scm_i_smob_class; -} - -SCM -scm_get_keyword (SCM kw, SCM initargs, SCM default_value) -{ - scm_c_issue_deprecation_warning - ("scm_get_keyword is deprecated. Use `kw-arg-ref' from Scheme instead."); - - return scm_call_3 (scm_variable_ref (var_get_keyword), - kw, initargs, default_value); -} - -#define BUFFSIZE 32 /* big enough for most uses */ -#define SPEC_OF(x) \ - (scm_slot_ref (x, scm_slot_ref (x, scm_from_latin1_symbol ("specializers")))) -#define CPL_OF(x) \ - (scm_slot_ref (x, scm_slot_ref (x, scm_from_latin1_symbol ("cpl")))) - -static SCM -scm_i_vector2list (SCM l, long len) -{ - long j; - SCM z = scm_c_make_vector (len, SCM_UNDEFINED); - - for (j = 0; j < len; j++, l = SCM_CDR (l)) { - SCM_SIMPLE_VECTOR_SET (z, j, SCM_CAR (l)); - } - return z; -} - -static int -applicablep (SCM actual, SCM formal) -{ - /* We already know that the cpl is well formed. */ - return scm_is_true (scm_c_memq (formal, CPL_OF (actual))); -} - -static int -more_specificp (SCM m1, SCM m2, SCM const *targs) -{ - register SCM s1, s2; - register long i; - /* - * Note: - * m1 and m2 can have != length (i.e. one can be one element longer than the - * other when we have a dotted parameter list). For instance, with the call - * (M 1) - * with - * (define-method M (a . l) ....) - * (define-method M (a) ....) - * - * we consider that the second method is more specific. - * - * BTW, targs is an array of types. We don't need it's size since - * we already know that m1 and m2 are applicable (no risk to go past - * the end of this array). - * - */ - for (i=0, s1=SPEC_OF(m1), s2=SPEC_OF(m2); ; i++, s1=SCM_CDR(s1), s2=SCM_CDR(s2)) { - if (scm_is_null(s1)) return 1; - if (scm_is_null(s2)) return 0; - if (!scm_is_eq (SCM_CAR(s1), SCM_CAR(s2))) { - register SCM l, cs1 = SCM_CAR(s1), cs2 = SCM_CAR(s2); - - for (l = CPL_OF (targs[i]); ; l = SCM_CDR(l)) { - if (scm_is_eq (cs1, SCM_CAR (l))) - return 1; - if (scm_is_eq (cs2, SCM_CAR (l))) - return 0; - } - return 0;/* should not occur! */ - } - } - return 0; /* should not occur! */ -} - -static SCM -sort_applicable_methods (SCM method_list, long size, SCM const *targs) -{ - long i, j, incr; - SCM *v, vector = SCM_EOL; - SCM buffer[BUFFSIZE]; - SCM save = method_list; - scm_t_array_handle handle; - - /* For reasonably sized method_lists we can try to avoid all the - * consing and reorder the list in place... - * This idea is due to David McClain - */ - if (size <= BUFFSIZE) - { - for (i = 0; i < size; i++) - { - buffer[i] = SCM_CAR (method_list); - method_list = SCM_CDR (method_list); - } - v = buffer; - } - else - { - /* Too many elements in method_list to keep everything locally */ - vector = scm_i_vector2list (save, size); - v = scm_vector_writable_elements (vector, &handle, NULL, NULL); - } - - /* Use a simple shell sort since it is generally faster than qsort on - * small vectors (which is probably mostly the case when we have to - * sort a list of applicable methods). - */ - for (incr = size / 2; incr; incr /= 2) - { - for (i = incr; i < size; i++) - { - for (j = i - incr; j >= 0; j -= incr) - { - if (more_specificp (v[j], v[j+incr], targs)) - break; - else - { - SCM tmp = v[j + incr]; - v[j + incr] = v[j]; - v[j] = tmp; - } - } - } - } - - if (size <= BUFFSIZE) - { - /* We did it in locally, so restore the original list (reordered) in-place */ - for (i = 0, method_list = save; i < size; i++, v++) - { - SCM_SETCAR (method_list, *v); - method_list = SCM_CDR (method_list); - } - return save; - } - - /* If we are here, that's that we did it the hard way... */ - scm_array_handle_release (&handle); - return scm_vector_to_list (vector); -} - -SCM -scm_compute_applicable_methods (SCM gf, SCM args, long len, int find_method_p) -{ - register long i; - long count = 0; - SCM l, fl, applicable = SCM_EOL; - SCM save = args; - SCM buffer[BUFFSIZE]; - SCM const *types; - SCM *p; - SCM tmp = SCM_EOL; - scm_t_array_handle handle; - - scm_c_issue_deprecation_warning - ("scm_compute_applicable_methods is deprecated. Use " - "`compute-applicable-methods' from Scheme instead."); - - /* Build the list of arguments types */ - if (len >= BUFFSIZE) - { - tmp = scm_c_make_vector (len, SCM_UNDEFINED); - types = p = scm_vector_writable_elements (tmp, &handle, NULL, NULL); - - /* - note that we don't have to work to reset the generation - count. TMP is a new vector anyway, and it is found - conservatively. - */ - } - else - types = p = buffer; - - for ( ; !scm_is_null (args); args = SCM_CDR (args)) - *p++ = scm_class_of (SCM_CAR (args)); - - /* Build a list of all applicable methods */ - for (l = scm_generic_function_methods (gf); !scm_is_null (l); l = SCM_CDR (l)) - { - fl = SPEC_OF (SCM_CAR (l)); - for (i = 0; ; i++, fl = SCM_CDR (fl)) - { - if (SCM_INSTANCEP (fl) - /* We have a dotted argument list */ - || (i >= len && scm_is_null (fl))) - { /* both list exhausted */ - applicable = scm_cons (SCM_CAR (l), applicable); - count += 1; - break; - } - if (i >= len - || scm_is_null (fl) - || !applicablep (types[i], SCM_CAR (fl))) - break; - } - } - - if (len >= BUFFSIZE) - scm_array_handle_release (&handle); - - if (count == 0) - { - if (find_method_p) - return SCM_BOOL_F; - scm_call_2 (scm_no_applicable_method, gf, save); - /* if we are here, it's because no-applicable-method hasn't signaled an error */ - return SCM_BOOL_F; - } - - return (count == 1 - ? applicable - : sort_applicable_methods (applicable, count, types)); -} - -SCM_SYMBOL (sym_compute_applicable_methods, "compute-applicable-methods"); - -SCM -scm_find_method (SCM l) -#define FUNC_NAME "find-method" -{ - SCM gf; - long len = scm_ilength (l); - - if (len == 0) - SCM_WRONG_NUM_ARGS (); - - scm_c_issue_deprecation_warning - ("scm_find_method is deprecated. Use `compute-applicable-methods' " - "from Scheme instead."); - - gf = SCM_CAR(l); l = SCM_CDR(l); - SCM_VALIDATE_GENERIC (1, gf); - if (scm_is_null (scm_slot_ref (gf, scm_from_latin1_symbol ("methods")))) - SCM_MISC_ERROR ("no methods for generic ~S", scm_list_1 (gf)); - - return scm_compute_applicable_methods (gf, l, len - 1, 1); -} -#undef FUNC_NAME - -SCM -scm_basic_make_class (SCM meta, SCM name, SCM dsupers, SCM dslots) -{ - scm_c_issue_deprecation_warning - ("scm_basic_make_class is deprecated. Use `define-class' in Scheme," - "or use `(make META #:name NAME #:dsupers DSUPERS #:slots DSLOTS)' " - "in Scheme."); - - return scm_make_standard_class (meta, name, dsupers, dslots); -} - -/* Scheme will issue the deprecation warning for these. */ -SCM -scm_slot_ref_using_class (SCM class, SCM obj, SCM slot_name) -{ - return scm_call_3 (scm_variable_ref (var_slot_ref_using_class), - class, obj, slot_name); -} - -SCM -scm_slot_set_using_class_x (SCM class, SCM obj, SCM slot_name, SCM value) -{ - return scm_call_4 (scm_variable_ref (var_slot_set_using_class_x), - class, obj, slot_name, value); -} - -SCM -scm_slot_bound_using_class_p (SCM class, SCM obj, SCM slot_name) -{ - return scm_call_3 (scm_variable_ref (var_slot_bound_using_class_p), - class, obj, slot_name); -} - -SCM -scm_slot_exists_using_class_p (SCM class, SCM obj, SCM slot_name) -{ - return scm_call_3 (scm_variable_ref (var_slot_exists_using_class_p), - class, obj, slot_name); -} - - - -#define FETCH_STORE(fet,mem,sto) \ - do { \ - scm_i_scm_pthread_mutex_lock (&scm_i_misc_mutex); \ - (fet) = (mem); \ - (mem) = (sto); \ - scm_i_pthread_mutex_unlock (&scm_i_misc_mutex); \ - } while (0) - -static scm_t_bits scm_tc16_arbiter; - - -#define SCM_LOCK_VAL (scm_tc16_arbiter | (1L << 16)) -#define SCM_UNLOCK_VAL scm_tc16_arbiter -#define SCM_ARB_LOCKED(arb) ((SCM_CELL_WORD_0 (arb)) & (1L << 16)) - - -static int -arbiter_print (SCM exp, SCM port, scm_print_state *pstate) -{ - scm_puts ("#', port); - return !0; -} - -SCM_DEFINE (scm_make_arbiter, "make-arbiter", 1, 0, 0, - (SCM name), - "Return an arbiter object, initially unlocked. Currently\n" - "@var{name} is only used for diagnostic output.") -#define FUNC_NAME s_scm_make_arbiter -{ - scm_c_issue_deprecation_warning - ("Arbiters are deprecated. " - "Use mutexes or atomic variables instead."); - - SCM_RETURN_NEWSMOB (scm_tc16_arbiter, SCM_UNPACK (name)); -} -#undef FUNC_NAME - - -/* The atomic FETCH_STORE here is so two threads can't both see the arbiter - unlocked and return #t. The arbiter itself wouldn't be corrupted by - this, but two threads both getting #t would be contrary to the intended - semantics. */ - -SCM_DEFINE (scm_try_arbiter, "try-arbiter", 1, 0, 0, - (SCM arb), - "If @var{arb} is unlocked, then lock it and return @code{#t}.\n" - "If @var{arb} is already locked, then do nothing and return\n" - "@code{#f}.") -#define FUNC_NAME s_scm_try_arbiter -{ - scm_t_bits old; - scm_t_bits *loc; - SCM_VALIDATE_SMOB (1, arb, arbiter); - loc = (scm_t_bits*)SCM_SMOB_OBJECT_N_LOC (arb, 0); - FETCH_STORE (old, *loc, SCM_LOCK_VAL); - return scm_from_bool (old == SCM_UNLOCK_VAL); -} -#undef FUNC_NAME - - -/* The atomic FETCH_STORE here is so two threads can't both see the arbiter - locked and return #t. The arbiter itself wouldn't be corrupted by this, - but we don't want two threads both thinking they were the unlocker. The - intended usage is for the code which locked to be responsible for - unlocking, but we guarantee the return value even if multiple threads - compete. */ - -SCM_DEFINE (scm_release_arbiter, "release-arbiter", 1, 0, 0, - (SCM arb), - "If @var{arb} is locked, then unlock it and return @code{#t}.\n" - "If @var{arb} is already unlocked, then do nothing and return\n" - "@code{#f}.\n" - "\n" - "Typical usage is for the thread which locked an arbiter to\n" - "later release it, but that's not required, any thread can\n" - "release it.") -#define FUNC_NAME s_scm_release_arbiter -{ - scm_t_bits old; - scm_t_bits *loc; - SCM_VALIDATE_SMOB (1, arb, arbiter); - loc = (scm_t_bits*)SCM_SMOB_OBJECT_N_LOC (arb, 0); - FETCH_STORE (old, *loc, SCM_UNLOCK_VAL); - return scm_from_bool (old == SCM_LOCK_VAL); -} -#undef FUNC_NAME - - - - -/* User asyncs. */ - -static scm_t_bits tc16_async; - -/* cmm: this has SCM_ prefix because SCM_MAKE_VALIDATE expects it. - this is ugly. */ -#define SCM_ASYNCP(X) SCM_TYP16_PREDICATE (tc16_async, X) -#define VALIDATE_ASYNC(pos, a) SCM_MAKE_VALIDATE_MSG(pos, a, ASYNCP, "user async") - -#define ASYNC_GOT_IT(X) (SCM_SMOB_FLAGS (X)) -#define SET_ASYNC_GOT_IT(X, V) (SCM_SET_SMOB_FLAGS ((X), ((V)))) -#define ASYNC_THUNK(X) SCM_SMOB_OBJECT_1 (X) - - -SCM_DEFINE (scm_async, "async", 1, 0, 0, - (SCM thunk), - "Create a new async for the procedure @var{thunk}.") -#define FUNC_NAME s_scm_async -{ - scm_c_issue_deprecation_warning - ("\"User asyncs\" are deprecated. Use closures instead."); - - SCM_RETURN_NEWSMOB (tc16_async, SCM_UNPACK (thunk)); -} -#undef FUNC_NAME - -SCM_DEFINE (scm_async_mark, "async-mark", 1, 0, 0, - (SCM a), - "Mark the async @var{a} for future execution.") -#define FUNC_NAME s_scm_async_mark -{ - VALIDATE_ASYNC (1, a); - SET_ASYNC_GOT_IT (a, 1); - return SCM_UNSPECIFIED; -} -#undef FUNC_NAME - -SCM_DEFINE (scm_run_asyncs, "run-asyncs", 1, 0, 0, - (SCM list_of_a), - "Execute all thunks from the asyncs of the list @var{list_of_a}.") -#define FUNC_NAME s_scm_run_asyncs -{ - while (! SCM_NULL_OR_NIL_P (list_of_a)) - { - SCM a; - SCM_VALIDATE_CONS (1, list_of_a); - a = SCM_CAR (list_of_a); - VALIDATE_ASYNC (SCM_ARG1, a); - if (ASYNC_GOT_IT (a)) - { - SET_ASYNC_GOT_IT (a, 0); - scm_call_0 (ASYNC_THUNK (a)); - } - list_of_a = SCM_CDR (list_of_a); - } - return SCM_BOOL_T; -} -#undef FUNC_NAME - - -static scm_i_pthread_mutex_t critical_section_mutex; -static SCM dynwind_critical_section_mutex; - -void -scm_critical_section_start (void) -{ - scm_c_issue_deprecation_warning - ("Critical sections are deprecated. Instead use dynwinds and " - "\"scm_dynwind_pthread_mutex_lock\" together with " - "\"scm_dynwind_block_asyncs\" if appropriate."); - - scm_i_pthread_mutex_lock (&critical_section_mutex); - SCM_I_CURRENT_THREAD->block_asyncs++; -} - -void -scm_critical_section_end (void) -{ - SCM_I_CURRENT_THREAD->block_asyncs--; - scm_i_pthread_mutex_unlock (&critical_section_mutex); - scm_async_tick (); -} - -void -scm_dynwind_critical_section (SCM mutex) -{ - scm_c_issue_deprecation_warning - ("Critical sections are deprecated. Instead use dynwinds and " - "\"scm_dynwind_pthread_mutex_lock\" together with " - "\"scm_dynwind_block_asyncs\" if appropriate."); - - if (scm_is_false (mutex)) - mutex = dynwind_critical_section_mutex; - scm_dynwind_lock_mutex (mutex); - scm_dynwind_block_asyncs (); -} - - - - -SCM -scm_make_mutex_with_flags (SCM flags) -{ - SCM kind = SCM_UNDEFINED; - - scm_c_issue_deprecation_warning - ("'scm_make_mutex_with_flags' is deprecated. " - "Use 'scm_make_mutex_with_kind' instead."); - - if (!scm_is_null (flags)) - { - if (!scm_is_null (scm_cdr (flags))) - scm_misc_error (NULL, "too many mutex options: ~a", scm_list_1 (flags)); - kind = scm_car (flags); - } - - return scm_make_mutex_with_kind (kind); -} - -SCM -scm_lock_mutex_timed (SCM m, SCM timeout, SCM owner) -{ - scm_c_issue_deprecation_warning - ("'scm_lock_mutex_timed' is deprecated. " - "Use 'scm_timed_lock_mutex' instead."); - - if (!SCM_UNBNDP (owner) && !scm_is_false (owner)) - scm_c_issue_deprecation_warning - ("The 'owner' argument to 'scm_lock_mutex_timed' is deprecated. " - "Use SRFI-18 directly if you need this concept."); - - return scm_timed_lock_mutex (m, timeout); -} - -SCM -scm_unlock_mutex_timed (SCM mx, SCM cond, SCM timeout) -{ - scm_c_issue_deprecation_warning - ("'scm_unlock_mutex_timed' is deprecated. " - "Use just plain old 'scm_unlock_mutex' instead, or otherwise " - "'scm_wait_condition_variable' if you need to."); - - if (!SCM_UNBNDP (cond) && - scm_is_false (scm_timed_wait_condition_variable (cond, mx, timeout))) - return SCM_BOOL_F; - - return scm_unlock_mutex (mx); -} - - - -SCM -scm_from_contiguous_array (SCM bounds, const SCM *elts, size_t len) -#define FUNC_NAME "scm_from_contiguous_array" -{ - size_t k, rlen = 1; - scm_t_array_dim *s; - SCM ra; - scm_t_array_handle h; - - scm_c_issue_deprecation_warning - ("`scm_from_contiguous_array' is deprecated. Use make-array and array-copy!\n" - "instead.\n"); - - ra = scm_i_shap2ra (bounds); - SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra); - s = SCM_I_ARRAY_DIMS (ra); - k = SCM_I_ARRAY_NDIM (ra); - - while (k--) - { - s[k].inc = rlen; - SCM_ASSERT_RANGE (1, bounds, s[k].lbnd <= s[k].ubnd + 1); - rlen = (s[k].ubnd - s[k].lbnd + 1) * s[k].inc; - } - if (rlen != len) - SCM_MISC_ERROR ("element length and dimensions do not match", SCM_EOL); - - SCM_I_ARRAY_SET_V (ra, scm_c_make_vector (rlen, SCM_UNDEFINED)); - scm_array_get_handle (ra, &h); - memcpy (h.writable_elements, elts, rlen * sizeof(SCM)); - scm_array_handle_release (&h); - - if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra)) - if (0 == s->lbnd) - return SCM_I_ARRAY_V (ra); - return ra; -} -#undef FUNC_NAME - - - -/* {call-with-dynamic-root} - * - * Suspending the current thread to evaluate a thunk on the - * same C stack but under a new root. - * - * Calls to call-with-dynamic-root return exactly once (unless - * the process is somehow exitted). */ - -/* cwdr fills out both of these structures, and then passes a pointer - to them through scm_internal_catch to the cwdr_body and - cwdr_handler functions, to tell them how to behave and to get - information back from them. - - A cwdr is a lot like a catch, except there is no tag (all - exceptions are caught), and the body procedure takes the arguments - passed to cwdr as A1 and ARGS. The handler is also special since - it is not directly run from scm_internal_catch. It is executed - outside the new dynamic root. */ - -struct cwdr_body_data { - /* Arguments to pass to the cwdr body function. */ - SCM a1, args; - - /* Scheme procedure to use as body of cwdr. */ - SCM body_proc; -}; - -struct cwdr_handler_data { - /* Do we need to run the handler? */ - int run_handler; - - /* The tag and args to pass it. */ - SCM tag, args; -}; - - -/* Invoke the body of a cwdr, assuming that the throw handler has - already been set up. DATA points to a struct set up by cwdr that - says what proc to call, and what args to apply it to. - - With a little thought, we could replace this with scm_body_thunk, - but I don't want to mess with that at the moment. */ -static SCM -cwdr_body (void *data) -{ - struct cwdr_body_data *c = (struct cwdr_body_data *) data; - - return scm_apply (c->body_proc, c->a1, c->args); -} - -/* Record the fact that the body of the cwdr has thrown. Record - enough information to invoke the handler later when the dynamic - root has been deestablished. */ - -static SCM -cwdr_handler (void *data, SCM tag, SCM args) -{ - struct cwdr_handler_data *c = (struct cwdr_handler_data *) data; - - c->run_handler = 1; - c->tag = tag; - c->args = args; - return SCM_UNSPECIFIED; -} - -SCM -scm_internal_cwdr (scm_t_catch_body body, void *body_data, - scm_t_catch_handler handler, void *handler_data, - SCM_STACKITEM *stack_start) -{ - struct cwdr_handler_data my_handler_data; - scm_t_dynstack *dynstack = &SCM_I_CURRENT_THREAD->dynstack; - SCM answer; - scm_t_dynstack *old_dynstack; - - /* Exit caller's dynamic state. - */ - old_dynstack = scm_dynstack_capture_all (dynstack); - scm_dynstack_unwind (dynstack, SCM_DYNSTACK_FIRST (dynstack)); - - scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE); - scm_dynwind_current_dynamic_state (scm_current_dynamic_state ()); - - my_handler_data.run_handler = 0; - answer = scm_i_with_continuation_barrier (body, body_data, - cwdr_handler, &my_handler_data, - NULL, NULL); - - scm_dynwind_end (); - - /* Enter caller's dynamic state. - */ - scm_dynstack_wind (dynstack, SCM_DYNSTACK_FIRST (old_dynstack)); - - /* Now run the real handler iff the body did a throw. */ - if (my_handler_data.run_handler) - return handler (handler_data, my_handler_data.tag, my_handler_data.args); - else - return answer; -} - -/* The original CWDR for invoking Scheme code with a Scheme handler. */ - -static SCM -cwdr (SCM proc, SCM a1, SCM args, SCM handler, SCM_STACKITEM *stack_start) -{ - struct cwdr_body_data c; - - c.a1 = a1; - c.args = args; - c.body_proc = proc; - - return scm_internal_cwdr (cwdr_body, &c, - scm_handle_by_proc, &handler, - stack_start); -} - -SCM_DEFINE (scm_call_with_dynamic_root, "call-with-dynamic-root", 2, 0, 0, - (SCM thunk, SCM handler), - "Call @var{thunk} with a new dynamic state and within\n" - "a continuation barrier. The @var{handler} catches all\n" - "otherwise uncaught throws and executes within the same\n" - "dynamic context as @var{thunk}.") -#define FUNC_NAME s_scm_call_with_dynamic_root -{ - SCM_STACKITEM stack_place; - scm_c_issue_deprecation_warning - ("call-with-dynamic-root is deprecated. There is no replacement."); - return cwdr (thunk, SCM_EOL, SCM_EOL, handler, &stack_place); -} -#undef FUNC_NAME - -SCM_DEFINE (scm_dynamic_root, "dynamic-root", 0, 0, 0, - (), - "Return an object representing the current dynamic root.\n\n" - "These objects are only useful for comparison using @code{eq?}.\n") -#define FUNC_NAME s_scm_dynamic_root -{ - scm_c_issue_deprecation_warning - ("dynamic-root is deprecated. There is no replacement."); - return SCM_I_CURRENT_THREAD->continuation_root; -} -#undef FUNC_NAME - -SCM -scm_apply_with_dynamic_root (SCM proc, SCM a1, SCM args, SCM handler) -{ - SCM_STACKITEM stack_place; - scm_c_issue_deprecation_warning - ("scm_apply_with_dynamic_root is deprecated. There is no replacement."); - return cwdr (proc, a1, args, handler, &stack_place); -} - - - - -SCM -scm_make_dynamic_state (SCM parent) -{ - scm_c_issue_deprecation_warning - ("scm_make_dynamic_state is deprecated. Dynamic states are " - "now immutable; just use the parent directly."); - return SCM_UNBNDP (parent) ? scm_current_dynamic_state () : parent; -} - - - - -int -SCM_FDES_RANDOM_P (int fdes) -{ - scm_c_issue_deprecation_warning - ("SCM_FDES_RANDOM_P is deprecated. Use lseek (fd, 0, SEEK_CUR)."); - - return (lseek (fdes, 0, SEEK_CUR) == -1) ? 0 : 1; -} +/* Newly deprecated code goes here. */ void scm_i_init_deprecated () { - scm_tc16_arbiter = scm_make_smob_type ("arbiter", 0); - scm_set_smob_print (scm_tc16_arbiter, arbiter_print); - tc16_async = scm_make_smob_type ("async", 0); - scm_i_pthread_mutex_init (&critical_section_mutex, - scm_i_pthread_mutexattr_recursive); - dynwind_critical_section_mutex = scm_make_recursive_mutex (); #include "libguile/deprecated.x" } -#endif +#endif /* SCM_ENABLE_DEPRECATD == 1 */ diff --git a/libguile/deprecated.h b/libguile/deprecated.h index 2c49076a1..af5e901d7 100644 --- a/libguile/deprecated.h +++ b/libguile/deprecated.h @@ -1,11 +1,7 @@ -/* This file contains definitions for deprecated features. When you - deprecate something, move it here when that is feasible. -*/ - #ifndef SCM_DEPRECATED_H #define SCM_DEPRECATED_H -/* Copyright (C) 2003,2004, 2005, 2006, 2007, 2009, 2010, 2011, 2012, 2013, 2014, 2015 Free Software Foundation, Inc. +/* Copyright (C) 2003-2007, 2009-2017 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -24,255 +20,10 @@ */ #include "libguile/__scm.h" -#include "libguile/strings.h" -#include "libguile/eval.h" -#include "libguile/throw.h" -#include "libguile/iselect.h" #if (SCM_ENABLE_DEPRECATED == 1) -/* Deprecated 13-05-2011 because it's better just to scm_dynwind_begin. - That also avoids the temptation to stuff pointers in an SCM. */ - -typedef SCM (*scm_t_inner) (void *); -SCM_DEPRECATED SCM scm_internal_dynamic_wind (scm_t_guard before, - scm_t_inner inner, - scm_t_guard after, - void *inner_data, - void *guard_data); - - -/* Deprecated 15-05-2011 because it's better to be explicit with the - `return'. Code is more readable that way. */ -#define SCM_WTA_DISPATCH_0(gf, subr) \ - return scm_wta_dispatch_0 ((gf), (subr)) -#define SCM_WTA_DISPATCH_1(gf, a1, pos, subr) \ - return scm_wta_dispatch_1 ((gf), (a1), (pos), (subr)) -#define SCM_WTA_DISPATCH_2(gf, a1, a2, pos, subr) \ - return scm_wta_dispatch_2 ((gf), (a1), (a2), (pos), (subr)) -#define SCM_WTA_DISPATCH_N(gf, args, pos, subr) \ - return scm_wta_dispatch_n ((gf), (args), (pos), (subr)) - -/* Deprecated 15-05-2011 because this idiom is not very readable. */ -#define SCM_GASSERT0(cond, gf, subr) \ - if (SCM_UNLIKELY (!(cond))) \ - return scm_wta_dispatch_0 ((gf), (subr)) -#define SCM_GASSERT1(cond, gf, a1, pos, subr) \ - if (SCM_UNLIKELY (!(cond))) \ - return scm_wta_dispatch_1 ((gf), (a1), (pos), (subr)) -#define SCM_GASSERT2(cond, gf, a1, a2, pos, subr) \ - if (SCM_UNLIKELY (!(cond))) \ - return scm_wta_dispatch_2 ((gf), (a1), (a2), (pos), (subr)) -#define SCM_GASSERTn(cond, gf, args, pos, subr) \ - if (SCM_UNLIKELY (!(cond))) \ - return scm_wta_dispatch_n ((gf), (args), (pos), (subr)) - -/* Deprecated 15-05-2011 because this is a one-off macro that does - strange things. */ -#define SCM_WTA_DISPATCH_1_SUBR(subr, a1, pos) \ - return (SCM_UNPACK ((*SCM_SUBR_GENERIC (subr))) \ - ? scm_call_1 ((*SCM_SUBR_GENERIC (subr)), (a1)) \ - : (scm_i_wrong_type_arg_symbol (SCM_SUBR_NAME (subr), (pos), (a1)), SCM_UNSPECIFIED)) - -#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_CHAR_CODE_LIMIT SCM_CHAR_CODE_LIMIT__GONE__REPLACE_WITH__256L -#define SCM_OPDIRP SCM_OPDIRP__GONE__REPLACE_WITH__SCM_DIRP_and_SCM_DIR_OPEN_P -#define SCM_PROCEDURE SCM_PROCEDURE__GONE__REPLACE_WITH__scm_procedure -#define SCM_PROCEDURE_WITH_SETTER_P SCM_PROCEDURE_WITH_SETTER_P__GONE__REPLACE_WITH__scm_is_true__scm_procedure_with_setter_p -#define SCM_SETTER SCM_SETTER__GONE__REPLACE_WITH__scm_setter -#define SCM_THREAD_SWITCHING_CODE SCM_THREAD_SWITCHING_CODE__GONE__REMOVE_FROM_YOUR_CODE -#define SCM_VALIDATE_NUMBER_COPY SCM_VALIDATE_NUMBER_COPY__GONE__REPLACE_WITH__SCM_VALIDATE_DOUBLE_COPY -#define SCM_VALIDATE_NUMBER_DEF_COPY SCM_VALIDATE_NUMBER_DEF_COPY__GONE__REPLACE_WITH__SCM_UNBNDP_and_SCM_VALIDATE_DOUBLE_COPY -#define SCM_VALIDATE_OPDIR SCM_VALIDATE_OPDIR__GONE -#define SCM_VALIDATE_STRING_COPY SCM_VALIDATE_STRING_COPY__GONE -#define SCM_VALIDATE_SUBSTRING_SPEC_COPY SCM_VALIDATE_SUBSTRING_SPEC_COPY__GONE -#define scm_array scm_array__GONE__REPLACE_WITH__scm_t_array -#define scm_array_dim scm_array_dim__GONE__REPLACE_WITH__scm_t_array_dim -#define scm_async_click scm_async_click__GONE__REPLACE_WITH__scm_async_tick -#define scm_call_generic_0 scm_call_generic_0__GONE__REPLACE_WITH__scm_call_0 -#define scm_call_generic_1 scm_call_generic_1__GONE__REPLACE_WITH__scm_call_1 -#define scm_call_generic_2 scm_call_generic_2__GONE__REPLACE_WITH__scm_call_2 -#define scm_call_generic_3 scm_call_generic_3__GONE__REPLACE_WITH__scm_call_3 -#define scm_apply_generic scm_apply_generic__GONE__REPLACE_WITH__scm_apply_0 -#define scm_fport scm_fport__GONE__REPLACE_WITH__scm_t_fport -#define scm_listify scm_listify__GONE__REPLACE_WITH__scm_list_n -#define scm_option scm_option__GONE__REPLACE_WITH__scm_t_option -#define scm_port scm_port__GONE__REPLACE_WITH__scm_t_port -#define scm_ptob_descriptor scm_ptob_descriptor__GONE__REPLACE_WITH__scm_t_port_type -#define scm_rng scm_rng__GONE__REPLACE_WITH__scm_t_rng -#define scm_rstate scm_rstate__GONE__REPLACE_WITH__scm_t_rstate -#define scm_sizet scm_sizet__GONE__REPLACE_WITH__size_t -#define scm_srcprops scm_srcprops__GONE__REPLACE_WITH__scm_t_srcprops -#define scm_srcprops_chunk scm_srcprops_chunk__GONE__REPLACE_WITH__scm_t_srcprops_chunk -#define scm_struct_i_flags scm_struct_i_flags__GONE__REPLACE_WITH__scm_vtable_index_flags -#define scm_struct_i_free scm_struct_i_free__GONE__REPLACE_WITH__scm_vtable_index_instance_finalize -#define scm_subr_entry scm_subr_entry__GONE__REPLACE_WITH__scm_t_subr_entry -#define scm_substring_move_left_x scm_substring_move_left_x__GONE__REPLACE_WITH__scm_substring_move_x -#define scm_substring_move_right_x scm_substring_move_right_x__GONE__REPLACE_WITH__scm_substring_move_x -#define scm_vtable_index_printer scm_vtable_index_printer__GONE__REPLACE_WITH__scm_vtable_index_instance_printer -#define scm_vtable_index_vtable scm_vtable_index_vtable__GONE__REPLACE_WITH__scm_vtable_index_self - -#ifndef BUILDING_LIBGUILE -#define SCM_ASYNC_TICK SCM_ASYNC_TICK__GONE__REPLACE_WITH__scm_async_tick -#endif - - - - -/* Deprecated 26-05-2011, as the GC_STUBBORN API doesn't do anything any - more. */ -SCM_DEPRECATED SCM scm_immutable_cell (scm_t_bits car, scm_t_bits cdr); -SCM_DEPRECATED SCM scm_immutable_double_cell (scm_t_bits car, scm_t_bits cbr, - scm_t_bits ccr, scm_t_bits cdr); - - - -SCM_DEPRECATED SCM scm_memory_alloc_key; -SCM_DEPRECATED void scm_memory_error (const char *subr) SCM_NORETURN; - - - -SCM_DEPRECATED SCM scm_no_applicable_method; - -SCM_DEPRECATED SCM scm_class_boolean; -SCM_DEPRECATED SCM scm_class_char; -SCM_DEPRECATED SCM scm_class_pair; -SCM_DEPRECATED SCM scm_class_procedure; -SCM_DEPRECATED SCM scm_class_string; -SCM_DEPRECATED SCM scm_class_symbol; -SCM_DEPRECATED SCM scm_class_primitive_generic; -SCM_DEPRECATED SCM scm_class_vector; -SCM_DEPRECATED SCM scm_class_null; -SCM_DEPRECATED SCM scm_class_real; -SCM_DEPRECATED SCM scm_class_complex; -SCM_DEPRECATED SCM scm_class_integer; -SCM_DEPRECATED SCM scm_class_fraction; -SCM_DEPRECATED SCM scm_class_unknown; -SCM_DEPRECATED SCM scm_class_top; -SCM_DEPRECATED SCM scm_class_object; -SCM_DEPRECATED SCM scm_class_class; -SCM_DEPRECATED SCM scm_class_applicable; -SCM_DEPRECATED SCM scm_class_applicable_struct; -SCM_DEPRECATED SCM scm_class_applicable_struct_with_setter; -SCM_DEPRECATED SCM scm_class_generic; -SCM_DEPRECATED SCM scm_class_generic_with_setter; -SCM_DEPRECATED SCM scm_class_accessor; -SCM_DEPRECATED SCM scm_class_extended_generic; -SCM_DEPRECATED SCM scm_class_extended_generic_with_setter; -SCM_DEPRECATED SCM scm_class_extended_accessor; -SCM_DEPRECATED SCM scm_class_method; -SCM_DEPRECATED SCM scm_class_accessor_method; -SCM_DEPRECATED SCM scm_class_procedure_class; -SCM_DEPRECATED SCM scm_class_applicable_struct_class; -SCM_DEPRECATED SCM scm_class_number; -SCM_DEPRECATED SCM scm_class_list; -SCM_DEPRECATED SCM scm_class_keyword; -SCM_DEPRECATED SCM scm_class_port; -SCM_DEPRECATED SCM scm_class_input_output_port; -SCM_DEPRECATED SCM scm_class_input_port; -SCM_DEPRECATED SCM scm_class_output_port; -SCM_DEPRECATED SCM scm_class_foreign_slot; -SCM_DEPRECATED SCM scm_class_self; -SCM_DEPRECATED SCM scm_class_protected; -SCM_DEPRECATED SCM scm_class_hidden; -SCM_DEPRECATED SCM scm_class_opaque; -SCM_DEPRECATED SCM scm_class_read_only; -SCM_DEPRECATED SCM scm_class_protected_hidden; -SCM_DEPRECATED SCM scm_class_protected_opaque; -SCM_DEPRECATED SCM scm_class_protected_read_only; -SCM_DEPRECATED SCM scm_class_scm; -SCM_DEPRECATED SCM scm_class_int; -SCM_DEPRECATED SCM scm_class_float; -SCM_DEPRECATED SCM scm_class_double; - -SCM_DEPRECATED SCM *scm_smob_class; - -SCM_INTERNAL void scm_init_deprecated_goops (void); - -SCM_DEPRECATED SCM scm_compute_applicable_methods (SCM gf, SCM args, long len, int scm_find_method); -SCM_DEPRECATED SCM scm_find_method (SCM l); -SCM_DEPRECATED SCM scm_basic_make_class (SCM c, SCM name, SCM dsupers, SCM dslots); -SCM_DEPRECATED SCM scm_get_keyword (SCM kw, SCM initargs, SCM default_value); -SCM_DEPRECATED SCM scm_slot_ref_using_class (SCM cls, SCM obj, SCM slot_name); -SCM_DEPRECATED SCM scm_slot_set_using_class_x (SCM cls, SCM obj, SCM slot_name, SCM value); -SCM_DEPRECATED SCM scm_slot_bound_using_class_p (SCM cls, SCM obj, SCM slot_name); -SCM_DEPRECATED SCM scm_slot_exists_using_class_p (SCM cls, SCM obj, SCM slot_name); - - - -SCM_DEPRECATED SCM scm_make_arbiter (SCM name); -SCM_DEPRECATED SCM scm_try_arbiter (SCM arb); -SCM_DEPRECATED SCM scm_release_arbiter (SCM arb); - - - -SCM_DEPRECATED SCM scm_async (SCM thunk); -SCM_DEPRECATED SCM scm_async_mark (SCM a); -SCM_DEPRECATED SCM scm_run_asyncs (SCM list_of_a); - - - -SCM_DEPRECATED void scm_critical_section_start (void); -SCM_DEPRECATED void scm_critical_section_end (void); -SCM_DEPRECATED void scm_dynwind_critical_section (SCM mutex); - -#define SCM_CRITICAL_SECTION_START scm_critical_section_start () -#define SCM_CRITICAL_SECTION_END scm_critical_section_end () - - - -SCM_DEPRECATED SCM scm_make_mutex_with_flags (SCM flags); -SCM_DEPRECATED SCM scm_unlock_mutex_timed (SCM mx, SCM cond, SCM timeout); -SCM_DEPRECATED SCM scm_lock_mutex_timed (SCM m, SCM timeout, SCM owner); - - - -SCM_DEPRECATED SCM scm_internal_cwdr (scm_t_catch_body body, - void *body_data, - scm_t_catch_handler handler, - void *handler_data, - SCM_STACKITEM *stack_start); -SCM_DEPRECATED SCM scm_call_with_dynamic_root (SCM thunk, SCM handler); -SCM_DEPRECATED SCM scm_dynamic_root (void); -SCM_DEPRECATED SCM scm_apply_with_dynamic_root (SCM proc, SCM a1, - SCM args, SCM handler); - - - -SCM_DEPRECATED SCM scm_make_dynamic_state (SCM parent); - - - -/* Deprecated 2016-11-18. Never documented. Unnecessary, since - array-copy! already unrolls and does it in more general cases. */ -/* With this also remove SCM_I_ARRAY_FLAG_CONTIGUOUS, - SCM_SET_ARRAY_CONTIGUOUS_FLAG, SCM_CLR_ARRAY_CONTIGUOUS_FLAG, - scm_i_ra_set_contp, and uses thereof. */ -SCM_DEPRECATED SCM scm_from_contiguous_array (SCM bounds, const SCM *elts, - size_t len); - - - -SCM_DEPRECATED int SCM_FDES_RANDOM_P (int fdes); - - +/* Deprecated declarations go here. */ void scm_i_init_deprecated (void); diff --git a/libguile/goops.c b/libguile/goops.c index a158a1cab..1e7639ef1 100644 --- a/libguile/goops.c +++ b/libguile/goops.c @@ -1054,10 +1054,6 @@ SCM_DEFINE (scm_sys_goops_loaded, "%goops-loaded", 0, 0, 0, var_change_class = scm_c_lookup ("change-class"); -#if (SCM_ENABLE_DEPRECATED == 1) - scm_init_deprecated_goops (); -#endif - return SCM_UNSPECIFIED; } #undef FUNC_NAME diff --git a/libguile/numbers.c b/libguile/numbers.c index 3e0efc8bb..39e2d622c 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -6089,14 +6089,7 @@ mem2ureal (SCM mem, unsigned int *p_idx, idx += 4; if (!scm_is_eq (mem2uinteger (mem, &idx, 10, &implicit_x), SCM_INUM0)) - { -#if SCM_ENABLE_DEPRECATED == 1 - scm_c_issue_deprecation_warning - ("Non-zero suffixes to `+nan.' are deprecated. Use `+nan.0'."); -#else - return SCM_BOOL_F; -#endif - } + return SCM_BOOL_F; *p_idx = idx; return scm_nan (); diff --git a/libguile/socket.c b/libguile/socket.c index 71c17e892..b28e01bca 100644 --- a/libguile/socket.c +++ b/libguile/socket.c @@ -58,11 +58,6 @@ #include "libguile/validate.h" #include "libguile/socket.h" -#if SCM_ENABLE_DEPRECATED == 1 -# include "libguile/deprecation.h" -#endif - - #if defined (HAVE_UNIX_DOMAIN_SOCKETS) && !defined (SUN_LEN) #define SUN_LEN(ptr) (offsetof (struct sockaddr_un, sun_path) \ diff --git a/libguile/srfi-13.c b/libguile/srfi-13.c index c77cba9b2..ff5e72150 100644 --- a/libguile/srfi-13.c +++ b/libguile/srfi-13.c @@ -3112,22 +3112,6 @@ SCM_DEFINE (scm_string_filter, "string-filter", 2, 2, 0, SCM result; size_t idx; -#if SCM_ENABLE_DEPRECATED == 1 - if (scm_is_string (char_pred)) - { - SCM tmp; - - scm_c_issue_deprecation_warning - ("Guile used to use the wrong argument order for string-filter.\n" - "This call to string-filter had the arguments in the wrong order.\n" - "See SRFI-13 for more details. At some point we will remove this hack."); - - tmp = char_pred; - char_pred = s; - s = tmp; - } -#endif - MY_VALIDATE_SUBSTRING_SPEC (2, s, 3, start, cstart, 4, end, cend); @@ -3245,22 +3229,6 @@ SCM_DEFINE (scm_string_delete, "string-delete", 2, 2, 0, SCM result; size_t idx; -#if SCM_ENABLE_DEPRECATED == 1 - if (scm_is_string (char_pred)) - { - SCM tmp; - - scm_c_issue_deprecation_warning - ("Guile used to use the wrong argument order for string-delete.\n" - "This call to string-filter had the arguments in the wrong order.\n" - "See SRFI-13 for more details. At some point we will remove this hack."); - - tmp = char_pred; - char_pred = s; - s = tmp; - } -#endif - MY_VALIDATE_SUBSTRING_SPEC (2, s, 3, start, cstart, 4, end, cend); diff --git a/module/Makefile.am b/module/Makefile.am index d5896bdd8..8a8eab583 100644 --- a/module/Makefile.am +++ b/module/Makefile.am @@ -54,7 +54,6 @@ SOURCES = \ ice-9/common-list.scm \ ice-9/control.scm \ ice-9/curried-definitions.scm \ - ice-9/debug.scm \ ice-9/deprecated.scm \ ice-9/documentation.scm \ ice-9/eval-string.scm \ @@ -75,7 +74,6 @@ SOURCES = \ ice-9/list.scm \ ice-9/local-eval.scm \ ice-9/ls.scm \ - ice-9/mapping.scm \ ice-9/match.scm \ ice-9/networking.scm \ ice-9/null.scm \ @@ -113,7 +111,6 @@ SOURCES = \ ice-9/streams.scm \ ice-9/string-fun.scm \ ice-9/suspendable-ports.scm \ - ice-9/syncase.scm \ ice-9/textual-ports.scm \ ice-9/threads.scm \ ice-9/time.scm \ diff --git a/module/ice-9/debug.scm b/module/ice-9/debug.scm deleted file mode 100644 index 380b04595..000000000 --- a/module/ice-9/debug.scm +++ /dev/null @@ -1,25 +0,0 @@ -;;;; Copyright (C) 1996, 1997, 1998, 1999, 2001, 2006, 2010 Free Software Foundation -;;;; -;;;; This library is free software; you can redistribute it and/or -;;;; modify it under the terms of the GNU Lesser General Public -;;;; License as published by the Free Software Foundation; either -;;;; version 3 of the License, or (at your option) any later version. -;;;; -;;;; This library is distributed in the hope that it will be useful, -;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;;;; Lesser General Public License for more details. -;;;; -;;;; You should have received a copy of the GNU Lesser General Public -;;;; License along with this library; if not, write to the Free Software -;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -;;;; -;;;; The author can be reached at djurfeldt@nada.kth.se -;;;; Mikael Djurfeldt, SANS/NADA KTH, 10044 STOCKHOLM, SWEDEN -;;;; - - -(define-module (ice-9 debug)) - -(issue-deprecation-warning - "(ice-9 debug) is deprecated. Use (system vm trace) for tracing.") diff --git a/module/ice-9/deprecated.scm b/module/ice-9/deprecated.scm index 2f41686ac..597ca8b4d 100644 --- a/module/ice-9/deprecated.scm +++ b/module/ice-9/deprecated.scm @@ -15,79 +15,4 @@ ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA ;;;; -(define-module (ice-9 deprecated) - #:use-module ((ice-9 threads) #:prefix threads:)) - -(define-syntax-rule (define-deprecated var msg exp) - (begin - (define-syntax var - (lambda (x) - (issue-deprecation-warning msg) - (syntax-case x () - ((id arg (... ...)) #'(let ((x id)) (x arg (... ...)))) - (id (identifier? #'id) #'exp)))) - (export var))) - -(define-deprecated _IONBF - "`_IONBF' is deprecated. Use the symbol 'none instead." - 'none) -(define-deprecated _IOLBF - "`_IOLBF' is deprecated. Use the symbol 'line instead." - 'line) -(define-deprecated _IOFBF - "`_IOFBF' is deprecated. Use the symbol 'block instead." - 'block) - -(define-syntax define-deprecated/threads - (lambda (stx) - (define (threads-name id) - (datum->syntax id (symbol-append 'threads: (syntax->datum id)))) - (syntax-case stx () - ((_ name) - (with-syntax ((name* (threads-name #'name)) - (warning (string-append - "Import (ice-9 threads) to have access to `" - (symbol->string (syntax->datum #'name)) "'."))) - #'(define-deprecated name warning name*)))))) - -(define-syntax-rule (define-deprecated/threads* name ...) - (begin (define-deprecated/threads name) ...)) - -(define-deprecated/threads* - call-with-new-thread - yield - cancel-thread - join-thread - thread? - make-mutex - make-recursive-mutex - lock-mutex - try-mutex - unlock-mutex - mutex? - mutex-owner - mutex-level - mutex-locked? - make-condition-variable - wait-condition-variable - signal-condition-variable - broadcast-condition-variable - condition-variable? - current-thread - all-threads - thread-exited? - total-processor-count - current-processor-count) - -(define-public make-dynamic-state - (case-lambda - (() - (issue-deprecation-warning - "`(make-dynamic-state)' is deprecated; use `(current-dynamic-state)' -instead.") - (current-dynamic-state)) - ((parent) - (issue-deprecation-warning - "`(make-dynamic-state PARENT)' is deprecated; now that reified -dynamic state objects are themselves copies, just use PARENT directly.") - parent))) +(define-module (ice-9 deprecated)) diff --git a/module/ice-9/format.scm b/module/ice-9/format.scm index 1ef4cb5ef..e7258a1e2 100644 --- a/module/ice-9/format.scm +++ b/module/ice-9/format.scm @@ -45,11 +45,6 @@ ((not destination) (open-output-string)) ((boolean? destination) (current-output-port)) ; boolean but not false ((output-port? destination) destination) - ((number? destination) - (issue-deprecation-warning - "Passing a number to format as the port is deprecated." - "Pass (current-error-port) instead.") - (current-error-port)) (else (error "format: bad destination `~a'" destination)))) @@ -1603,24 +1598,5 @@ (close-port port) str))))))) -(begin-deprecated - (set! format - (let ((format format)) - (case-lambda - ((destination format-string . args) - (if (string? destination) - (begin - (issue-deprecation-warning - "Omitting the destination on a call to format is deprecated." - "Pass #f as the destination, before the format string.") - (apply format #f destination format-string args)) - (apply format destination format-string args))) - ((deprecated-format-string-only) - (issue-deprecation-warning - "Omitting the destination port on a call to format is deprecated." - "Pass #f as the destination port, before the format string.") - (format #f deprecated-format-string-only)))))) - - ;; Thanks to Shuji Narazaki (module-set! the-root-module 'format format) diff --git a/module/ice-9/mapping.scm b/module/ice-9/mapping.scm deleted file mode 100644 index bd4dbfbd3..000000000 --- a/module/ice-9/mapping.scm +++ /dev/null @@ -1,118 +0,0 @@ -;;; installed-scm-file - -;;;; Copyright (C) 1996, 2001, 2006, 2013 Free Software Foundation, Inc. -;;;; -;;;; This library is free software; you can redistribute it and/or -;;;; modify it under the terms of the GNU Lesser General Public -;;;; License as published by the Free Software Foundation; either -;;;; version 3 of the License, or (at your option) any later version. -;;;; -;;;; This library is distributed in the hope that it will be useful, -;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;;;; Lesser General Public License for more details. -;;;; -;;;; You should have received a copy of the GNU Lesser General Public -;;;; License along with this library; if not, write to the Free Software -;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -;;;; - - - -(define-module (ice-9 mapping) - :use-module (ice-9 poe) - :export (mapping-hooks-type make-mapping-hooks mapping-hooks? - mapping-hooks-get-handle mapping-hooks-create-handle - mapping-hooks-remove mapping-type make-mapping mapping? - mapping-hooks mapping-data set-mapping-hooks! set-mapping-data! - mapping-get-handle mapping-create-handle! mapping-remove! - mapping-ref mapping-set! hash-table-mapping-hooks - make-hash-table-mapping hash-table-mapping)) - -(issue-deprecation-warning - "(ice-9 mapping) is deprecated. Use srfi-69 or rnrs hash tables instead.") - -(define mapping-hooks-type (make-record-type 'mapping-hooks '(get-handle - create-handle - remove))) - - -(define make-mapping-hooks (perfect-funcq 17 (record-constructor mapping-hooks-type))) -(define mapping-hooks? (record-predicate mapping-hooks-type)) -(define mapping-hooks-get-handle (record-accessor mapping-hooks-type 'get-handle)) -(define mapping-hooks-create-handle (record-accessor mapping-hooks-type 'create-handle)) -(define mapping-hooks-remove (record-accessor mapping-hooks-type 'remove)) - -(define mapping-type (make-record-type 'mapping '(hooks data))) -(define make-mapping (record-constructor mapping-type)) -(define mapping? (record-predicate mapping-type)) -(define mapping-hooks (record-accessor mapping-type 'hooks)) -(define mapping-data (record-accessor mapping-type 'data)) -(define set-mapping-hooks! (record-modifier mapping-type 'hooks)) -(define set-mapping-data! (record-modifier mapping-type 'data)) - -(define (mapping-get-handle map key) - ((mapping-hooks-get-handle (mapping-hooks map)) map key)) -(define (mapping-create-handle! map key init) - ((mapping-hooks-create-handle (mapping-hooks map)) map key init)) -(define (mapping-remove! map key) - ((mapping-hooks-remove (mapping-hooks map)) map key)) - -(define* (mapping-ref map key #:optional dflt) - (cond - ((mapping-get-handle map key) => cdr) - (else dflt))) - -(define (mapping-set! map key val) - (set-cdr! (mapping-create-handle! map key #f) val)) - - - -(define hash-table-mapping-hooks - (let ((wrap (lambda (proc) (lambda (1st . rest) (apply proc (mapping-data 1st) rest))))) - - (perfect-funcq 17 - (lambda (hash-proc assoc-proc) - (let ((procs (list hash-proc assoc-proc))) - (cond - ((equal? procs `(,hashq ,assq)) - (make-mapping-hooks (wrap hashq-get-handle) - (wrap hashq-create-handle!) - (wrap hashq-remove!))) - ((equal? procs `(,hashv ,assv)) - (make-mapping-hooks (wrap hashv-get-handle) - (wrap hashv-create-handle!) - (wrap hashv-remove!))) - ((equal? procs `(,hash ,assoc)) - (make-mapping-hooks (wrap hash-get-handle) - (wrap hash-create-handle!) - (wrap hash-remove!))) - (else - (make-mapping-hooks (wrap - (lambda (table key) - (hashx-get-handle hash-proc assoc-proc table key))) - (wrap - (lambda (table key init) - (hashx-create-handle! hash-proc assoc-proc table key init))) - (wrap - (lambda (table key) - (hashx-remove! hash-proc assoc-proc table key))))))))))) - -(define (make-hash-table-mapping table hash-proc assoc-proc) - (make-mapping (hash-table-mapping-hooks hash-proc assoc-proc) table)) - -(define* (hash-table-mapping #:optional (size 71) #:key - (hash-proc hash) - (assoc-proc - (or (assq-ref `((,hashq . ,assq) - (,hashv . ,assv) - (,hash . ,assoc)) - hash-proc) - (error 'hash-table-mapping - "Hash-procedure specified with no known assoc function." - hash-proc))) - (table-constructor - (lambda (len) (make-vector len '())))) - (make-hash-table-mapping (table-constructor size) - hash-proc - assoc-proc)) diff --git a/module/ice-9/syncase.scm b/module/ice-9/syncase.scm deleted file mode 100644 index 219803ef0..000000000 --- a/module/ice-9/syncase.scm +++ /dev/null @@ -1,37 +0,0 @@ -;;;; Copyright (C) 1997, 2000, 2001, 2002, 2003, 2006, 2010 Free Software Foundation, Inc. -;;;; -;;;; This library is free software; you can redistribute it and/or -;;;; modify it under the terms of the GNU Lesser General Public -;;;; License as published by the Free Software Foundation; either -;;;; version 3 of the License, or (at your option) any later version. -;;;; -;;;; This library is distributed in the hope that it will be useful, -;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;;;; Lesser General Public License for more details. -;;;; -;;;; You should have received a copy of the GNU Lesser General Public -;;;; License along with this library; if not, write to the Free Software -;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -;;;; - - -(define-module (ice-9 syncase) - ;; FIXME re-export other procs - #:export (datum->syntax-object syntax-object->datum - sc-expand)) - -(issue-deprecation-warning - "Syntax-case macros are now a part of Guile core; importing (ice-9 syncase) is no longer necessary.") - -(define datum->syntax-object datum->syntax) -(define syntax-object->datum syntax->datum) -(define sc-expand macroexpand) - -;;; Hack to make syncase macros work in the slib module -;; FIXME wingo is this still necessary? -;; (let ((m (nested-ref the-root-module '(%app modules ice-9 slib)))) -;; (if m -;; (set-object-property! (module-local-variable m 'define) -;; '*sc-expander* -;; '(define)))) diff --git a/module/oop/goops.scm b/module/oop/goops.scm index a46918062..c78d0bd3c 100644 --- a/module/oop/goops.scm +++ b/module/oop/goops.scm @@ -1188,39 +1188,6 @@ function." #f) (%class-slot-definition (class-of obj) slot-name have-slot no-slot)) -(begin-deprecated - (define (check-slot-args class obj slot-name) - (unless (eq? class (class-of obj)) - (scm-error 'wrong-type-arg #f "~S is not the class of ~S" - (list class obj) #f)) - (unless (symbol? slot-name) - (scm-error 'wrong-type-arg #f "Not a symbol: ~S" - (list slot-name) #f))) - - (define (slot-ref-using-class class obj slot-name) - (issue-deprecation-warning "slot-ref-using-class is deprecated. " - "Use slot-ref instead.") - (check-slot-args class obj slot-name) - (slot-ref obj slot-name)) - - (define (slot-set-using-class! class obj slot-name value) - (issue-deprecation-warning "slot-set-using-class! is deprecated. " - "Use slot-set! instead.") - (check-slot-args class obj slot-name) - (slot-set! obj slot-name value)) - - (define (slot-bound-using-class? class obj slot-name) - (issue-deprecation-warning "slot-bound-using-class? is deprecated. " - "Use slot-bound? instead.") - (check-slot-args class obj slot-name) - (slot-bound? obj slot-name)) - - (define (slot-exists-using-class? class obj slot-name) - (issue-deprecation-warning "slot-exists-using-class? is deprecated. " - "Use slot-exists? instead.") - (check-slot-args class obj slot-name) - (slot-exists? obj slot-name))) - @@ -3097,10 +3064,6 @@ var{initargs}." ;;; {SMOB and port classes} ;;; -(begin-deprecated - (define-public (find-subclass ')) - (define-public (find-subclass '))) - (define (find-subclass ')) (define (find-subclass ')) (define (find-subclass ')) diff --git a/module/statprof.scm b/module/statprof.scm index 59a2f12d0..9f2179b06 100644 --- a/module/statprof.scm +++ b/module/statprof.scm @@ -65,7 +65,6 @@ statprof-display statprof-display-anomalies - statprof-display-anomolies ; Deprecated spelling. statprof-fetch-stacks statprof-fetch-call-tree @@ -677,11 +676,6 @@ statistics.@code{}" (format #t "Total time: ~A\n" (statprof-accumulated-time state)) (format #t "Sample count: ~A\n" (statprof-sample-count state))) -(define (statprof-display-anomolies) - (issue-deprecation-warning "statprof-display-anomolies is a misspelling. " - "Use statprof-display-anomalies instead.") - (statprof-display-anomalies)) - (define* (statprof-accumulated-time #:optional (state (existing-profiler-state))) "Returns the time accumulated during the last statprof run.@code{}" @@ -895,49 +889,6 @@ operation is somewhat expensive." (statprof-stop state) (statprof-display port state #:style display-style)))))) -(begin-deprecated - (define-macro (with-statprof . args) - "Profile the expressions in the body, and return the body's return values. - -Keyword arguments: - -@table @code -@item #:display-style -Set the display style, either @code{'flat} or @code{'tree}. - -@item #:loop -Execute the body @var{loop} number of times, or @code{#f} for no looping - -default: @code{#f} -@item #:hz -Sampling rate - -default: @code{20} -@item #:count-calls? -Whether to instrument each function call (expensive) - -default: @code{#f} -@end table" - (define (kw-arg-ref kw args def) - (cond - ((null? args) (error "Invalid macro body")) - ((keyword? (car args)) - (if (eq? (car args) kw) - (cadr args) - (kw-arg-ref kw (cddr args) def))) - ((eq? kw #f def) ;; asking for the body - args) - (else def))) ;; kw not found - (issue-deprecation-warning - "`with-statprof' is deprecated. Use `statprof' instead.") - `((@ (statprof) statprof) - (lambda () ,@(kw-arg-ref #f args #f)) - #:display-style ,(kw-arg-ref #:display-style args ''flat) - #:loop ,(kw-arg-ref #:loop args 1) - #:hz ,(kw-arg-ref #:hz args 100) - #:count-calls? ,(kw-arg-ref #:count-calls? args #f))) - (export with-statprof)) - (define* (gcprof thunk #:key (loop 1) full-stacks? (port (current-output-port))) "Do an allocation profile of the execution of @var{thunk}. diff --git a/module/texinfo/reflection.scm b/module/texinfo/reflection.scm index d85f61239..50cb2ab05 100644 --- a/module/texinfo/reflection.scm +++ b/module/texinfo/reflection.scm @@ -288,16 +288,11 @@ (else (lp (cdr forms)))))) (define* (module-stexi-documentation sym-name - #:optional %docs-resolver #:key (docs-resolver - (or %docs-resolver - (lambda (name def) def)))) + (lambda (name def) def))) "Return documentation for the module named @var{sym-name}. The documentation will be formatted as @code{stexi} (@pxref{texinfo,texinfo})." - (if %docs-resolver - (issue-deprecation-warning - "module-stexi-documentation: use #:docs-resolver instead of a positional argument.")) (let* ((commentary (and=> (module-commentary sym-name) (lambda (x) (string-trim-both x #\newline)))) (stexi (string->stexi commentary)) diff --git a/module/web/client.scm b/module/web/client.scm index 3b7ea5156..c13117dd2 100644 --- a/module/web/client.scm +++ b/module/web/client.scm @@ -48,7 +48,6 @@ #:export (current-http-proxy open-socket-for-uri http-get - http-get* http-head http-post http-put @@ -381,9 +380,7 @@ as is the case by default with a request returned by `build-request'." (body #f) (port (open-socket-for-uri uri)) (version '(1 . 1)) (keep-alive? #f) - ;; #:headers is the new name of #:extra-headers. - (extra-headers #f) (headers (or extra-headers '())) - (decode-body? #t) (streaming? #f)) + (headers '()) (decode-body? #t) (streaming? #f)) "Connect to the server corresponding to URI and ask for the resource, using the ‘GET’ method. If you already have a port open, pass it as PORT. The port will be closed at the end of the @@ -410,30 +407,11 @@ response body has been read. Returns two values: the response read from the server, and the response body as a string, bytevector, #f value, or as a port (if STREAMING? is true)." - (when extra-headers - (issue-deprecation-warning - "The #:extra-headers argument to http-get has been renamed to #:headers. " - "Please update your code.")) (request uri #:method 'GET #:body body #:port port #:version version #:keep-alive? keep-alive? #:headers headers #:decode-body? decode-body? #:streaming? streaming?)) -(define* (http-get* uri #:key - (body #f) - (port (open-socket-for-uri uri)) - (version '(1 . 1)) (keep-alive? #f) - ;; #:headers is the new name of #:extra-headers. - (extra-headers #f) (headers (or extra-headers '())) - (decode-body? #t)) - "Deprecated in favor of (http-get #:streaming? #t)." - (issue-deprecation-warning - "`http-get*' has been deprecated. " - "Instead, use `http-get' with the #:streaming? #t keyword argument.") - (http-get uri #:body body - #:port port #:version version #:keep-alive? keep-alive? - #:headers headers #:decode-body? #t #:streaming? #t)) - (define-syntax-rule (define-http-verb http-verb method doc) (define* (http-verb uri #:key (body #f) diff --git a/module/web/uri.scm b/module/web/uri.scm index 5b01aa41f..4c6fa5051 100644 --- a/module/web/uri.scm +++ b/module/web/uri.scm @@ -75,14 +75,7 @@ (define (uri? obj) (and (uri-reference? obj) - (if (include-deprecated-features) - (begin - (unless (uri-scheme obj) - (issue-deprecation-warning - "Use uri-reference? instead of uri?; in the future, uri? -will require that the object not be a relative-ref.")) - #t) - (uri-scheme obj)) + (uri-scheme obj) #t)) ;;; RFC 3986, #4.2.