mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

remove all deprecated code

Browse source 
* libguile/async.c:
* libguile/async.h:
* libguile/debug.h:
* libguile/deprecated.c:
* libguile/deprecated.h:
* libguile/evalext.h:
* libguile/gc-malloc.c:
* libguile/gc.h:
* libguile/gen-scmconfig.c:
* libguile/numbers.c:
* libguile/ports.c:
* libguile/ports.h:
* libguile/procprop.c:
* libguile/procprop.h:
* libguile/read.c:
* libguile/socket.c:
* libguile/srfi-4.h:
* libguile/strings.c:
* libguile/strings.h:
* libguile/tags.h:
* module/ice-9/boot-9.scm:
* module/ice-9/deprecated.scm: Remove all deprecated code.  CPP defines
  that were not previously issuing warnings were changed so that their
  expansions would indicate the replacement forms to use,
  e.g. scm_sizet__GONE__REPLACE_WITH__size_t.

  The two exceptions were SCM_LISTN, which did not produce warnings
  before, and the string-filter argument order stuff.

  Drops the initial dirty memory usage of Guile down to 2.8 MB on my
  machine, from 4.4 MB.
This commit is contained in:
Andy Wingo 2011-05-12 14:01:26 +02:00
parent 7fbea320fb
commit fc7bd367ab
22 changed files with 73 additions and 4745 deletions
Download patch file Download diff file Expand all files Collapse all files

