guile/libguile/deprecated.c

/* Copyright 2003-2004,2006,2008-2018,2020,2021,2022,2025
     Free Software Foundation, Inc.

   This file is part of Guile.

   Guile 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.

   Guile 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 Guile.  If not, see
   <https://www.gnu.org/licenses/>.  */

#ifdef HAVE_CONFIG_H
# include <config.h>
#endif

#define SCM_BUILDING_DEPRECATED_CODE

#include "deprecation.h"
#include "eval.h"
#include "gsubr.h"
#include "keywords.h"
#include "modules.h"
#include "numbers.h"
#include "ports.h"
#include "symbols.h"
#include "threads.h"
#include "variable.h"

#include "deprecated.h"

#if (SCM_ENABLE_DEPRECATED == 1)



/* Deprecated functions go here.  */
static SCM make_guardian_var;

static void
init_make_guardian_var (void)
{
  make_guardian_var = scm_c_public_lookup ("ice-9 guardians", "make-guardian");
}

SCM
scm_make_guardian (void)
{
  static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
  scm_i_pthread_once (&once, init_make_guardian_var);

  scm_c_issue_deprecation_warning
    ("The scm_make_guardian C interface is deprecated.  Invoke the Scheme "
     "make-guardian procedure from (ice-9 guardians) instead.");

  return scm_call_0 (scm_variable_ref (make_guardian_var));
}



static SCM make_weak_vector_var;
static SCM weak_vector_var;
static SCM weak_vector_p_var;
static SCM weak_vector_length_var;
static SCM weak_vector_ref_var;
static SCM weak_vector_set_x_var;

static void
init_weak_vector_vars (void)
{
  make_weak_vector_var =
    scm_c_public_lookup ("ice-9 weak-vector", "make-weak-vector");
  weak_vector_var =
    scm_c_public_lookup ("ice-9 weak-vector", "weak-vector");
  weak_vector_p_var =
    scm_c_public_lookup ("ice-9 weak-vector", "weak-vector?");
  weak_vector_length_var =
    scm_c_public_lookup ("ice-9 weak-vector", "weak-vector-length");
  weak_vector_ref_var =
    scm_c_public_lookup ("ice-9 weak-vector", "weak-vector-ref");
  weak_vector_set_x_var =
    scm_c_public_lookup ("ice-9 weak-vector", "weak-vector-set!");
}

static void
init_weak_vectors (void)
{
  static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
  scm_c_issue_deprecation_warning
    ("The weak vector C interface is deprecated.  Invoke the Scheme "
     "procedures from (ice-9 weak-vector) instead.");
  scm_i_pthread_once (&once, init_weak_vector_vars);
}

SCM
scm_make_weak_vector (SCM len, SCM fill)
{
  init_weak_vectors ();
  return scm_call_2 (scm_variable_ref (make_weak_vector_var), len,
                     SCM_UNBNDP (fill) ? SCM_BOOL_F : fill);
}

SCM
scm_weak_vector (SCM l)
{
  init_weak_vectors ();
  return scm_call_1 (scm_variable_ref (weak_vector_var), l);
}

SCM
scm_weak_vector_p (SCM x)
{
  init_weak_vectors ();
  return scm_call_1 (scm_variable_ref (weak_vector_p_var), x);
}

SCM
scm_weak_vector_length (SCM v)
{
  init_weak_vectors ();
  return scm_call_1 (scm_variable_ref (weak_vector_length_var), v);
}

SCM
scm_weak_vector_ref (SCM v, SCM k)
{
  init_weak_vectors ();
  return scm_call_2 (scm_variable_ref (weak_vector_ref_var), v, k);
}

SCM
scm_weak_vector_set_x (SCM v, SCM k, SCM x)
{
  init_weak_vectors ();
  scm_call_3 (scm_variable_ref (weak_vector_set_x_var), v, k, x);
  return SCM_UNSPECIFIED;
}

SCM
scm_c_make_weak_vector (size_t len, SCM fill)
{
  return scm_make_weak_vector (scm_from_size_t (len), fill);
}

int
scm_is_weak_vector (SCM obj)
{
  return scm_is_true (scm_weak_vector_p (obj));
}

size_t
scm_c_weak_vector_length (SCM vec)
{
  return scm_to_size_t (scm_weak_vector_length (vec));
}

SCM
scm_c_weak_vector_ref (SCM v, size_t k)
{
  return scm_weak_vector_ref (v, scm_from_size_t (k));
}

void
scm_c_weak_vector_set_x (SCM v, size_t k, SCM x)
{
  scm_weak_vector_set_x (v, scm_from_size_t (k), x);
}




static SCM object_properties_var;
static SCM set_object_properties_var;
static SCM object_property_var;
static SCM set_object_property_var;

