[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 01/04: Remove all deprecated code
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] 01/04: Remove all deprecated code |
|
Date: |
Mon, 22 May 2017 11:35:54 -0400 (EDT) |
wingo pushed a commit to branch master
in repository guile.
commit c248ea10beb2afa4c113dbc6dc707bed5dbfc92e
Author: Andy Wingo <address@hidden>
Date: Mon May 22 13:36:42 2017 +0200
Remove all deprecated code
* module/ice-9/debug.scm:
* module/ice-9/mapping.scm:
* module/ice-9/syncase.scm: Delete these deprecated files.
* module/Makefile.am: Remove deleted files.
* libguile/deprecated.c:
* libguile/deprecated.h:
* libguile/backtrace.c:
* libguile/goops.c:
* libguile/numbers.c:
* libguile/socket.c:
* libguile/srfi-13.c:
* module/ice-9/deprecated.scm:
* module/ice-9/format.scm:
* module/oop/goops.scm:
* module/statprof.scm:
* module/texinfo/reflection.scm:
* module/web/client.scm:
* module/web/uri.scm: Remove deprecated code.
---
libguile/backtrace.c | 13 -
libguile/deprecated.c | 933 +-----------------------------------------
libguile/deprecated.h | 253 +-----------
libguile/goops.c | 4 -
libguile/numbers.c | 9 +-
libguile/socket.c | 5 -
libguile/srfi-13.c | 32 --
module/Makefile.am | 3 -
module/ice-9/debug.scm | 25 --
module/ice-9/deprecated.scm | 77 +---
module/ice-9/format.scm | 24 --
module/ice-9/mapping.scm | 118 ------
module/ice-9/syncase.scm | 37 --
module/oop/goops.scm | 37 --
module/statprof.scm | 49 ---
module/texinfo/reflection.scm | 7 +-
module/web/client.scm | 24 +-
module/web/uri.scm | 9 +-
18 files changed, 10 insertions(+), 1649 deletions(-)
diff --git a/libguile/backtrace.c b/libguile/backtrace.c
index 495a68b..6eb7454 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 cee6b1d..acf9b19 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 <sys/types.h>
-#include <unistd.h>
-
#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 ("<class>"));
- scm_class_top = scm_variable_ref (scm_c_lookup ("<top>"));
- scm_class_object = scm_variable_ref (scm_c_lookup ("<object>"));
-
- scm_class_foreign_slot = scm_variable_ref (scm_c_lookup ("<foreign-slot>"));
- scm_class_protected = scm_variable_ref (scm_c_lookup ("<protected-slot>"));
- scm_class_hidden = scm_variable_ref (scm_c_lookup ("<hidden-slot>"));
- scm_class_opaque = scm_variable_ref (scm_c_lookup ("<opaque-slot>"));
- scm_class_read_only = scm_variable_ref (scm_c_lookup ("<read-only-slot>"));
- scm_class_self = scm_variable_ref (scm_c_lookup ("<self-slot>"));
- scm_class_protected_opaque = scm_variable_ref (scm_c_lookup
("<protected-opaque-slot>"));
- scm_class_protected_hidden = scm_variable_ref (scm_c_lookup
("<protected-hidden-slot>"));
- scm_class_protected_read_only = scm_variable_ref (scm_c_lookup
("<protected-read-only-slot>"));
- scm_class_scm = scm_variable_ref (scm_c_lookup ("<scm-slot>"));
- scm_class_int = scm_variable_ref (scm_c_lookup ("<int-slot>"));
- scm_class_float = scm_variable_ref (scm_c_lookup ("<float-slot>"));
- scm_class_double = scm_variable_ref (scm_c_lookup ("<double-slot>"));
-
- /* scm_class_generic functions classes */
- scm_class_procedure_class = scm_variable_ref (scm_c_lookup
("<procedure-class>"));
- scm_class_applicable_struct_class = scm_variable_ref (scm_c_lookup
("<applicable-struct-class>"));
-
- scm_class_method = scm_variable_ref (scm_c_lookup ("<method>"));
- scm_class_accessor_method = scm_variable_ref (scm_c_lookup
("<accessor-method>"));
- scm_class_applicable = scm_variable_ref (scm_c_lookup ("<applicable>"));
- scm_class_applicable_struct = scm_variable_ref (scm_c_lookup
("<applicable-struct>"));
- scm_class_applicable_struct_with_setter = scm_variable_ref (scm_c_lookup
("<applicable-struct-with-setter>"));
- scm_class_generic = scm_variable_ref (scm_c_lookup ("<generic>"));
- scm_class_extended_generic = scm_variable_ref (scm_c_lookup
("<extended-generic>"));
- scm_class_generic_with_setter = scm_variable_ref (scm_c_lookup
("<generic-with-setter>"));
- scm_class_accessor = scm_variable_ref (scm_c_lookup ("<accessor>"));
- scm_class_extended_generic_with_setter = scm_variable_ref (scm_c_lookup
("<extended-generic-with-setter>"));
- scm_class_extended_accessor = scm_variable_ref (scm_c_lookup
("<extended-accessor>"));
-
- /* Primitive types classes */
- scm_class_boolean = scm_variable_ref (scm_c_lookup ("<boolean>"));
- scm_class_char = scm_variable_ref (scm_c_lookup ("<char>"));
- scm_class_list = scm_variable_ref (scm_c_lookup ("<list>"));
- scm_class_pair = scm_variable_ref (scm_c_lookup ("<pair>"));
- scm_class_null = scm_variable_ref (scm_c_lookup ("<null>"));
- scm_class_string = scm_variable_ref (scm_c_lookup ("<string>"));
- scm_class_symbol = scm_variable_ref (scm_c_lookup ("<symbol>"));
- scm_class_vector = scm_variable_ref (scm_c_lookup ("<vector>"));
- scm_class_number = scm_variable_ref (scm_c_lookup ("<number>"));
- scm_class_complex = scm_variable_ref (scm_c_lookup ("<complex>"));
- scm_class_real = scm_variable_ref (scm_c_lookup ("<real>"));
- scm_class_integer = scm_variable_ref (scm_c_lookup ("<integer>"));
- scm_class_fraction = scm_variable_ref (scm_c_lookup ("<fraction>"));
- scm_class_keyword = scm_variable_ref (scm_c_lookup ("<keyword>"));
- scm_class_unknown = scm_variable_ref (scm_c_lookup ("<unknown>"));
- scm_class_procedure = scm_variable_ref (scm_c_lookup ("<procedure>"));
- scm_class_primitive_generic = scm_variable_ref (scm_c_lookup
("<primitive-generic>"));
- scm_class_port = scm_variable_ref (scm_c_lookup ("<port>"));
- scm_class_input_port = scm_variable_ref (scm_c_lookup ("<input-port>"));
- scm_class_output_port = scm_variable_ref (scm_c_lookup ("<output-port>"));
- scm_class_input_output_port = scm_variable_ref (scm_c_lookup
("<input-output-port>"));
-
- 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 <address@hidden>
- */
- 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 ("#<arbiter ", port);
- if (SCM_ARB_LOCKED (exp))
- scm_puts ("locked ", port);
- scm_iprin1 (SCM_PACK (SCM_SMOB_DATA (exp)), port, pstate);
- scm_putc ('>', 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 2c49076..af5e901 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 a158a1c..1e7639e 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 3e0efc8..39e2d62 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 71c17e8..b28e01b 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 c77cba9..ff5e721 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 d5896bd..8a8eab5 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 380b045..0000000
--- 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 address@hidden
-;;;; 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 2f41686..597ca8b 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 1ef4cb5..e7258a1 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 bd4dbfb..0000000
--- 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 219803e..0000000
--- 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 a469180..c78d0bd 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 <arbiter> (find-subclass <top> '<arbiter>))
- (define-public <async> (find-subclass <top> '<async>)))
-
(define <promise> (find-subclass <top> '<promise>))
(define <thread> (find-subclass <top> '<thread>))
(define <mutex> (find-subclass <top> '<mutex>))
diff --git a/module/statprof.scm b/module/statprof.scm
index 59a2f12..9f2179b 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 @@ address@hidden"
(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 address@hidden"
@@ -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:
-
address@hidden @code
address@hidden #:display-style
-Set the display style, either @code{'flat} or @code{'tree}.
-
address@hidden #:loop
-Execute the body @var{loop} number of times, or @code{#f} for no looping
-
-default: @code{#f}
address@hidden #:hz
-Sampling rate
-
-default: @code{20}
address@hidden #:count-calls?
-Whether to instrument each function call (expensive)
-
-default: @code{#f}
address@hidden 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 d85f612..50cb2ab 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 3b7ea51..c13117d 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 5b01aa4..4c6fa50 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.