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 "modules.h"
#include "numbers.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);
}




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

#endif /* SCM_ENABLE_DEPRECATED == 1 */