static void
init_object_properties_vars (void)
{
  object_properties_var =
    scm_c_public_lookup ("ice-9 object-properties", "object-properties");
  set_object_properties_var =
    scm_c_public_lookup ("ice-9 object-properties", "set-object-properties!");
  object_property_var =
    scm_c_public_lookup ("ice-9 object-properties", "object-property");
  set_object_property_var =
    scm_c_public_lookup ("ice-9 object-properties", "set-object-property!");
}

static void
init_object_properties (void)
{
  static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
  scm_c_issue_deprecation_warning
    ("The object properties C interface is deprecated.  Invoke the Scheme "
     "procedures from (ice-9 object-properties) instead.");
  scm_i_pthread_once (&once, init_object_properties_vars);
}

SCM
scm_object_properties (SCM obj)
{
  init_object_properties ();
  return scm_call_1 (scm_variable_ref (object_properties_var), obj);
}


SCM
scm_set_object_properties_x (SCM obj, SCM alist)
{
  init_object_properties ();
  return scm_call_2 (scm_variable_ref (set_object_properties_var), obj, alist);
}

SCM
scm_object_property (SCM obj, SCM key)
{
  init_object_properties ();
  return scm_call_2 (scm_variable_ref (object_property_var), obj, key);
}

SCM
scm_set_object_property_x (SCM obj, SCM key, SCM value)
{
  init_object_properties ();
  return scm_call_3 (scm_variable_ref (set_object_property_var), obj, key, value);
}




SCM_GLOBAL_SYMBOL (scm_sym_filename, "filename");
SCM_GLOBAL_SYMBOL (scm_sym_line, "line");
SCM_GLOBAL_SYMBOL (scm_sym_column, "column");

static SCM source_properties_var;
static SCM set_source_properties_var;
static SCM source_property_var;
static SCM set_source_property_var;
static SCM cons_source_var;

static void
init_source_properties_vars (void)
{
  source_properties_var =
    scm_c_public_lookup ("ice-9 source-properties", "source-properties");
  set_source_properties_var =
    scm_c_public_lookup ("ice-9 source-properties", "set-source-properties!");
  source_property_var =
    scm_c_public_lookup ("ice-9 source-properties", "source-property");
  set_source_property_var =
    scm_c_public_lookup ("ice-9 source-properties", "set-source-property!");
  cons_source_var =
    scm_c_public_lookup ("ice-9 source-properties", "cons-source");
}

static void
init_source_properties (void)
{
  static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
  scm_c_issue_deprecation_warning
    ("The source properties C interface is deprecated.  Invoke the Scheme "
     "procedures from (ice-9 source-properties) instead.");
  scm_i_pthread_once (&once, init_source_properties_vars);
}

SCM
scm_source_properties (SCM obj)
{
  init_source_properties ();
  return scm_call_1 (scm_variable_ref (source_properties_var), obj);
}


SCM
scm_set_source_properties_x (SCM obj, SCM alist)
{
  init_source_properties ();
  return scm_call_2 (scm_variable_ref (set_source_properties_var), obj, alist);
}

SCM
scm_source_property (SCM obj, SCM key)
{
  init_source_properties ();
  return scm_call_2 (scm_variable_ref (source_property_var), obj, key);
}

SCM
scm_set_source_property_x (SCM obj, SCM key, SCM value)
{
  init_source_properties ();
  return scm_call_3 (scm_variable_ref (set_source_property_var), obj, key, value);
}

SCM
scm_cons_source (SCM orig, SCM x, SCM y)
{
  init_source_properties ();
  return scm_call_3 (scm_variable_ref (cons_source_var), orig, x, y);
}

/* In versions 3.0 and prior, the hash table interface could also access
   weak tables.  This is now deprecated.  */



static SCM array_fill_x_var;
static SCM array_copy_x_var;
static SCM array_map_x_var;
static SCM array_for_each_var;
static SCM array_index_map_x_var;
static SCM array_equal_p_var;
static SCM array_slice_for_each_var;
static SCM array_cell_ref_var;
static SCM array_cell_set_x_var;

static void
init_array_map_vars (void)
{
  array_fill_x_var = scm_c_public_lookup ("ice-9 arrays", "array-fill!");
  array_copy_x_var = scm_c_public_lookup ("ice-9 arrays", "array-copy!");
  array_map_x_var = scm_c_public_lookup ("ice-9 arrays", "array-map!");
  array_for_each_var = scm_c_public_lookup ("ice-9 arrays", "array-for-each");
  array_index_map_x_var = scm_c_public_lookup ("ice-9 arrays", "array-index-map!");
  array_equal_p_var = scm_c_public_lookup ("ice-9 arrays", "array-equal?");
  array_fill_x_var = scm_c_public_lookup ("ice-9 arrays", "array-fill!");
  array_cell_ref_var = scm_c_public_lookup ("ice-9 arrays", "array-cell-ref");
  array_cell_set_x_var = scm_c_public_lookup ("ice-9 arrays", "array-cell-set!");
}