62
libguile/async.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2004, 2006, 2008, 2009, 2010 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2004, 2006, 2008, 2009, 2010, 2011 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
@ -22,8 +22,6 @@
# include <config.h>
#endif
#define SCM_BUILDING_DEPRECATED_CODE
#include "libguile/_scm.h"
#include "libguile/eval.h"
#include "libguile/throw.h"
@ -170,23 +168,6 @@ scm_async_click ()
}
}
#if (SCM_ENABLE_DEPRECATED == 1)
SCM_DEFINE (scm_system_async, "system-async", 1, 0, 0,
(SCM thunk),
"This function is deprecated. You can use @var{thunk} directly\n"
"instead of explicitly creating an async object.\n")
#define FUNC_NAME s_scm_system_async
{
scm_c_issue_deprecation_warning
("'system-async' is deprecated. "
"Use the procedure directly with 'system-async-mark'.");
return thunk;
}
#undef FUNC_NAME
#endif /* SCM_ENABLE_DEPRECATED == 1 */
void
scm_i_queue_async_cell (SCM c, scm_i_thread *t)
{
@ -341,47 +322,6 @@ SCM_DEFINE (scm_noop, "noop", 0, 0, 1,
#if (SCM_ENABLE_DEPRECATED == 1)
SCM_DEFINE (scm_unmask_signals, "unmask-signals", 0, 0, 0,
(),
"Unmask signals. The returned value is not specified.")
#define FUNC_NAME s_scm_unmask_signals
{
scm_i_thread *t = SCM_I_CURRENT_THREAD;
scm_c_issue_deprecation_warning
("'unmask-signals' is deprecated. "
"Use 'call-with-blocked-asyncs' instead.");
if (t->block_asyncs == 0)
SCM_MISC_ERROR ("signals already unmasked", SCM_EOL);
t->block_asyncs = 0;
scm_async_click ();
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
SCM_DEFINE (scm_mask_signals, "mask-signals", 0, 0, 0,
(),
"Mask signals. The returned value is not specified.")
#define FUNC_NAME s_scm_mask_signals
{
scm_i_thread *t = SCM_I_CURRENT_THREAD;
scm_c_issue_deprecation_warning
("'mask-signals' is deprecated. Use 'call-with-blocked-asyncs' instead.");
if (t->block_asyncs > 0)
SCM_MISC_ERROR ("signals already masked", SCM_EOL);
t->block_asyncs = 1;
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
#endif /* SCM_ENABLE_DEPRECATED == 1 */
static void
increase_block (void *data)
{

10
libguile/async.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_ASYNC_H
#define SCM_ASYNC_H
/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2004, 2005, 2006, 2008, 2009 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2004, 2005, 2006, 2008, 2009, 2011 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
@ -87,14 +87,6 @@ SCM_API void scm_critical_section_end (void);
SCM_INTERNAL void scm_init_async (void);
#if (SCM_ENABLE_DEPRECATED == 1)
SCM_DEPRECATED SCM scm_system_async (SCM thunk);
SCM_DEPRECATED SCM scm_unmask_signals (void);
SCM_DEPRECATED SCM scm_mask_signals (void);
#endif
#endif /* SCM_ASYNC_H */
/*

14
libguile/debug.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_DEBUG_H
#define SCM_DEBUG_H
/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2004,2008,2009,2010
/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2004,2008,2009,2010,2011
* Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
@ -52,18 +52,6 @@ SCM_INTERNAL void scm_init_debug (void);
SCM_API SCM scm_debug_hang (SCM obj);
#endif /*GUILE_DEBUG*/
#if SCM_ENABLE_DEPRECATED == 1
#define CHECK_ENTRY scm_check_entry_p
#define CHECK_APPLY scm_check_apply_p
#define CHECK_EXIT scm_check_exit_p
/* Deprecated in guile 1.7.0 on 2004-03-29. */
#define SCM_DEBUGGINGP scm_debug_mode_p
#define scm_debug_mode scm_debug_mode_p
#endif
#endif /* SCM_DEBUG_H */
/*

2546
libguile/deprecated.c
View file

File diff suppressed because it is too large Load diff

761
libguile/deprecated.h
View file

@ -31,118 +31,6 @@
#if (SCM_ENABLE_DEPRECATED == 1)
/* From eval.h: Macros for handling ilocs. These were deprecated in guile
* 1.7.0 on 2004-04-22. */
#define SCM_IFRINC (0x00000100L)
#define SCM_ICDR (0x00080000L)
#define SCM_IFRAME(n) ((long)((SCM_ICDR-SCM_IFRINC)>>8) \
& (SCM_UNPACK (n) >> 8))
#define SCM_IDIST(n) (SCM_UNPACK (n) >> 20)
#define SCM_ICDRP(n) (SCM_ICDR & SCM_UNPACK (n))
/* From tags.h: Macros to access internal symbol names of isyms. Deprecated
* in guile 1.7.0 on 2004-04-22. */
SCM_API char *scm_isymnames[];
#define SCM_ISYMNUM(n) 0
#define SCM_ISYMCHARS(n) "#@<deprecated>"
/* From tags.h: Macro checking for two tc16 types that are allocated to differ
* only in the 's'-bit. Deprecated in guile 1.7.0 on 2003-09-21. */
#define SCM_TYP16S(x) (0xfeff & SCM_CELL_TYPE (x))
/* From numbers.h: Macros checking for types, but avoiding a redundant check
* for !SCM_IMP. These were deprecated in guile 1.7.0 on 2003-09-06. */
#define SCM_SLOPPY_INEXACTP(x) (SCM_TYP16S (x) == scm_tc16_real)
#define SCM_SLOPPY_REALP(x) (SCM_TYP16 (x) == scm_tc16_real)
#define SCM_SLOPPY_COMPLEXP(x) (SCM_TYP16 (x) == scm_tc16_complex)
/* From structs.h:
Deprecated in Guile 1.9.5 on 2009-11-03. */
#define scm_vtable_index_vtable scm_vtable_index_self
#define scm_vtable_index_printer scm_vtable_index_instance_printer
#define scm_struct_i_free scm_vtable_index_instance_finalize
#define scm_struct_i_flags scm_vtable_index_flags
#define SCM_STRUCTF_MASK ((scm_t_bits)-1)
#define SCM_SET_VTABLE_DESTRUCTOR(X, D) (SCM_STRUCT_DATA(x)[scm_struct_i_free]=(scm_t_bits)(D))
#define scm_substring_move_left_x scm_substring_move_x
#define scm_substring_move_right_x scm_substring_move_x
#define scm_sizet size_t
SCM_DEPRECATED SCM scm_wta (SCM arg, const char *pos, const char *s_subr);
#define SCM_WNA 8
#define SCM_OUTOFRANGE 10
#define SCM_NALLOC 11
SCM_DEPRECATED void scm_register_module_xxx (char *module_name, void *init_func);
SCM_DEPRECATED SCM scm_registered_modules (void);
SCM_DEPRECATED SCM scm_clear_registered_modules (void);
SCM_DEPRECATED SCM scm_protect_object (SCM obj);
SCM_DEPRECATED SCM scm_unprotect_object (SCM obj);
#define SCM_SETAND_CAR(x, y) \
(SCM_SETCAR ((x), SCM_PACK (SCM_UNPACK (SCM_CAR (x)) & (y))))
#define SCM_SETOR_CAR(x, y)\
(SCM_SETCAR ((x), SCM_PACK (SCM_UNPACK (SCM_CAR (x)) | (y))))
#define SCM_SETAND_CDR(x, y)\
(SCM_SETCDR ((x), SCM_PACK (SCM_UNPACK (SCM_CDR (x)) & (y))))
#define SCM_SETOR_CDR(x, y)\
(SCM_SETCDR ((x), SCM_PACK (SCM_UNPACK (SCM_CDR (x)) | (y))))
#define SCM_FREEP(x) (0)
#define SCM_NFREEP(x) (1)
#define SCM_GCTYP16(x) SCM_TYP16 (x)
#define SCM_GCCDR(x) SCM_CDR (x)
SCM_DEPRECATED void scm_remember (SCM * ptr);
SCM_DEPRECATED SCM scm_make_module (SCM name);
SCM_DEPRECATED SCM scm_ensure_user_module (SCM name);
SCM_DEPRECATED SCM scm_load_scheme_module (SCM name);
#define scm_port scm_t_port
#define scm_ptob_descriptor scm_t_ptob_descriptor
#define scm_port_rw_active scm_t_port_rw_active
SCM_DEPRECATED SCM scm_close_all_ports_except (SCM ports);
#define scm_rstate scm_t_rstate
#define scm_rng scm_t_rng
#define SCM_SLOPPY_CONSP(x) ((1 & SCM_CELL_TYPE (x)) == 0)
#define SCM_SLOPPY_NCONSP(x) (!SCM_SLOPPY_CONSP(x))
#define scm_tc7_ssymbol scm_tc7_symbol
#define scm_tc7_msymbol scm_tc7_symbol
#define scm_tcs_symbols scm_tc7_symbol
SCM_DEPRECATED SCM scm_makstr (size_t len, int);
SCM_DEPRECATED SCM scm_makfromstr (const char *src, size_t len, int);
SCM_DEPRECATED SCM scm_variable_set_name_hint (SCM var, SCM hint);
SCM_DEPRECATED SCM scm_builtin_variable (SCM name);
SCM_DEPRECATED SCM scm_internal_with_fluids (SCM fluids, SCM vals,
SCM (*cproc)(void *),
void *cdata);
SCM_DEPRECATED SCM scm_make_gsubr (const char *name,
int req, int opt, int rst,
scm_t_subr fcn);
SCM_DEPRECATED SCM scm_make_gsubr_with_generic (const char *name,
int req,
int opt,
int rst,
scm_t_subr fcn,
SCM *gf);
SCM_DEPRECATED SCM scm_create_hook (const char* name, int n_args);
#define SCM_LIST0 SCM_EOL
#define SCM_LIST1(e0) scm_cons ((e0), SCM_EOL)
#define SCM_LIST2(e0, e1) scm_cons2 ((e0), (e1), SCM_EOL)
@ -161,625 +49,36 @@ SCM_DEPRECATED SCM scm_create_hook (const char* name, int n_args);
scm_cons ((e0),\
SCM_LIST8 ((e1), (e2), (e3), (e4), (e5), (e6), (e7), (e8)))
#define scm_listify scm_list_n
SCM_DEPRECATED SCM scm_sloppy_memq (SCM x, SCM lst);
SCM_DEPRECATED SCM scm_sloppy_memv (SCM x, SCM lst);
SCM_DEPRECATED SCM scm_sloppy_member (SCM x, SCM lst);
SCM_DEPRECATED SCM scm_read_and_eval_x (SCM port);
#define scm_subr_entry scm_t_subr_entry
#define SCM_SUBR_DOC(x) SCM_BOOL_F
SCM_DEPRECATED SCM scm_call_catching_errors (scm_t_subr thunk,
scm_t_subr err_filter,
void * closure);
SCM_DEPRECATED long scm_make_smob_type_mfpe (char *name, size_t size,
SCM (*mark) (SCM),
size_t (*free) (SCM),
int (*print) (SCM, SCM,
scm_print_state*),
SCM (*equalp) (SCM, SCM));
SCM_DEPRECATED void scm_set_smob_mfpe (long tc,
SCM (*mark) (SCM),
size_t (*free) (SCM),
int (*print) (SCM, SCM, scm_print_state*),
SCM (*equalp) (SCM, SCM));
SCM_DEPRECATED size_t scm_smob_free (SCM obj);
SCM_DEPRECATED SCM scm_strprint_obj (SCM obj);
SCM_DEPRECATED SCM scm_read_0str (char *expr);
SCM_DEPRECATED SCM scm_eval_0str (const char *expr);
SCM_DEPRECATED char *scm_i_object_chars (SCM);
#define SCM_CHARS(x) scm_i_object_chars(x)
#define SCM_UCHARS(x) ((unsigned char *)SCM_CHARS(x))
SCM_DEPRECATED long scm_i_object_length (SCM);
#define SCM_LENGTH(x) scm_i_object_length(x)
#define scm_strhash(str, len, n) (scm_string_hash ((str), (len)) % (n))
SCM_DEPRECATED SCM scm_sym2ovcell_soft (SCM sym, SCM obarray);
SCM_DEPRECATED SCM scm_sym2ovcell (SCM sym, SCM obarray);
SCM_DEPRECATED SCM scm_intern_obarray_soft (const char *name, size_t len,
SCM obarray, unsigned int softness);
SCM_DEPRECATED SCM scm_intern_obarray (const char *name, size_t len, SCM obarray);
SCM_DEPRECATED SCM scm_symbol_value0 (const char *name);
SCM_DEPRECATED SCM scm_string_to_obarray_symbol (SCM o, SCM s, SCM softp);
SCM_DEPRECATED SCM scm_intern_symbol (SCM o, SCM s);
SCM_DEPRECATED SCM scm_unintern_symbol (SCM o, SCM s);
SCM_DEPRECATED SCM scm_symbol_binding (SCM o, SCM s);
#if 0
/* This name has been reused for real uninterned symbols. */
SCM_DEPRECATED SCM scm_symbol_interned_p (SCM o, SCM s);
#endif
SCM_DEPRECATED SCM scm_symbol_bound_p (SCM o, SCM s);
SCM_DEPRECATED SCM scm_symbol_set_x (SCM o, SCM s, SCM v);
SCM_DEPRECATED SCM scm_gentemp (SCM prefix, SCM obarray);
#define SCM_OPDIRP(x) (SCM_DIRP (x) && (SCM_DIR_OPEN_P (x)))
#define scm_fport scm_t_fport
#define scm_option scm_t_option
#define scm_srcprops scm_t_srcprops
#define scm_srcprops_chunk scm_t_srcprops_chunk
#define scm_array scm_t_array
#define scm_array_dim scm_t_array_dim
#define SCM_FUNC_NAME (scm_makfrom0str (FUNC_NAME))
#define SCM_WTA(pos, scm) \
do { scm_wta (scm, (char *) pos, FUNC_NAME); } while (0)
#define RETURN_SCM_WTA(pos, scm) \
do { return scm_wta (scm, (char *) pos, FUNC_NAME); } while (0)
#define SCM_VALIDATE_NUMBER_COPY(pos, z, cvar) \
do { \
if (SCM_I_INUMP (z)) \
cvar = (double) SCM_I_INUM (z); \
else if (SCM_REALP (z)) \
cvar = SCM_REAL_VALUE (z); \
else if (SCM_BIGP (z)) \
cvar = scm_i_big2dbl (z); \
else \
{ \
cvar = 0.0; \
SCM_WRONG_TYPE_ARG (pos, z); \
} \
} while (0)
#define SCM_VALIDATE_NUMBER_DEF_COPY(pos, number, def, cvar) \
do { \
if (SCM_UNBNDP (number)) \
cvar = def; \
else \
SCM_VALIDATE_NUMBER_COPY(pos, number, cvar); \
} while (0)
#define SCM_VALIDATE_OPDIR(pos, port) SCM_MAKE_VALIDATE (pos, port, OPDIRP)
/* Deprecated because we can not safely cast a SCM* to a scm_t_bits*
*/
#define SCM_CELL_WORD_LOC(x, n) ((scm_t_bits*)SCM_CELL_OBJECT_LOC((x),(n)))
/* Users shouldn't know about INUMs.
*/
SCM_DEPRECATED SCM scm_i_makinum (scm_t_signed_bits val);
SCM_DEPRECATED int scm_i_inump (SCM obj);
SCM_DEPRECATED scm_t_signed_bits scm_i_inum (SCM obj);
#define SCM_MAKINUM(x) scm_i_makinum(x)
#define SCM_INUM(x) scm_i_inum(x)
#define SCM_INUMP(x) scm_i_inump(x)
#define SCM_NINUMP(x) (!SCM_INUMP(x))
#define SCM_VALIDATE_INUM(pos, k) SCM_MAKE_VALIDATE_MSG (pos, k, INUMP, "exact integer")
#define SCM_VALIDATE_INUM_COPY(pos, k, cvar) \
do { \
SCM_ASSERT (SCM_I_INUMP (k), k, pos, FUNC_NAME); \
cvar = SCM_I_INUM (k); \
} while (0)
#define SCM_VALIDATE_BIGINT(pos, k) SCM_MAKE_VALIDATE_MSG (pos, k, BIGP, "bignum")
#define SCM_VALIDATE_INUM_MIN(pos, k, min) \
do { \
SCM_ASSERT (SCM_I_INUMP(k), k, pos, FUNC_NAME); \
SCM_ASSERT_RANGE (pos, k, (SCM_I_INUM (k) >= min)); \
} while (0)
#define SCM_VALIDATE_INUM_MIN_COPY(pos, k, min, cvar) \
do { \
SCM_ASSERT (SCM_I_INUMP (k), k, pos, FUNC_NAME); \
SCM_ASSERT_RANGE (pos, k, (SCM_I_INUM (k) >= min)); \
cvar = SCM_INUM (k); \
} while (0)
#define SCM_VALIDATE_INUM_MIN_DEF_COPY(pos, k, min, default, cvar) \
do { \
if (SCM_UNBNDP (k)) \
k = SCM_I_MAKINUM (default); \
SCM_ASSERT (SCM_I_INUMP (k), k, pos, FUNC_NAME); \
SCM_ASSERT_RANGE (pos, k, (SCM_I_INUM (k) >= min)); \
cvar = SCM_INUM (k); \
} while (0)
#define SCM_VALIDATE_INUM_DEF(pos, k, default) \
do { \
if (SCM_UNBNDP (k)) \
k = SCM_I_MAKINUM (default); \
else SCM_ASSERT (SCM_I_INUMP (k), k, pos, FUNC_NAME); \
} while (0)
#define SCM_VALIDATE_INUM_DEF_COPY(pos, k, default, cvar) \
do { \
if (SCM_UNBNDP (k)) \
{ \
k = SCM_I_MAKINUM (default); \
cvar = default; \
} \
else \
{ \
SCM_ASSERT (SCM_I_INUMP (k), k, pos, FUNC_NAME); \
cvar = SCM_INUM (k); \
} \
} while (0)
/* [low, high) */
#define SCM_VALIDATE_INUM_RANGE(pos, k, low, high) \
do { SCM_ASSERT(SCM_I_INUMP(k), k, pos, FUNC_NAME); \
SCM_ASSERT_RANGE(pos, k, \
(SCM_I_INUM (k) >= low && \
SCM_I_INUM (k) < high)); \
} while (0)
#define SCM_VALIDATE_INUM_RANGE_COPY(pos, k, low, high, cvar) \
do { \
SCM_ASSERT (SCM_INUMP (k), k, pos, FUNC_NAME); \
SCM_ASSERT_RANGE (pos, k, low <= SCM_INUM (k) && SCM_INUM (k) < high); \
cvar = SCM_INUM (k); \
} while (0)
#define SCM_STRING_COERCE_0TERMINATION_X(x) (x)
/* XXX - buggy interface, STR might not be large enough.
Converts the given Scheme string OBJ into a C string, containing a copy
of OBJ's content with a trailing null byte. If LENP is non-NULL, set
*LENP to the string's length.
When STR is non-NULL it receives the copy and is returned by the function,
otherwise new memory is allocated and the caller is responsible for
freeing it via free(). If out of memory, NULL is returned.
Note that Scheme strings may contain arbitrary data, including null
characters. This means that null termination is not a reliable way to
determine the length of the returned value. However, the function always
copies the complete contents of OBJ, and sets *LENP to the length of the
scheme string (if LENP is non-null).
*/
SCM_DEPRECATED char *scm_c_string2str (SCM obj, char *str, size_t *lenp);
/* XXX - buggy interface, you don't know how many bytes have been copied.
Copy LEN characters at START from the Scheme string OBJ to memory
at STR. START is an index into OBJ; zero means the beginning of
the string. STR has already been allocated by the caller.
If START + LEN is off the end of OBJ, silently truncate the source
region to fit the string. If truncation occurs, the corresponding
area of STR is left unchanged.
*/
SCM_DEPRECATED char *scm_c_substring2str (SCM obj, char *str, size_t start, size_t len);
SCM_DEPRECATED char *scm_c_symbol2str (SCM obj, char *str, size_t *lenp);
/* Deprecated because the names belong to what is now
scm_truncate_number and scm_round_number.
*/
SCM_DEPRECATED double scm_truncate (double x);
SCM_DEPRECATED double scm_round (double x);
/* Deprecated, use scm_expt */
SCM_DEPRECATED SCM scm_sys_expt (SCM x, SCM y);
/* if your platform doesn't have asinh et al */
SCM_API double scm_asinh (double x);
SCM_API double scm_acosh (double x);
SCM_API double scm_atanh (double x);
SCM_API SCM scm_sys_atan2 (SCM z1, SCM z2);
/* Deprecated because we don't want people to access the internal
representation of strings directly.
*/
#define SCM_VALIDATE_STRING_COPY(pos, str, cvar) \
do { \
SCM_ASSERT (SCM_STRINGP (str), str, pos, FUNC_NAME); \
cvar = SCM_STRING_CHARS(str); \
} while (0)
/* validate a string and optional start/end arguments which default to
0/string-len. this is unrelated to the old shared substring
support, so please do not deprecate it :) */
#define SCM_VALIDATE_SUBSTRING_SPEC_COPY(pos_str, str, c_str, \
pos_start, start, c_start,\
pos_end, end, c_end) \
do {\
SCM_VALIDATE_STRING_COPY (pos_str, str, c_str);\
c_start = SCM_UNBNDP(start)? 0 : scm_to_size_t (start);\
c_end = SCM_UNBNDP(end)? SCM_STRING_LENGTH(str) : scm_to_size_t (end);\
SCM_ASSERT_RANGE (pos_start, start,\
0 <= c_start \
&& (size_t) c_start <= SCM_STRING_LENGTH (str));\
SCM_ASSERT_RANGE (pos_end, end,\
c_start <= c_end \
&& (size_t) c_end <= SCM_STRING_LENGTH (str));\
} while (0)
/* Deprecated because we don't want people to access the internals of
symbols directly.
*/
SCM_DEPRECATED char *scm_i_deprecated_symbol_chars (SCM sym);
SCM_DEPRECATED size_t scm_i_deprecated_symbol_length (SCM sym);
#define SCM_SYMBOL_CHARS(x) scm_i_deprecated_symbol_chars(x)
#define SCM_SYMBOL_LENGTH(x) scm_i_deprecated_symbol_length(x)
/* Deprecated because the macros used to evaluate the arguments more
than once and because the symbol of a keyword now has no dash.
*/
SCM_DEPRECATED int scm_i_keywordp (SCM obj);
SCM_DEPRECATED SCM scm_i_keywordsym (SCM keyword);
#define SCM_KEYWORDP(x) scm_i_keywordp(x)
#define SCM_KEYWORDSYM(x) scm_i_keywordsym(x)
/* Deprecated because we don't want to hand out unprotected pointers
to arrays, vectors, etc. */
#define SCM_VECTOR_MAX_LENGTH ((1L << 24) - 1)
SCM_DEPRECATED int scm_i_vectorp (SCM x);
SCM_DEPRECATED unsigned long scm_i_vector_length (SCM x);
SCM_DEPRECATED const SCM *scm_i_velts (SCM x);
SCM_DEPRECATED SCM *scm_i_writable_velts (SCM x);
SCM_DEPRECATED SCM scm_i_vector_ref (SCM x, size_t idx);
SCM_DEPRECATED void scm_i_vector_set (SCM x, size_t idx, SCM val);
SCM_DEPRECATED SCM scm_vector_equal_p (SCM x, SCM y);
#define SCM_VECTORP(x) scm_i_vectorp(x)
#define SCM_VECTOR_LENGTH(x) scm_i_vector_length(x)
#define SCM_VELTS(x) scm_i_velts(x)
#define SCM_WRITABLE_VELTS(x) scm_i_writable_velts(x)
#define SCM_VECTOR_REF(x,y) scm_i_vector_ref(x,y)
#define SCM_VECTOR_SET(x,y,z) scm_i_vector_set(x,y,z)
typedef scm_i_t_array scm_t_array;
SCM_DEPRECATED int scm_i_arrayp (SCM a);
SCM_DEPRECATED size_t scm_i_array_ndim (SCM a);
SCM_DEPRECATED int scm_i_array_contp (SCM a);
SCM_DEPRECATED scm_t_array *scm_i_array_mem (SCM a);
SCM_DEPRECATED SCM scm_i_array_v (SCM a);
SCM_DEPRECATED size_t scm_i_array_base (SCM a);
SCM_DEPRECATED scm_t_array_dim *scm_i_array_dims (SCM a);
#define SCM_ARRAYP(a) scm_i_arrayp(a)
#define SCM_ARRAY_NDIM(a) scm_i_array_ndim(a)
#define SCM_ARRAY_CONTP(a) scm_i_array_contp(a)
#define SCM_ARRAY_MEM(a) scm_i_array_mem(a)
#define SCM_ARRAY_V(a) scm_i_array_v(a)
#define SCM_ARRAY_BASE(a) scm_i_array_base(a)
#define SCM_ARRAY_DIMS(a) scm_i_array_dims(a)
SCM_DEPRECATED SCM scm_uniform_vector_read_x (SCM v, SCM port_or_fd,
SCM start, SCM end);
SCM_DEPRECATED SCM scm_uniform_vector_write (SCM v, SCM port_or_fd,
SCM start, SCM end);
SCM_DEPRECATED SCM scm_uniform_array_read_x (SCM ra, SCM port_or_fd,
SCM start, SCM end);
SCM_DEPRECATED SCM scm_uniform_array_write (SCM v, SCM port_or_fd,
SCM start, SCM end);
/* Deprecated because they should not be lvalues and we want people to
use the official interfaces.
*/
#define scm_cur_inp scm_i_cur_inp ()
#define scm_cur_outp scm_i_cur_outp ()
#define scm_cur_errp scm_i_cur_errp ()
#define scm_cur_loadp scm_i_cur_loadp ()
#define scm_progargs scm_i_progargs ()
#define scm_dynwinds scm_i_deprecated_dynwinds ()
#define scm_stack_base scm_i_stack_base ()
SCM_DEPRECATED SCM scm_i_cur_inp (void);
SCM_DEPRECATED SCM scm_i_cur_outp (void);
SCM_DEPRECATED SCM scm_i_cur_errp (void);
SCM_DEPRECATED SCM scm_i_cur_loadp (void);
SCM_DEPRECATED SCM scm_i_progargs (void);
SCM_DEPRECATED SCM scm_i_deprecated_dynwinds (void);
SCM_DEPRECATED SCM_STACKITEM *scm_i_stack_base (void);
/* Deprecated because it evaluates its argument twice.
*/
#define SCM_FLUIDP(x) scm_i_fluidp (x)
SCM_DEPRECATED int scm_i_fluidp (SCM x);
/* Deprecated in Guile 1.9.5 on 2009-11-15 because these are IPv4-only
functions which are deprecated upstream. */
SCM_DEPRECATED SCM scm_inet_aton (SCM address);
SCM_DEPRECATED SCM scm_inet_ntoa (SCM inetid);
/* In the old days, SCM_CRITICAL_SECTION_START stopped signal handlers
from running, since in those days the handler directly ran scheme
code, and that had to be avoided when the heap was not in a
consistent state etc. And since the scheme code could do a stack
swapping new continuation etc, signals had to be deferred around
various C library functions which were not safe or not known to be
safe to swap away, which was a lot of stuff.
These days signals are implemented with asyncs and don't directly
run scheme code in the handler, but hold it until an SCM_TICK etc
where it will be safe. This means interrupt protection is not
needed and SCM_CRITICAL_SECTION_START / SCM_CRITICAL_SECTION_END is
something of an anachronism.
What past SCM_CRITICAL_SECTION_START usage also did though was
indicate code that was not reentrant, ie. could not be reentered by
signal handler code. The present definitions are a mutex lock,
affording that reentrancy protection against the new guile 1.8
free-running posix threads.
One big problem with the present defintions though is that code which
throws an error from within a DEFER/ALLOW region will leave the
defer_mutex locked and hence hang other threads that attempt to enter a
similar DEFER/ALLOW region.
*/
SCM_DEPRECATED void scm_i_defer_ints_etc (void);
#define SCM_DEFER_INTS scm_i_defer_ints_etc ()
#define SCM_ALLOW_INTS scm_i_defer_ints_etc ()
#define SCM_REDEFER_INTS scm_i_defer_ints_etc ()
#define SCM_REALLOW_INTS scm_i_defer_ints_etc ()
/* In the old days (pre-1.8), this macro was sometimes used as an lvalue as
in "scm_mask_ints = 1" to block async execution. It no longer works. */
#define scm_mask_ints (scm_i_mask_ints ())
SCM_DEPRECATED int scm_i_mask_ints (void);
/* Deprecated since they are unnecessary and had not been documented.
*/
SCM_DEPRECATED SCM scm_guard (SCM guardian, SCM obj, int throw_p);
SCM_DEPRECATED SCM scm_get_one_zombie (SCM guardian);
/* Deprecated since guardians no longer have these special features.
*/
SCM_DEPRECATED SCM scm_destroy_guardian_x (SCM guardian);
SCM_DEPRECATED SCM scm_guardian_greedy_p (SCM guardian);
SCM_DEPRECATED SCM scm_guardian_destroyed_p (SCM guardian);
/* GC-related things deprecated with the move to BDW-GC starting from 1.9.3
(2009-09-15). */
SCM_DEPRECATED unsigned long scm_mallocated;
SCM_DEPRECATED unsigned long scm_mtrigger;
SCM_DEPRECATED size_t scm_max_segment_size;
#if defined (GUILE_DEBUG) || defined (GUILE_DEBUG_FREELIST)
SCM_DEPRECATED SCM scm_map_free_list (void);
#endif
#if defined (GUILE_DEBUG_FREELIST)
SCM_DEPRECATED SCM scm_gc_set_debug_check_freelist_x (SCM flag);
#endif
/* Deprecated 2009-11-27, scm_call_N is sufficient */
SCM_DEPRECATED scm_t_trampoline_0 scm_trampoline_0 (SCM proc);
SCM_DEPRECATED scm_t_trampoline_1 scm_trampoline_1 (SCM proc);
SCM_DEPRECATED scm_t_trampoline_2 scm_trampoline_2 (SCM proc);
/* Deprecated 2009-12-06, use the procedures instead */
#define SCM_PROCEDURE_WITH_SETTER_P(obj) (scm_is_true (scm_procedure_with_setter_p (obj)))
#define SCM_PROCEDURE(obj) SCM_STRUCT_PROCEDURE (obj, 0)
#define SCM_SETTER(obj) SCM_STRUCT_SETTER (obj, 1)
/* Deprecated 2010-01-05, use SCM_PRIMITIVE_P instead */
SCM_DEPRECATED int scm_i_subr_p (SCM x);
#define scm_subr_p(x) (scm_i_subr_p (x))
/* Deprecated 2010-01-31, use with-throw-handler instead */
SCM_DEPRECATED SCM scm_lazy_catch (SCM tag, SCM thunk, SCM handler);
SCM_DEPRECATED SCM scm_internal_lazy_catch (SCM tag,
scm_t_catch_body body,
void *body_data,
scm_t_catch_handler handler,
void *handler_data);
/* Deprecated 2010-03-31, use array-equal? instead */
SCM_DEPRECATED SCM scm_raequal (SCM ra0, SCM ra1);
/* Deprecated 2010-04-01, use the dynamic FFI instead */
SCM_DEPRECATED SCM scm_dynamic_args_call (SCM symb, SCM dobj, SCM args);
/* Deprecated 2010-05-12, no replacement */
SCM_DEPRECATED int scm_badargsp (SCM formals, SCM args);
/* Deprecated 2010-06-19, use call-with-error-handling instead */
SCM_DEPRECATED SCM scm_internal_stack_catch (SCM tag,
scm_t_catch_body body,
void *body_data,
scm_t_catch_handler handler,
void *handler_data);
/* These functions were "discouraged" in 1.8, and now are deprecated. */
/* scm_to_int, scm_from_int are the official functions to do the job,
but there is nothing wrong with using scm_num2int, etc.
These could be trivially defined via macros, but we leave them as
functions since existing code may take their addresses.
*/
SCM_DEPRECATED SCM scm_short2num (short n);
SCM_DEPRECATED SCM scm_ushort2num (unsigned short n);
SCM_DEPRECATED SCM scm_int2num (int n);
SCM_DEPRECATED SCM scm_uint2num (unsigned int n);
SCM_DEPRECATED SCM scm_long2num (long n);
SCM_DEPRECATED SCM scm_ulong2num (unsigned long n);
SCM_DEPRECATED SCM scm_size2num (size_t n);
SCM_DEPRECATED SCM scm_ptrdiff2num (scm_t_ptrdiff n);
SCM_DEPRECATED short scm_num2short (SCM num, unsigned long int pos,
const char *s_caller);
SCM_DEPRECATED unsigned short scm_num2ushort (SCM num, unsigned long int pos,
const char *s_caller);
SCM_DEPRECATED int scm_num2int (SCM num, unsigned long int pos,
const char *s_caller);
SCM_DEPRECATED unsigned int scm_num2uint (SCM num, unsigned long int pos,
const char *s_caller);
SCM_DEPRECATED long scm_num2long (SCM num, unsigned long int pos,
const char *s_caller);
SCM_DEPRECATED unsigned long scm_num2ulong (SCM num, unsigned long int pos,
const char *s_caller);
SCM_DEPRECATED scm_t_ptrdiff scm_num2ptrdiff (SCM num, unsigned long int pos,
const char *s_caller);
SCM_DEPRECATED size_t scm_num2size (SCM num, unsigned long int pos,
const char *s_caller);
#if SCM_SIZEOF_LONG_LONG != 0
SCM_DEPRECATED SCM scm_long_long2num (long long sl);
SCM_DEPRECATED SCM scm_ulong_long2num (unsigned long long sl);
SCM_DEPRECATED long long scm_num2long_long (SCM num, unsigned long int pos,
const char *s_caller);
SCM_DEPRECATED unsigned long long scm_num2ulong_long (SCM num, unsigned long int pos,
const char *s_caller);
#endif
SCM_DEPRECATED SCM scm_make_real (double x);
SCM_DEPRECATED double scm_num2dbl (SCM a, const char * why);
SCM_DEPRECATED SCM scm_float2num (float n);
SCM_DEPRECATED SCM scm_double2num (double n);
/* The next two are implemented in numbers.c since they use features
only available there.
*/
SCM_DEPRECATED float scm_num2float (SCM num, unsigned long int pos,
const char *s_caller);
SCM_DEPRECATED double scm_num2double (SCM num, unsigned long int pos,
const char *s_caller);
SCM_DEPRECATED SCM scm_make_complex (double x, double y);
/* Discouraged because they don't make the encoding explicit.
*/
SCM_DEPRECATED SCM scm_mem2symbol (const char *mem, size_t len);
SCM_DEPRECATED SCM scm_mem2uninterned_symbol (const char *mem, size_t len);
SCM_DEPRECATED SCM scm_str2symbol (const char *str);
SCM_DEPRECATED SCM scm_take_str (char *s, size_t len);
SCM_DEPRECATED SCM scm_take0str (char *s);
SCM_DEPRECATED SCM scm_mem2string (const char *src, size_t len);
SCM_DEPRECATED SCM scm_str2string (const char *src);
SCM_DEPRECATED SCM scm_makfrom0str (const char *src);
SCM_DEPRECATED SCM scm_makfrom0str_opt (const char *src);
/* Discouraged because scm_c_make_string has a better name and is more
consistent with make-string.
*/
SCM_DEPRECATED SCM scm_allocate_string (size_t len);
/* Discouraged because they are just strange.
*/
SCM_DEPRECATED SCM scm_make_keyword_from_dash_symbol (SCM symbol);
SCM_DEPRECATED SCM scm_keyword_dash_symbol (SCM keyword);
/* Discouraged because it does not state what encoding S is in.
*/
SCM_DEPRECATED SCM scm_c_make_keyword (const char *s);
SCM_DEPRECATED unsigned int scm_thread_sleep (unsigned int);
SCM_DEPRECATED unsigned long scm_thread_usleep (unsigned long);
SCM_DEPRECATED int scm_internal_select (int fds,
SELECT_TYPE *rfds,
SELECT_TYPE *wfds,
SELECT_TYPE *efds,
struct timeval *timeout);
/* Deprecated because the cuserid call is deprecated.
*/
SCM_DEPRECATED SCM scm_cuserid (void);
/* Deprecated because it's yet another property interface.
*/
SCM_DEPRECATED SCM scm_primitive_make_property (SCM not_found_proc);
SCM_DEPRECATED SCM scm_primitive_property_ref (SCM prop, SCM obj);
SCM_DEPRECATED SCM scm_primitive_property_set_x (SCM prop, SCM obj, SCM val);
SCM_DEPRECATED SCM scm_primitive_property_del_x (SCM prop, SCM obj);
/* {The old whash table interface}
* Deprecated, as the hash table interface is sufficient, and accessing
* handles of weak hash tables is no longer supported.
*/
#define scm_whash_handle SCM
SCM_DEPRECATED SCM scm_whash_get_handle (SCM whash, SCM key);
SCM_DEPRECATED int SCM_WHASHFOUNDP (SCM h);
SCM_DEPRECATED SCM SCM_WHASHREF (SCM whash, SCM handle);
SCM_DEPRECATED void SCM_WHASHSET (SCM whash, SCM handle, SCM obj);
SCM_DEPRECATED SCM scm_whash_create_handle (SCM whash, SCM key);
SCM_DEPRECATED SCM scm_whash_lookup (SCM whash, SCM obj);
SCM_DEPRECATED void scm_whash_insert (SCM whash, SCM key, SCM obj);
/* No need for a table for names, and the struct->class mapping is
maintained by GOOPS now. */
#define SCM_STRUCT_TABLE_NAME(X) SCM_CAR (X)
#define SCM_SET_STRUCT_TABLE_NAME(X, NAME) SCM_SETCAR (X, NAME)
#define SCM_STRUCT_TABLE_CLASS(X) SCM_CDR (X)
#define SCM_SET_STRUCT_TABLE_CLASS(X, CLASS) SCM_SETCDR (X, CLASS)
SCM_DEPRECATED SCM scm_struct_table;
SCM_DEPRECATED SCM scm_struct_create_handle (SCM obj);
#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_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_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_port_rw_active scm_port_rw_active__GONE__REPLACE_WITH__scm_t_port_rw_active
#define scm_ptob_descriptor scm_ptob_descriptor__GONE__REPLACE_WITH__scm_t_ptob_descriptor
#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
typedef scm_i_t_array scm_i_t_array__GONE__REPLACE_WITH__scm_t_array;

8
libguile/evalext.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_EVALEXT_H
#define SCM_EVALEXT_H
/* Copyright (C) 1998,1999,2000, 2003, 2006, 2008 Free Software Foundation, Inc.
/* Copyright (C) 1998,1999,2000, 2003, 2006, 2008, 2011 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
@ -31,12 +31,6 @@ SCM_API SCM scm_defined_p (SCM sym, SCM env);
SCM_API SCM scm_self_evaluating_p (SCM obj);
SCM_INTERNAL void scm_init_evalext (void);
#if (SCM_ENABLE_DEPRECATED == 1)
#define scm_definedp scm_defined_p
#endif
#endif /* SCM_EVALEXT_H */
/*

105
libguile/gc-malloc.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006, 2008, 2009, 2010 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006, 2008, 2009, 2010, 2011 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
@ -237,106 +237,3 @@ scm_gc_strdup (const char *str, const char *what)
{
return scm_gc_strndup (str, strlen (str), what);
}
#if SCM_ENABLE_DEPRECATED == 1
/* {Deprecated front end to malloc}
*
* scm_must_malloc, scm_must_realloc, scm_must_free, scm_done_malloc,
* scm_done_free
*
* These functions provide services comparable to malloc, realloc, and
* free.
*
* There has been a fair amount of confusion around the use of these functions;
* see "Memory Blocks" in the manual. They are totally unnecessary in 2.0 given
* the Boehm GC.
*/
void *
scm_must_malloc (size_t size, const char *what)
{
scm_c_issue_deprecation_warning
("scm_must_malloc is deprecated. "
"Use scm_gc_malloc and scm_gc_free instead.");
return scm_gc_malloc (size, what);
}
void *
scm_must_realloc (void *where,
size_t old_size,
size_t size,
const char *what)
{
scm_c_issue_deprecation_warning
("scm_must_realloc is deprecated. "
"Use scm_gc_realloc and scm_gc_free instead.");
return scm_gc_realloc (where, old_size, size, what);
}
char *
scm_must_strndup (const char *str, size_t length)
{
scm_c_issue_deprecation_warning
("scm_must_strndup is deprecated. "
"Use scm_gc_strndup and scm_gc_free instead.");
return scm_gc_strndup (str, length, "string");
}
char *
scm_must_strdup (const char *str)
{
scm_c_issue_deprecation_warning
("scm_must_strdup is deprecated. "
"Use scm_gc_strdup and scm_gc_free instead.");
return scm_gc_strdup (str, "string");
}
void
scm_must_free (void *obj)
#define FUNC_NAME "scm_must_free"
{
scm_c_issue_deprecation_warning
("scm_must_free is deprecated. "
"Use scm_gc_malloc and scm_gc_free instead.");
#ifdef GUILE_DEBUG_MALLOC
scm_malloc_unregister (obj);
#endif
GC_FREE (obj);
}
#undef FUNC_NAME
void
scm_done_malloc (long size)
{
scm_c_issue_deprecation_warning
("scm_done_malloc is deprecated. "
"Use scm_gc_register_collectable_memory instead.");
if (size >= 0)
scm_gc_register_collectable_memory (NULL, size, "foreign mallocs");
else
scm_gc_unregister_collectable_memory (NULL, -size, "foreign mallocs");
}
void
scm_done_free (long size)
{
scm_c_issue_deprecation_warning
("scm_done_free is deprecated. "
"Use scm_gc_unregister_collectable_memory instead.");
if (size >= 0)
scm_gc_unregister_collectable_memory (NULL, size, "foreign mallocs");
else
scm_gc_register_collectable_memory (NULL, -size, "foreign mallocs");
}
#endif /* SCM_ENABLE_DEPRECATED == 1 */

38
libguile/gc.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_GC_H
#define SCM_GC_H
/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2002, 2003, 2004, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2002, 2003, 2004, 2006, 2007, 2008, 2009, 2010, 2011 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
@ -138,20 +138,6 @@ void *scm_ia64_ar_bsp (const void *);
#if (SCM_ENABLE_DEPRECATED == 1)
SCM_DEPRECATED size_t scm_default_init_heap_size_1;
SCM_DEPRECATED int scm_default_min_yield_1;
SCM_DEPRECATED size_t scm_default_init_heap_size_2;
SCM_DEPRECATED int scm_default_min_yield_2;
SCM_DEPRECATED size_t scm_default_max_segment_size;
#else
#define scm_default_init_heap_size_1 deprecated
#define scm_default_min_yield_1 deprecated
#define scm_default_init_heap_size_2 deprecated
#define scm_default_min_yield_2 deprecated
#define scm_default_max_segment_size deprecated
#endif
SCM_API unsigned long scm_gc_ports_collected;
SCM_API SCM scm_after_gc_hook;
@ -247,28 +233,6 @@ SCM_INTERNAL void scm_storage_prehistory (void);
SCM_INTERNAL void scm_init_gc_protect_object (void);
SCM_INTERNAL void scm_init_gc (void);
#if SCM_ENABLE_DEPRECATED == 1
SCM_DEPRECATED SCM scm_deprecated_newcell (void);
SCM_DEPRECATED SCM scm_deprecated_newcell2 (void);
#define SCM_NEWCELL(_into) \
do { _into = scm_deprecated_newcell (); } while (0)
#define SCM_NEWCELL2(_into) \
do { _into = scm_deprecated_newcell2 (); } while (0)
SCM_DEPRECATED void * scm_must_malloc (size_t len, const char *what);
SCM_DEPRECATED void * scm_must_realloc (void *where,
size_t olen, size_t len,
const char *what);
SCM_DEPRECATED char *scm_must_strdup (const char *str);
SCM_DEPRECATED char *scm_must_strndup (const char *str, size_t n);
SCM_DEPRECATED void scm_done_malloc (long size);
SCM_DEPRECATED void scm_done_free (long size);
SCM_DEPRECATED void scm_must_free (void *obj);
#endif
#endif /* SCM_GC_H */
/*

9
libguile/gen-scmconfig.c
View file

@ -383,15 +383,6 @@ main (int argc, char *argv[])
#endif
pf ("\n");
pf ("#if SCM_ENABLE_DEPRECATED == 1\n"
"# define USE_THREADS 1 /* always true now */\n"
"# define GUILE_ISELECT 1 /* always true now */\n"
"# define READER_EXTENSIONS 1 /* always true now */\n"
"# define DEBUG_EXTENSIONS 1 /* always true now */\n"
"# define DYNAMIC_LINKING 1 /* always true now */\n"
"#endif\n");
printf ("\n");
pf ("#define SCM_HAVE_ARRAYS 1 /* always true now */\n");
pf ("\n");

40
libguile/numbers.c
View file

@ -9288,46 +9288,6 @@ scm_from_double (double val)
return z;
}
#if SCM_ENABLE_DEPRECATED == 1
float
scm_num2float (SCM num, unsigned long pos, const char *s_caller)
{
scm_c_issue_deprecation_warning
("`scm_num2float' is deprecated. Use scm_to_double instead.");
if (SCM_BIGP (num))
{
float res = mpz_get_d (SCM_I_BIG_MPZ (num));
if (!isinf (res))
return res;
else
scm_out_of_range (NULL, num);
}
else
return scm_to_double (num);
}
double
scm_num2double (SCM num, unsigned long pos, const char *s_caller)
{
scm_c_issue_deprecation_warning
("`scm_num2double' is deprecated. Use scm_to_double instead.");
if (SCM_BIGP (num))
{
double res = mpz_get_d (SCM_I_BIG_MPZ (num));
if (!isinf (res))
return res;
else
scm_out_of_range (NULL, num);
}
else
return scm_to_double (num);
}
#endif
int
scm_is_complex (SCM val)
{

23
libguile/ports.c
View file

@ -621,29 +621,6 @@ scm_new_port_table_entry (scm_t_bits tag)
}
#undef FUNC_NAME
#if SCM_ENABLE_DEPRECATED==1
scm_t_port *
scm_add_to_port_table (SCM port)
{
SCM z;
scm_t_port * pt;
scm_c_issue_deprecation_warning ("scm_add_to_port_table is deprecated.");
scm_i_pthread_mutex_lock (&scm_i_port_table_mutex);
z = scm_new_port_table_entry (scm_tc7_port);
pt = SCM_PTAB_ENTRY(z);
pt->port = port;
SCM_SETCAR (z, SCM_EOL);
SCM_SETCDR (z, SCM_EOL);
SCM_SETPTAB_ENTRY (port, pt);
scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
return pt;
}
#endif
/* Remove a port from the table and destroy it. */
static void

4
libguile/ports.h
View file

@ -316,10 +316,6 @@ SCM_API SCM scm_void_port (char * mode_str);
SCM_API SCM scm_sys_make_void_port (SCM mode);
SCM_INTERNAL void scm_init_ports (void);
#if SCM_ENABLE_DEPRECATED==1
SCM_DEPRECATED scm_t_port * scm_add_to_port_table (SCM port);
#endif
#ifdef GUILE_DEBUG
SCM_API SCM scm_pt_size (void);
SCM_API SCM scm_pt_member (SCM member);

35
libguile/procprop.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1995,1996,1998,2000,2001,2003,2004, 2006, 2008, 2009, 2010 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1998,2000,2001,2003,2004, 2006, 2008, 2009, 2010, 2011 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
@ -22,13 +22,9 @@
# include <config.h>
#endif
#define SCM_BUILDING_DEPRECATED_CODE
#include "libguile/_scm.h"
#include "libguile/alist.h"
#include "libguile/deprecation.h"
#include "libguile/deprecated.h"
#include "libguile/eval.h"
#include "libguile/procs.h"
#include "libguile/gsubr.h"
@ -43,9 +39,6 @@
SCM_GLOBAL_SYMBOL (scm_sym_system_procedure, "system-procedure");
#if (SCM_ENABLE_DEPRECATED == 1)
SCM_GLOBAL_SYMBOL (scm_sym_arity, "arity");
#endif
SCM_GLOBAL_SYMBOL (scm_sym_name, "name");
static SCM overrides;
@ -123,10 +116,6 @@ SCM_DEFINE (scm_procedure_properties, "procedure-properties", 1, 0, 0,
ret = SCM_EOL;
}
#if (SCM_ENABLE_DEPRECATED == 1)
ret = scm_acons (scm_sym_arity, scm_procedure_minimum_arity (proc), ret);
#endif
return ret;
}
#undef FUNC_NAME
@ -138,11 +127,6 @@ SCM_DEFINE (scm_set_procedure_properties_x, "set-procedure-properties!", 2, 0, 0
{
SCM_VALIDATE_PROC (1, proc);
#if (SCM_ENABLE_DEPRECATED == 1)
if (scm_assq (alist, scm_sym_arity))
SCM_MISC_ERROR ("arity is a read-only property", SCM_EOL);
#endif
scm_i_pthread_mutex_lock (&overrides_lock);
scm_hashq_set_x (overrides, proc, alist);
scm_i_pthread_mutex_unlock (&overrides_lock);
@ -158,13 +142,6 @@ SCM_DEFINE (scm_procedure_property, "procedure-property", 2, 0, 0,
{
SCM_VALIDATE_PROC (1, proc);
#if (SCM_ENABLE_DEPRECATED == 1)
if (scm_is_eq (key, scm_sym_arity))
scm_c_issue_deprecation_warning
("Accessing a procedure's arity via `procedure-property' is deprecated.\n"
"Use `procedure-minimum-arity instead.");
#endif
return scm_assq_ref (scm_procedure_properties (proc), key);
}
#undef FUNC_NAME
@ -179,18 +156,8 @@ SCM_DEFINE (scm_set_procedure_property_x, "set-procedure-property!", 3, 0, 0,
SCM_VALIDATE_PROC (1, proc);
#if (SCM_ENABLE_DEPRECATED == 1)
if (scm_is_eq (key, scm_sym_arity))
SCM_MISC_ERROR ("arity is a deprecated read-only property", SCM_EOL);
#endif
props = scm_procedure_properties (proc);
#if (SCM_ENABLE_DEPRECATED == 1)
/* cdr past the consed-on arity. */
props = scm_cdr (props);
#endif
scm_i_pthread_mutex_lock (&overrides_lock);
scm_hashq_set_x (overrides, proc, scm_assq_set_x (props, key, val));
scm_i_pthread_mutex_unlock (&overrides_lock);

5
libguile/procprop.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_PROCPROP_H
#define SCM_PROCPROP_H
/* Copyright (C) 1995,1996,1998,2000, 2006, 2008, 2009, 2010 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1998,2000, 2006, 2008, 2009, 2010, 2011 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
@ -28,9 +28,6 @@
SCM_API SCM scm_sym_name;
#if (SCM_ENABLE_DEPRECATED == 1)
SCM_DEPRECATED SCM scm_sym_arity;
#endif
SCM_API SCM scm_sym_system_procedure;

19
libguile/read.c
View file

@ -1385,29 +1385,10 @@ scm_read_sharp (scm_t_wchar chr, SCM port)
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
case '@':
#if SCM_ENABLE_DEPRECATED
/* See below for 'i' and 'e'. */
case 'a':
case 'y':
case 'h':
case 'l':
#endif
return (scm_i_read_array (port, chr));
case 'i':
case 'e':
#if SCM_ENABLE_DEPRECATED
{
/* When next char is '(', it really is an old-style
uniform array. */
scm_t_wchar next_c = scm_getc (port);
if (next_c != EOF)
scm_ungetc (next_c, port);
if (next_c == '(')
return scm_i_read_array (port, chr);
/* Fall through. */
}
#endif
case 'b':
case 'B':
case 'o':

159
libguile/socket.c
View file

@ -39,10 +39,6 @@
#include "libguile/validate.h"
#include "libguile/socket.h"
#if SCM_ENABLE_DEPRECATED == 1
# include "libguile/deprecation.h"
#endif
#ifdef __MINGW32__
#include "win32-socket.h"
#include <netdb.h>
@ -1414,33 +1410,12 @@ SCM_DEFINE (scm_recv, "recv!", 2, 1, 0,
flg = scm_to_int (flags);
fd = SCM_FPORT_FDES (sock);
#if SCM_ENABLE_DEPRECATED == 1
if (SCM_UNLIKELY (scm_is_string (buf)))
{
SCM msg;
char *dest;
size_t len;
SCM_VALIDATE_BYTEVECTOR (1, buf);
scm_c_issue_deprecation_warning
("Passing a string to `recv!' is deprecated, "
"use a bytevector instead.");
len = scm_i_string_length (buf);
msg = scm_i_make_string (len, &dest, 0);
SCM_SYSCALL (rv = recv (fd, dest, len, flg));
scm_string_copy_x (buf, scm_from_int (0),
msg, scm_from_int (0), scm_from_size_t (len));
}
else
#endif
{
SCM_VALIDATE_BYTEVECTOR (1, buf);
SCM_SYSCALL (rv = recv (fd,
SCM_BYTEVECTOR_CONTENTS (buf),
SCM_BYTEVECTOR_LENGTH (buf),
flg));
}
SCM_SYSCALL (rv = recv (fd,
SCM_BYTEVECTOR_CONTENTS (buf),
SCM_BYTEVECTOR_LENGTH (buf),
flg));
if (SCM_UNLIKELY (rv == -1))
SCM_SYSERROR;
@ -1480,35 +1455,12 @@ SCM_DEFINE (scm_send, "send", 2, 1, 0,
fd = SCM_FPORT_FDES (sock);
#if SCM_ENABLE_DEPRECATED == 1
if (SCM_UNLIKELY (scm_is_string (message)))
{
scm_c_issue_deprecation_warning
("Passing a string to `send' is deprecated, "
"use a bytevector instead.");
SCM_VALIDATE_BYTEVECTOR (1, message);
/* If the string is wide, see if it can be coerced into a narrow
string. */
if (!scm_i_is_narrow_string (message)
|| !scm_i_try_narrow_string (message))
SCM_MISC_ERROR ("the message string is not 8-bit: ~s",
scm_list_1 (message));
SCM_SYSCALL (rv = send (fd,
scm_i_string_chars (message),
scm_i_string_length (message),
flg));
}
else
#endif
{
SCM_VALIDATE_BYTEVECTOR (1, message);
SCM_SYSCALL (rv = send (fd,
SCM_BYTEVECTOR_CONTENTS (message),
SCM_BYTEVECTOR_LENGTH (message),
flg));
}
SCM_SYSCALL (rv = send (fd,
SCM_BYTEVECTOR_CONTENTS (message),
SCM_BYTEVECTOR_LENGTH (message),
flg));
if (rv == -1)
SCM_SYSERROR;
@ -1566,52 +1518,28 @@ SCM_DEFINE (scm_recvfrom, "recvfrom!", 2, 3, 0,
((struct sockaddr *) &addr)->sa_family = AF_UNSPEC;
#if SCM_ENABLE_DEPRECATED == 1
if (SCM_UNLIKELY (scm_is_string (buf)))
{
char *cbuf;
SCM_VALIDATE_BYTEVECTOR (1, buf);
scm_c_issue_deprecation_warning
("Passing a string to `recvfrom!' is deprecated, "
"use a bytevector instead.");
scm_i_get_substring_spec (scm_i_string_length (buf),
start, &offset, end, &cend);
buf = scm_i_string_start_writing (buf);
cbuf = scm_i_string_writable_chars (buf);
SCM_SYSCALL (rv = recvfrom (fd, cbuf + offset,
cend - offset, flg,
(struct sockaddr *) &addr, &addr_size));
scm_i_string_stop_writing ();
}
if (SCM_UNBNDP (start))
offset = 0;
else
offset = scm_to_size_t (start);
if (SCM_UNBNDP (end))
cend = SCM_BYTEVECTOR_LENGTH (buf);
else
#endif
{
SCM_VALIDATE_BYTEVECTOR (1, buf);
if (SCM_UNBNDP (start))
offset = 0;
else
offset = scm_to_size_t (start);
if (SCM_UNBNDP (end))
cend = SCM_BYTEVECTOR_LENGTH (buf);
else
{
cend = scm_to_size_t (end);
if (SCM_UNLIKELY (cend >= SCM_BYTEVECTOR_LENGTH (buf)
|| cend < offset))
scm_out_of_range (FUNC_NAME, end);
}
SCM_SYSCALL (rv = recvfrom (fd,
SCM_BYTEVECTOR_CONTENTS (buf) + offset,
cend - offset, flg,
(struct sockaddr *) &addr, &addr_size));
cend = scm_to_size_t (end);
if (SCM_UNLIKELY (cend >= SCM_BYTEVECTOR_LENGTH (buf)
|| cend < offset))
scm_out_of_range (FUNC_NAME, end);
}
SCM_SYSCALL (rv = recvfrom (fd,
SCM_BYTEVECTOR_CONTENTS (buf) + offset,
cend - offset, flg,
(struct sockaddr *) &addr, &addr_size));
if (rv == -1)
SCM_SYSERROR;
@ -1681,35 +1609,12 @@ SCM_DEFINE (scm_sendto, "sendto", 3, 1, 1,
flg = SCM_NUM2ULONG (5, SCM_CAR (args_and_flags));
}
#if SCM_ENABLE_DEPRECATED == 1
if (SCM_UNLIKELY (scm_is_string (message)))
{
scm_c_issue_deprecation_warning
("Passing a string to `sendto' is deprecated, "
"use a bytevector instead.");
SCM_VALIDATE_BYTEVECTOR (1, message);
/* If the string is wide, see if it can be coerced into a narrow
string. */
if (!scm_i_is_narrow_string (message)
|| !scm_i_try_narrow_string (message))
SCM_MISC_ERROR ("the message string is not 8-bit: ~s",
scm_list_1 (message));
SCM_SYSCALL (rv = sendto (fd,
scm_i_string_chars (message),
scm_i_string_length (message),
flg, soka, size));
}
else
#endif
{
SCM_VALIDATE_BYTEVECTOR (1, message);
SCM_SYSCALL (rv = sendto (fd,
SCM_BYTEVECTOR_CONTENTS (message),
SCM_BYTEVECTOR_LENGTH (message),
flg, soka, size));
}
SCM_SYSCALL (rv = sendto (fd,
SCM_BYTEVECTOR_CONTENTS (message),
SCM_BYTEVECTOR_LENGTH (message),
flg, soka, size));
if (rv == -1)
{

12
libguile/srfi-4.h
View file

@ -2,7 +2,7 @@
#define SCM_SRFI_4_H
/* srfi-4.c --- Homogeneous numeric vector datatypes.
*
* Copyright (C) 2001, 2004, 2006, 2008, 2009, 2010 Free Software Foundation, Inc.
* Copyright (C) 2001, 2004, 2006, 2008, 2009, 2010, 2011 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
@ -279,16 +279,6 @@ SCM_INTERNAL const char *scm_i_uniform_vector_tag (SCM uvec);
SCM_INTERNAL scm_i_t_array_ref scm_i_uniform_vector_ref_proc (SCM uvec);
SCM_INTERNAL scm_i_t_array_set scm_i_uniform_vector_set_proc (SCM uvec);
#if SCM_ENABLE_DEPRECATED
/* Deprecated because we want people to use the scm_t_array_handle
interface.
*/
SCM_DEPRECATED size_t scm_uniform_element_size (SCM obj);
#endif
SCM_INTERNAL void scm_init_srfi_4 (void);
#endif /* SCM_SRFI_4_H */

60
libguile/strings.c
View file

@ -2122,66 +2122,6 @@ scm_i_get_substring_spec (size_t len,
*cend = scm_to_unsigned_integer (end, *cstart, len);
}
#if SCM_ENABLE_DEPRECATED
/* When these definitions are removed, it becomes reasonable to use
read-only strings for string literals. For that, change the reader
to create string literals with scm_c_substring_read_only instead of
with scm_c_substring_copy.
*/
int
scm_i_deprecated_stringp (SCM str)
{
scm_c_issue_deprecation_warning
("SCM_STRINGP is deprecated. Use scm_is_string instead.");
return scm_is_string (str);
}
char *
scm_i_deprecated_string_chars (SCM str)
{
char *chars;
scm_c_issue_deprecation_warning
("SCM_STRING_CHARS is deprecated. See the manual for alternatives.");
/* We don't accept shared substrings here since they are not
null-terminated.
*/
if (IS_SH_STRING (str))
scm_misc_error (NULL,
"SCM_STRING_CHARS does not work with shared substrings",
SCM_EOL);
/* We explicitly test for read-only strings to produce a better
error message.
*/
if (IS_RO_STRING (str))
scm_misc_error (NULL,
"SCM_STRING_CHARS does not work with read-only strings",
SCM_EOL);
/* The following is still wrong, of course...
*/
str = scm_i_string_start_writing (str);
chars = scm_i_string_writable_chars (str);
scm_i_string_stop_writing ();
return chars;
}
size_t
scm_i_deprecated_string_length (SCM str)
{
scm_c_issue_deprecation_warning
("SCM_STRING_LENGTH is deprecated. Use scm_c_string_length instead.");
return scm_c_string_length (str);
}
#endif
static SCM
string_handle_ref (scm_t_array_handle *h, size_t index)
{

15
libguile/strings.h
View file

@ -235,21 +235,6 @@ SCM_API SCM scm_sys_stringbuf_hist (void);
/* deprecated stuff */
#if SCM_ENABLE_DEPRECATED
SCM_DEPRECATED int scm_i_deprecated_stringp (SCM obj);
SCM_DEPRECATED char *scm_i_deprecated_string_chars (SCM str);
SCM_DEPRECATED size_t scm_i_deprecated_string_length (SCM str);
#define SCM_STRINGP(x) scm_i_deprecated_stringp(x)
#define SCM_STRING_CHARS(x) scm_i_deprecated_string_chars(x)
#define SCM_STRING_LENGTH(x) scm_i_deprecated_string_length(x)
#define SCM_STRING_UCHARS(str) ((unsigned char *)SCM_STRING_CHARS (str))
#endif
SCM_INTERNAL void scm_init_strings (void);
#endif /* SCM_STRINGS_H */

9
libguile/tags.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_TAGS_H
#define SCM_TAGS_H
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2008,2009,2010
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2008,2009,2010,2011
* Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
@ -652,13 +652,6 @@ enum scm_tc8_tags
#if (SCM_ENABLE_DEPRECATED == 1)
#define SCM_CELLP(x) (((sizeof (scm_t_cell) - 1) & SCM_UNPACK (x)) == 0)
#define SCM_NCELLP(x) (!SCM_CELLP (x))
#endif
#endif /* SCM_TAGS_H */
/*

36
module/ice-9/boot-9.scm
View file

@ -2065,33 +2065,6 @@ VALUE."
(define (module-define-submodule! module name submodule)
(hashq-set! (module-submodules module) name submodule))
;; It used to be, however, that module names were also present in the
;; value namespace. When we enable deprecated code, we preserve this
;; legacy behavior.
;;
;; These shims are defined here instead of in deprecated.scm because we
;; need their definitions before loading other modules.
;;
(begin-deprecated
(define (module-ref-submodule module name)
(or (hashq-ref (module-submodules module) name)
(and (module-submodule-binder module)
((module-submodule-binder module) module name))
(let ((var (module-local-variable module name)))
(and var (variable-bound? var) (module? (variable-ref var))
(begin
(warn "module" module "not in submodules table")
(variable-ref var))))))
(define (module-define-submodule! module name submodule)
(let ((var (module-local-variable module name)))
(if (and var
(or (not (variable-bound? var))
(not (module? (variable-ref var)))))
(warn "defining module" module ": not overriding local definition" var)
(module-define! module name submodule)))
(hashq-set! (module-submodules module) name submodule)))
;;; {Module-based Loading}
@ -3174,15 +3147,6 @@ module '(ice-9 q) '(make-q q-length))}."
(process-use-modules (list quoted-args ...))
*unspecified*))))))
(define-syntax use-syntax
(syntax-rules ()
((_ spec ...)
(begin
(eval-when (eval load compile expand)
(issue-deprecation-warning
"`use-syntax' is deprecated. Please contact guile-devel for more info."))
(use-modules spec ...)))))
(include-from-path "ice-9/r6rs-libraries")
(define-syntax define-private

848
module/ice-9/deprecated.scm
View file

@ -16,851 +16,5 @@
;;;;
(define-module (ice-9 deprecated)
#:export (substring-move-left! substring-move-right!
dynamic-maybe-call dynamic-maybe-link
try-module-linked try-module-dynamic-link
list* feature? eval-case unmemoize-expr
$asinh
$acosh
$atanh
$sqrt
$abs
$exp
$log
$sin
$cos
$tan
$asin
$acos
$atan
$sinh
$cosh
$tanh
closure?
%nil
@bind
bad-throw
error-catching-loop
error-catching-repl
scm-style-repl
apply-to-args
has-suffix?
scheme-file-suffix
get-option
for-next-option
display-usage-report
transform-usage-lambda
collect
assert-repl-silence
assert-repl-print-unspecified
assert-repl-verbosity
set-repl-prompt!
set-batch-mode?!
repl
pre-unwind-handler-dispatch
default-pre-unwind-handler
handle-system-error
stack-saved?
the-last-stack
save-stack
named-module-use!
top-repl
turn-on-debugging
read-hash-procedures
process-define-module))
#:export ())
;;;; Deprecated definitions.
(define substring-move-left!
(lambda args
(issue-deprecation-warning
"`substring-move-left!' is deprecated. Use `substring-move!' instead.")
(apply substring-move! args)))
(define substring-move-right!
(lambda args
(issue-deprecation-warning
"`substring-move-right!' is deprecated. Use `substring-move!' instead.")
(apply substring-move! args)))
;; This method of dynamically linking Guile Extensions is deprecated.
;; Use `load-extension' explicitly from Scheme code instead.
(define (split-c-module-name str)
(let loop ((rev '())
(start 0)
(pos 0)
(end (string-length str)))
(cond
((= pos end)
(reverse (cons (string->symbol (substring str start pos)) rev)))
((eq? (string-ref str pos) #\space)
(loop (cons (string->symbol (substring str start pos)) rev)
(+ pos 1)
(+ pos 1)
end))
(else
(loop rev start (+ pos 1) end)))))
(define (convert-c-registered-modules dynobj)
(let ((res (map (lambda (c)
(list (split-c-module-name (car c)) (cdr c) dynobj))
(c-registered-modules))))
(c-clear-registered-modules)
res))
(define registered-modules '())
(define (register-modules dynobj)
(set! registered-modules
(append! (convert-c-registered-modules dynobj)
registered-modules)))
(define (warn-autoload-deprecation modname)
(issue-deprecation-warning
"Autoloading of compiled code modules is deprecated."
"Write a Scheme file instead that uses `load-extension'.")
(issue-deprecation-warning
(simple-format #f "(You just autoloaded module ~S.)" modname)))
(define (init-dynamic-module modname)
;; Register any linked modules which have been registered on the C level
(register-modules #f)
(or-map (lambda (modinfo)
(if (equal? (car modinfo) modname)
(begin
(warn-autoload-deprecation modname)
(set! registered-modules (delq! modinfo registered-modules))
(let ((mod (resolve-module modname #f)))
(save-module-excursion
(lambda ()
(set-current-module mod)
(set-module-public-interface! mod mod)
(dynamic-call (cadr modinfo) (caddr modinfo))
))
#t))
#f))
registered-modules))
(define (dynamic-maybe-call name dynobj)
(issue-deprecation-warning
"`dynamic-maybe-call' is deprecated. "
"Wrap `dynamic-call' in a `false-if-exception' yourself.")
(false-if-exception (dynamic-call name dynobj)))
(define (dynamic-maybe-link filename)
(issue-deprecation-warning
"`dynamic-maybe-link' is deprecated. "
"Wrap `dynamic-link' in a `false-if-exception' yourself.")
(false-if-exception (dynamic-link filename)))
(define (find-and-link-dynamic-module module-name)
(define (make-init-name mod-name)
(string-append "scm_init"
(list->string (map (lambda (c)
(if (or (char-alphabetic? c)
(char-numeric? c))
c
#\_))
(string->list mod-name)))
"_module"))
;; Put the subdirectory for this module in the car of SUBDIR-AND-LIBNAME,
;; and the `libname' (the name of the module prepended by `lib') in the cdr
;; field. For example, if MODULE-NAME is the list (inet tcp-ip udp), then
;; SUBDIR-AND-LIBNAME will be the pair ("inet/tcp-ip" . "libudp").
(let ((subdir-and-libname
(let loop ((dirs "")
(syms module-name))
(if (null? (cdr syms))
(cons dirs (string-append "lib" (symbol->string (car syms))))
(loop (string-append dirs (symbol->string (car syms)) "/")
(cdr syms)))))
(init (make-init-name (apply string-append
(map (lambda (s)
(string-append "_"
(symbol->string s)))
module-name)))))
(let ((subdir (car subdir-and-libname))
(libname (cdr subdir-and-libname)))
;; Now look in each dir in %LOAD-PATH for `subdir/libfoo.la'. If that
;; file exists, fetch the dlname from that file and attempt to link
;; against it. If `subdir/libfoo.la' does not exist, or does not seem
;; to name any shared library, look for `subdir/libfoo.so' instead and
;; link against that.
(let check-dirs ((dir-list %load-path))
(if (null? dir-list)
#f
(let* ((dir (in-vicinity (car dir-list) subdir))
(sharlib-full
(or (try-using-libtool-name dir libname)
(try-using-sharlib-name dir libname))))
(if (and sharlib-full (file-exists? sharlib-full))
(link-dynamic-module sharlib-full init)
(check-dirs (cdr dir-list)))))))))
(define (try-using-libtool-name libdir libname)
(let ((libtool-filename (in-vicinity libdir
(string-append libname ".la"))))
(and (file-exists? libtool-filename)
libtool-filename)))
(define (try-using-sharlib-name libdir libname)
(in-vicinity libdir (string-append libname ".so")))
(define (link-dynamic-module filename initname)
;; Register any linked modules which have been registered on the C level
(register-modules #f)
(let ((dynobj (dynamic-link filename)))
(dynamic-call initname dynobj)
(register-modules dynobj)))
(define (try-module-linked module-name)
(issue-deprecation-warning
"`try-module-linked' is deprecated."
"See the manual for how more on C extensions.")
(init-dynamic-module module-name))
(define (try-module-dynamic-link module-name)
(issue-deprecation-warning
"`try-module-dynamic-link' is deprecated."
"See the manual for how more on C extensions.")
(and (find-and-link-dynamic-module module-name)
(init-dynamic-module module-name)))
(define (list* . args)
(issue-deprecation-warning "'list*' is deprecated. Use 'cons*' instead.")
(apply cons* args))
(define (feature? sym)
(issue-deprecation-warning
"`feature?' is deprecated. Use `provided?' instead.")
(provided? sym))
(define-macro (eval-case . clauses)
(issue-deprecation-warning
"`eval-case' is deprecated. Use `eval-when' instead.")
;; Practically speaking, eval-case only had load-toplevel and else as
;; conditions.
(cond
((assoc-ref clauses '(load-toplevel))
=> (lambda (exps)
;; the *unspecified so that non-toplevel definitions will be
;; caught
`(begin *unspecified* . ,exps)))
((assoc-ref clauses 'else)
=> (lambda (exps)
`(begin *unspecified* . ,exps)))
(else
`(begin))))
;; The strange prototype system for uniform arrays has been
;; deprecated.
(read-hash-extend
#\y
(lambda (c port)
(issue-deprecation-warning
"The `#y' bytevector syntax is deprecated. Use `#s8' instead.")
(let ((x (read port)))
(cond
((list? x) (list->s8vector x))
(else (error "#y needs to be followed by a list" x))))))
(define (unmemoize-expr . args)
(issue-deprecation-warning
"`unmemoize-expr' is deprecated. Use `unmemoize-expression' instead.")
(apply unmemoize-expression args))
(define ($asinh z)
(issue-deprecation-warning
"`$asinh' is deprecated. Use `asinh' instead.")
(asinh z))
(define ($acosh z)
(issue-deprecation-warning
"`$acosh' is deprecated. Use `acosh' instead.")
(acosh z))
(define ($atanh z)
(issue-deprecation-warning
"`$atanh' is deprecated. Use `atanh' instead.")
(atanh z))
(define ($sqrt z)
(issue-deprecation-warning
"`$sqrt' is deprecated. Use `sqrt' instead.")
(sqrt z))
(define ($abs z)
(issue-deprecation-warning
"`$abs' is deprecated. Use `abs' instead.")
(abs z))
(define ($exp z)
(issue-deprecation-warning
"`$exp' is deprecated. Use `exp' instead.")
(exp z))
(define ($log z)
(issue-deprecation-warning
"`$log' is deprecated. Use `log' instead.")
(log z))
(define ($sin z)
(issue-deprecation-warning
"`$sin' is deprecated. Use `sin' instead.")
(sin z))
(define ($cos z)
(issue-deprecation-warning
"`$cos' is deprecated. Use `cos' instead.")
(cos z))
(define ($tan z)
(issue-deprecation-warning
"`$tan' is deprecated. Use `tan' instead.")
(tan z))
(define ($asin z)
(issue-deprecation-warning
"`$asin' is deprecated. Use `asin' instead.")
(asin z))
(define ($acos z)
(issue-deprecation-warning
"`$acos' is deprecated. Use `acos' instead.")
(acos z))
(define ($atan z)
(issue-deprecation-warning
"`$atan' is deprecated. Use `atan' instead.")
(atan z))
(define ($sinh z)
(issue-deprecation-warning
"`$sinh' is deprecated. Use `sinh' instead.")
(sinh z))
(define ($cosh z)
(issue-deprecation-warning
"`$cosh' is deprecated. Use `cosh' instead.")
(cosh z))
(define ($tanh z)
(issue-deprecation-warning
"`$tanh' is deprecated. Use `tanh' instead.")
(tanh z))
(define (closure? x)
(issue-deprecation-warning
"`closure?' is deprecated. Use `procedure?' instead.")
(procedure? x))
(define %nil #nil)
;;; @bind is used by the old elisp code as a dynamic scoping mechanism.
;;; Please let the Guile developers know if you are using this macro.
;;;
(define-syntax @bind
(lambda (x)
(define (bound-member id ids)
(cond ((null? ids) #f)
((bound-identifier=? id (car ids)) #t)
((bound-member (car ids) (cdr ids)))))
(issue-deprecation-warning
"`@bind' is deprecated. Use `with-fluids' instead.")
(syntax-case x ()
((_ () b0 b1 ...)
#'(let () b0 b1 ...))
((_ ((id val) ...) b0 b1 ...)
(and-map identifier? #'(id ...))
(if (let lp ((ids #'(id ...)))
(cond ((null? ids) #f)
((bound-member (car ids) (cdr ids)) #t)
(else (lp (cdr ids)))))
(syntax-violation '@bind "duplicate bound identifier" x)
(with-syntax (((old-v ...) (generate-temporaries #'(id ...)))
((v ...) (generate-temporaries #'(id ...))))
#'(let ((old-v id) ...
(v val) ...)
(dynamic-wind
(lambda ()
(set! id v) ...)
(lambda () b0 b1 ...)
(lambda ()
(set! id old-v) ...)))))))))
;; There are deprecated definitions for module-ref-submodule and
;; module-define-submodule! in boot-9.scm.
;; Define (%app) and (%app modules), and have (app) alias (%app). This
;; side-effects the-root-module, both to the submodules table and (through
;; module-define-submodule! above) the obarray.
;;
(let ((%app (make-module 31)))
(set-module-name! %app '(%app))
(module-define-submodule! the-root-module '%app %app)
(module-define-submodule! the-root-module 'app %app)
(module-define-submodule! %app 'modules (resolve-module '() #f)))
;; Allow code that poked %module-public-interface to keep on working.
;;
(set! module-public-interface
(let ((getter module-public-interface))
(lambda (mod)
(or (getter mod)
(cond
((and=> (module-local-variable mod '%module-public-interface)
variable-ref)
=> (lambda (iface)
(issue-deprecation-warning
"Setting a module's public interface via munging %module-public-interface is
deprecated. Use set-module-public-interface! instead.")
(set-module-public-interface! mod iface)
iface))
(else #f))))))
(set! set-module-public-interface!
(let ((setter set-module-public-interface!))
(lambda (mod iface)
(setter mod iface)
(module-define! mod '%module-public-interface iface))))
(define (bad-throw key . args)
(issue-deprecation-warning
"`bad-throw' in the default environment is deprecated.
Find it in the `(ice-9 scm-style-repl)' module instead.")
(apply (@ (ice-9 scm-style-repl) bad-throw) key args))
(define (error-catching-loop thunk)
(issue-deprecation-warning
"`error-catching-loop' in the default environment is deprecated.
Find it in the `(ice-9 scm-style-repl)' module instead.")
((@ (ice-9 scm-style-repl) error-catching-loop) thunk))
(define (error-catching-repl r e p)
(issue-deprecation-warning
"`error-catching-repl' in the default environment is deprecated.
Find it in the `(ice-9 scm-style-repl)' module instead.")
((@ (ice-9 scm-style-repl) error-catching-repl) r e p))
(define (scm-style-repl)
(issue-deprecation-warning
"`scm-style-repl' in the default environment is deprecated.
Find it in the `(ice-9 scm-style-repl)' module instead, or
better yet, use the repl from `(system repl repl)'.")
((@ (ice-9 scm-style-repl) scm-style-repl)))
;;; Apply-to-args had the following comment attached to it in boot-9, but it's
;;; wrong-headed: in the mentioned case, a point should either be a record or
;;; multiple values.
;;;
;;; apply-to-args is functionally redundant with apply and, worse,
;;; is less general than apply since it only takes two arguments.
;;;
;;; On the other hand, apply-to-args is a syntacticly convenient way to
;;; perform binding in many circumstances when the "let" family of
;;; of forms don't cut it. E.g.:
;;;
;;; (apply-to-args (return-3d-mouse-coords)
;;; (lambda (x y z)
;;; ...))
;;;
(define (apply-to-args args fn)
(issue-deprecation-warning
"`apply-to-args' is deprecated. Include a local copy in your program.")
(apply fn args))
(define (has-suffix? str suffix)
(issue-deprecation-warning
"`has-suffix?' is deprecated. Use `string-suffix?' instead (args reversed).")
(string-suffix? suffix str))
(define scheme-file-suffix
(lambda ()
(issue-deprecation-warning
"`scheme-file-suffix' is deprecated. Use `%load-extensions' instead.")
".scm"))
;;; {Command Line Options}
;;;
(define (get-option argv kw-opts kw-args return)
(issue-deprecation-warning
"`get-option' is deprecated. Use `(ice-9 getopt-long)' instead.")
(cond
((null? argv)
(return #f #f argv))
((or (not (eq? #\- (string-ref (car argv) 0)))
(eq? (string-length (car argv)) 1))
(return 'normal-arg (car argv) (cdr argv)))
((eq? #\- (string-ref (car argv) 1))
(let* ((kw-arg-pos (or (string-index (car argv) #\=)
(string-length (car argv))))
(kw (symbol->keyword (substring (car argv) 2 kw-arg-pos)))
(kw-opt? (member kw kw-opts))
(kw-arg? (member kw kw-args))
(arg (or (and (not (eq? kw-arg-pos (string-length (car argv))))
(substring (car argv)
(+ kw-arg-pos 1)
(string-length (car argv))))
(and kw-arg?
(begin (set! argv (cdr argv)) (car argv))))))
(if (or kw-opt? kw-arg?)
(return kw arg (cdr argv))
(return 'usage-error kw (cdr argv)))))
(else
(let* ((char (substring (car argv) 1 2))
(kw (symbol->keyword char)))
(cond
((member kw kw-opts)
(let* ((rest-car (substring (car argv) 2 (string-length (car argv))))
(new-argv (if (= 0 (string-length rest-car))
(cdr argv)
(cons (string-append "-" rest-car) (cdr argv)))))
(return kw #f new-argv)))
((member kw kw-args)
(let* ((rest-car (substring (car argv) 2 (string-length (car argv))))
(arg (if (= 0 (string-length rest-car))
(cadr argv)
rest-car))
(new-argv (if (= 0 (string-length rest-car))
(cddr argv)
(cdr argv))))
(return kw arg new-argv)))
(else (return 'usage-error kw argv)))))))
(define (for-next-option proc argv kw-opts kw-args)
(issue-deprecation-warning
"`for-next-option' is deprecated. Use `(ice-9 getopt-long)' instead.")
(let loop ((argv argv))
(get-option argv kw-opts kw-args
(lambda (opt opt-arg argv)
(and opt (proc opt opt-arg argv loop))))))
(define (display-usage-report kw-desc)
(issue-deprecation-warning
"`display-usage-report' is deprecated. Use `(ice-9 getopt-long)' instead.")
(for-each
(lambda (kw)
(or (eq? (car kw) #t)
(eq? (car kw) 'else)
(let* ((opt-desc kw)
(help (cadr opt-desc))
(opts (car opt-desc))
(opts-proper (if (string? (car opts)) (cdr opts) opts))
(arg-name (if (string? (car opts))
(string-append "<" (car opts) ">")
""))
(left-part (string-append
(with-output-to-string
(lambda ()
(map (lambda (x) (display (keyword->symbol x)) (display " "))
opts-proper)))
arg-name))
(middle-part (if (and (< (string-length left-part) 30)
(< (string-length help) 40))
(make-string (- 30 (string-length left-part)) #\ )
"\n\t")))
(display left-part)
(display middle-part)
(display help)
(newline))))
kw-desc))
(define (transform-usage-lambda cases)
(issue-deprecation-warning
"`display-usage-report' is deprecated. Use `(ice-9 getopt-long)' instead.")
(let* ((raw-usage (delq! 'else (map car cases)))
(usage-sans-specials (map (lambda (x)
(or (and (not (list? x)) x)
(and (symbol? (car x)) #t)
(and (boolean? (car x)) #t)
x))
raw-usage))
(usage-desc (delq! #t usage-sans-specials))
(kw-desc (map car usage-desc))
(kw-opts (apply append (map (lambda (x) (and (not (string? (car x))) x)) kw-desc)))
(kw-args (apply append (map (lambda (x) (and (string? (car x)) (cdr x))) kw-desc)))
(transmogrified-cases (map (lambda (case)
(cons (let ((opts (car case)))
(if (or (boolean? opts) (eq? 'else opts))
opts
(cond
((symbol? (car opts)) opts)
((boolean? (car opts)) opts)
((string? (caar opts)) (cdar opts))
(else (car opts)))))
(cdr case)))
cases)))
`(let ((%display-usage (lambda () (display-usage-report ',usage-desc))))
(lambda (%argv)
(let %next-arg ((%argv %argv))
(get-option %argv
',kw-opts
',kw-args
(lambda (%opt %arg %new-argv)
(case %opt
,@ transmogrified-cases))))))))
;;; {collect}
;;;
;;; Similar to `begin' but returns a list of the results of all constituent
;;; forms instead of the result of the last form.
;;;
(define-syntax collect
(lambda (x)
(issue-deprecation-warning
"`collect' is deprecated. Define it yourself.")
(syntax-case x ()
((_) #''())
((_ x x* ...)
#'(let ((val x))
(cons val (collect x* ...)))))))
(define (assert-repl-silence v)
(issue-deprecation-warning
"`assert-repl-silence' has moved to `(ice-9 scm-style-repl)'.")
((@ (ice-9 scm-style-repl) assert-repl-silence) v))
(define (assert-repl-print-unspecified v)
(issue-deprecation-warning
"`assert-repl-print-unspecified' has moved to `(ice-9 scm-style-repl)'.")
((@ (ice-9 scm-style-repl) assert-repl-print-unspecified) v))
(define (assert-repl-verbosity v)
(issue-deprecation-warning
"`assert-repl-verbosity' has moved to `(ice-9 scm-style-repl)'.")
((@ (ice-9 scm-style-repl) assert-repl-verbosity) v))
(define (set-repl-prompt! v)
(issue-deprecation-warning
"`set-repl-prompt!' is deprecated. Use `repl-default-prompt-set!' from
the `(system repl common)' module.")
;; Avoid @, as when bootstrapping it will cause the (system repl common)
;; module to be loaded at expansion time, which eventually loads srfi-1, but
;; that fails due to an unbuilt supporting lib... grrrrrrrrr.
((module-ref (resolve-interface '(system repl common))
'repl-default-prompt-set!)
v))
(define (set-batch-mode?! arg)
(cond
(arg
(issue-deprecation-warning
"`set-batch-mode?!' is deprecated. Use `ensure-batch-mode!' instead.")
(ensure-batch-mode!))
(else
(issue-deprecation-warning
"`set-batch-mode?!' with an argument of `#f' is deprecated. Use the
`*repl-stack*' fluid instead.")
#t)))
(define (repl read evaler print)
(issue-deprecation-warning
"`repl' is deprecated. Define it yourself.")
(let loop ((source (read (current-input-port))))
(print (evaler source))
(loop (read (current-input-port)))))
(define (pre-unwind-handler-dispatch key . args)
(issue-deprecation-warning
"`pre-unwind-handler-dispatch' is deprecated. Use
`default-pre-unwind-handler' from `(ice-9 scm-style-repl)' directly.")
(apply (@ (ice-9 scm-style-repl) default-pre-unwind-handler) key args))
(define (default-pre-unwind-handler key . args)
(issue-deprecation-warning
"`default-pre-unwind-handler' is deprecated. Use it from
`(ice-9 scm-style-repl)' if you need it.")
(apply (@ (ice-9 scm-style-repl) default-pre-unwind-handler) key args))
(define (handle-system-error key . args)
(issue-deprecation-warning
"`handle-system-error' is deprecated. Use it from
`(ice-9 scm-style-repl)' if you need it.")
(apply (@ (ice-9 scm-style-repl) handle-system-error) key args))
(define-syntax stack-saved?
(make-variable-transformer
(lambda (x)
(issue-deprecation-warning
"`stack-saved?' is deprecated. Use it from
`(ice-9 save-stack)' if you need it.")
(syntax-case x (set!)
((set! id val)
(identifier? #'id)
#'(set! (@ (ice-9 save-stack) stack-saved?) val))
(id
(identifier? #'id)
#'(@ (ice-9 save-stack) stack-saved?))))))
(define-syntax the-last-stack
(lambda (x)
(issue-deprecation-warning
"`the-last-stack' is deprecated. Use it from `(ice-9 save-stack)'
if you need it.")
(syntax-case x ()
(id
(identifier? #'id)
#'(@ (ice-9 save-stack) the-last-stack)))))
(define (save-stack . args)
(issue-deprecation-warning
"`save-stack' is deprecated. Use it from `(ice-9 save-stack)' if you need
it.")
(apply (@ (ice-9 save-stack) save-stack) args))
(define (named-module-use! user usee)
(issue-deprecation-warning
"`named-module-use!' is deprecated. Define it yourself if you need it.")
(module-use! (resolve-module user) (resolve-interface usee)))
(define (top-repl)
(issue-deprecation-warning
"`top-repl' has moved to the `(ice-9 top-repl)' module.")
((module-ref (resolve-module '(ice-9 top-repl)) 'top-repl)))
(set! debug-enable
(let ((debug-enable debug-enable))
(lambda opts
(if (memq 'debug opts)
(begin
(issue-deprecation-warning
"`(debug-enable 'debug)' is obsolete and has no effect."
"Remove it from your code.")
(apply debug-enable (delq 'debug opts)))
(apply debug-enable opts)))))
(define (turn-on-debugging)
(issue-deprecation-warning
"`(turn-on-debugging)' is obsolete and usually has no effect."
"Debugging capabilities are present by default.")
(debug-enable 'backtrace)
(read-enable 'positions))
(define (read-hash-procedures-warning)
(issue-deprecation-warning
"`read-hash-procedures' is deprecated."
"Use the fluid `%read-hash-procedures' instead."))
(define-syntax read-hash-procedures
(identifier-syntax
(_
(begin (read-hash-procedures-warning)
(fluid-ref %read-hash-procedures)))
((set! _ expr)
(begin (read-hash-procedures-warning)
(fluid-set! %read-hash-procedures expr)))))
(define (process-define-module args)
(define (missing kw)
(error "missing argument to define-module keyword" kw))
(define (unrecognized arg)
(error "unrecognized define-module argument" arg))
(issue-deprecation-warning
"`process-define-module' is deprecated. Use `define-module*' instead.")
(let ((name (car args))
(filename #f)
(pure? #f)
(version #f)
(system? #f)
(duplicates '())
(transformer #f))
(let loop ((kws (cdr args))
(imports '())
(exports '())
(re-exports '())
(replacements '())
(autoloads '()))
(if (null? kws)
(define-module* name
#:filename filename #:pure pure? #:version version
#:duplicates duplicates #:transformer transformer
#:imports (reverse! imports)
#:exports exports
#:re-exports re-exports
#:replacements replacements
#:autoloads autoloads)
(case (car kws)
((#:use-module #:use-syntax)
(or (pair? (cdr kws))
(missing (car kws)))
(cond
((equal? (cadr kws) '(ice-9 syncase))
(issue-deprecation-warning
"(ice-9 syncase) is deprecated. Support for syntax-case is now in Guile core.")
(loop (cddr kws)
imports exports re-exports replacements autoloads))
(else
(let ((iface-spec (cadr kws)))
(if (eq? (car kws) #:use-syntax)
(set! transformer iface-spec))
(loop (cddr kws)
(cons iface-spec imports) exports re-exports
replacements autoloads)))))
((#:autoload)
(or (and (pair? (cdr kws)) (pair? (cddr kws)))
(missing (car kws)))
(let ((name (cadr kws))
(bindings (caddr kws)))
(loop (cdddr kws)
imports exports re-exports
replacements (cons* name bindings autoloads))))
((#:no-backtrace)
;; FIXME: deprecate?
(set! system? #t)
(loop (cdr kws)
imports exports re-exports replacements autoloads))
((#:pure)
(set! pure? #t)
(loop (cdr kws)
imports exports re-exports replacements autoloads))
((#:version)
(or (pair? (cdr kws))
(missing (car kws)))
(set! version (cadr kws))
(loop (cddr kws)
imports exports re-exports replacements autoloads))
((#:duplicates)
(if (not (pair? (cdr kws)))
(missing (car kws)))
(set! duplicates (cadr kws))
(loop (cddr kws)
imports exports re-exports replacements autoloads))
((#:export #:export-syntax)
(or (pair? (cdr kws))
(missing (car kws)))
(loop (cddr kws)
imports (append exports (cadr kws)) re-exports
replacements autoloads))
((#:re-export #:re-export-syntax)
(or (pair? (cdr kws))
(missing (car kws)))
(loop (cddr kws)
imports exports (append re-exports (cadr kws))
replacements autoloads))
((#:replace #:replace-syntax)
(or (pair? (cdr kws))
(missing (car kws)))
(loop (cddr kws)
imports exports re-exports
(append replacements (cadr kws)) autoloads))
((#:filename)
(or (pair? (cdr kws))
(missing (car kws)))
(set! filename (cadr kws))
(loop (cddr kws)
imports exports re-exports replacements autoloads))
(else
(unrecognized kws)))))))