static void
init_array_map_functions (void)
{
  static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
  scm_c_issue_deprecation_warning
    ("Using the array map functions from C is deprecated.  Invoke "
     "array-map!, etc. from (ice-9 arrays) instead.");
  scm_i_pthread_once (&once, init_array_map_vars);
}

SCM
scm_array_fill_x (SCM ra, SCM fill)
{
  init_array_map_functions ();
  return scm_call_2 (scm_variable_ref (array_fill_x_var), ra, fill);
}

SCM
scm_array_copy_x (SCM src, SCM dst)
{
  init_array_map_functions ();
  return scm_call_2 (scm_variable_ref (array_copy_x_var), src, dst);
}

SCM
scm_array_map_x (SCM ra0, SCM proc, SCM lra)
{
  init_array_map_functions ();
  return scm_apply_2 (scm_variable_ref (array_map_x_var), ra0, proc, lra);
}

SCM
scm_array_for_each (SCM proc, SCM ra0, SCM lra)
{
  init_array_map_functions ();
  return scm_apply_2 (scm_variable_ref (array_for_each_var), proc, ra0, lra);
}

SCM
scm_array_index_map_x (SCM ra, SCM proc)
{
  init_array_map_functions ();
  return scm_call_2 (scm_variable_ref (array_index_map_x_var), ra, proc);
}

SCM
scm_array_equal_p (SCM ra0, SCM ra1)
{
  init_array_map_functions ();
  return scm_call_2 (scm_variable_ref (array_equal_p_var), ra0, ra1);
}

SCM
scm_array_slice_for_each (SCM frank, SCM op, SCM args)
{
  init_array_map_functions ();
  return scm_apply_2 (scm_variable_ref (array_slice_for_each_var), frank, op,
                      args);
}

SCM
scm_array_slice_for_each_in_order (SCM frank, SCM op, SCM args)
{
  return scm_array_slice_for_each (frank, op, args);
}

SCM
scm_array_cell_ref (SCM array, SCM indices)
{
  init_array_map_functions ();
  return scm_apply_1 (scm_variable_ref (array_cell_ref_var), array, indices);
}

SCM
scm_array_cell_set_x (SCM array, SCM val, SCM indices)
{
  init_array_map_functions ();
  return scm_apply_2 (scm_variable_ref (array_cell_set_x_var), array, val,
                      indices);
}




static SCM char_set_cursor_var;
static SCM char_set_ref_var;
static SCM char_set_cursor_next_var;
static SCM end_of_char_set_p_var;

static void
init_char_set_cursor_vars (void)
{
  char_set_cursor_var = scm_c_public_lookup ("srfi srfi-14", "char-set-cursor");
  char_set_ref_var = scm_c_public_lookup ("srfi srfi-14", "char-set-ref");
  char_set_cursor_next_var = scm_c_public_lookup ("srfi srfi-14", "char-set-cursor-next");
  end_of_char_set_p_var = scm_c_public_lookup ("srfi srfi-14", "end-of-char-set?");
}

static void
init_char_set_cursor_functions (void)
{
  static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
  scm_c_issue_deprecation_warning
    ("Using the char set cursor functions from C is deprecated.  Invoke"
     "char-set-cursor, etc. from (srfi srfi-14) instead.");
  scm_i_pthread_once (&once, init_char_set_cursor_vars);
}

SCM
scm_char_set_cursor (SCM cs)
{
  init_char_set_cursor_functions ();
  return scm_call_1 (scm_variable_ref (char_set_cursor_var), cs);
}

SCM
scm_char_set_ref (SCM cs, SCM cursor)
{
  init_char_set_cursor_functions ();
  return scm_call_2 (scm_variable_ref (char_set_ref_var), cs, cursor);
}

SCM
scm_char_set_cursor_next (SCM cs, SCM cursor)
{
  init_char_set_cursor_functions ();
  return scm_call_2 (scm_variable_ref (char_set_cursor_next_var), cs, cursor);
}

SCM
scm_end_of_char_set_p (SCM cursor)
{
  init_char_set_cursor_functions ();
  return scm_call_1 (scm_variable_ref (end_of_char_set_p_var), cursor);
}




static SCM make_hook_var;
static SCM hook_p_var;
static SCM hook_empty_p_var;
static SCM add_hook_x_var;
static SCM remove_hook_x_var;
static SCM reset_hook_x_var;
static SCM run_hook_var;
static SCM hook_to_list_var;

static void
init_hook_vars (void)
{
  make_hook_var = scm_c_public_lookup ("ice-9 hooks", "make-hook");
  hook_p_var = scm_c_public_lookup ("ice-9 hooks", "hook?");
  hook_empty_p_var = scm_c_public_lookup ("ice-9 hooks", "hook-empty?");
  add_hook_x_var = scm_c_public_lookup ("ice-9 hooks", "add-hook!");
  remove_hook_x_var = scm_c_public_lookup ("ice-9 hooks", "remove-hook!");
  reset_hook_x_var = scm_c_public_lookup ("ice-9 hooks", "reset-hook!");
  run_hook_var = scm_c_public_lookup ("ice-9 hooks", "run-hook");
  hook_to_list_var = scm_c_public_lookup ("ice-9 hooks", "hook->list");
}

static void
init_hook_functions (void)
{
  static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
  scm_c_issue_deprecation_warning
    ("Using the SCM hook functions from C is deprecated.  Invoke"
     "make-hook, etc. from (ice-9 hooks) instead.");
  scm_i_pthread_once (&once, init_hook_vars);
}

SCM
scm_make_hook (SCM arity)
{
  init_hook_functions ();
  return scm_call_0 (scm_variable_ref (make_hook_var));
}

SCM
scm_hook_p (SCM x)
{
  init_hook_functions ();
  return scm_call_1 (scm_variable_ref (hook_p_var), x);
}

SCM
scm_hook_empty_p (SCM hook)
{
  init_hook_functions ();
  return scm_call_1 (scm_variable_ref (hook_empty_p_var), hook);
}

SCM_KEYWORD (kw_append_p, "append?");

SCM
scm_add_hook_x (SCM hook, SCM f, SCM append_p)
{
  init_hook_functions ();
  return scm_call_4 (scm_variable_ref (add_hook_x_var), hook, f,
                     kw_append_p,
                     SCM_UNBNDP (append_p) ? SCM_BOOL_F : append_p);
}

SCM
scm_remove_hook_x (SCM hook, SCM f)
{
  init_hook_functions ();
  return scm_call_2 (scm_variable_ref (remove_hook_x_var), hook, f);
}

SCM
scm_reset_hook_x (SCM hook)
{
  init_hook_functions ();
  return scm_call_1 (scm_variable_ref (reset_hook_x_var), hook);
}

SCM
scm_run_hook (SCM hook, SCM args)
{
  init_hook_functions ();
  return scm_apply_1 (scm_variable_ref (run_hook_var), hook, args);
}

void
scm_c_run_hook (SCM hook, SCM args)
{
  scm_run_hook (hook, args);
}

void
scm_c_run_hookn (SCM hook, SCM *argsv, size_t nargs)
{
  init_hook_functions ();

  SCM hook_and_argsv[nargs + 1];
  hook_and_argsv[0] = hook;
  memcpy (&hook_and_argsv[1], argsv, nargs * sizeof (SCM));
  scm_call_n (scm_variable_ref (run_hook_var), hook_and_argsv, nargs + 1);
}

SCM
scm_hook_to_list (SCM hook)
{
  init_hook_functions ();
  return scm_call_1 (scm_variable_ref (hook_to_list_var), hook);
}




void
scm_free_print_state (SCM)
{
  scm_c_issue_deprecation_warning ("scm_free_print_state is no longer useful; "
                                   "remove calls to it.");
}

SCM
scm_coerce_outport (SCM val)
{
  scm_c_issue_deprecation_warning
    ("SCM_COERCE_OUTPORT is deprecated; just return the value instead.");
  return val;
}

int
scm_valid_oport_value_p (SCM val)
{
  scm_c_issue_deprecation_warning
    ("scm_valid_oport_value_p is deprecated.  Use SCM_OPOUTPORTP instead.");
  return SCM_OPOUTPORTP (val);
}

SCM
scm_make_print_state (void)
{
  scm_c_issue_deprecation_warning
    ("scm_make_print_state is deprecated.  Use a custom writer instead.");
  return SCM_BOOL_F;
}

SCM
scm_port_with_print_state (SCM port, SCM pstate)
{
  scm_c_issue_deprecation_warning
    ("scm_port_with_print_state is deprecated.  Just use ports.");
  return port;
}

SCM
scm_printer_apply (SCM proc, SCM exp, SCM port, scm_print_state *)
{
  scm_c_issue_deprecation_warning
    ("scm_printer_apply is deprecated.  Just use scm_call_2.");
  return scm_call_2 (proc, exp, port);
}

SCM
scm_get_print_state (SCM port)
{
  scm_c_issue_deprecation_warning
    ("scm_get_print_state is deprecated.  Use a custom writer instead.");
  return SCM_BOOL_F;
}



void
scm_i_init_deprecated ()
{
#include "deprecated.x"
}

#endif /* SCM_ENABLE_DEPRECATED == 1 */