/* Copyright 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

#include <assert.h>
#include <errno.h>
#include <fcntl.h>
#include <full-write.h>
#include <stdio.h>
#include <unistd.h>

#include "atomics-internal.h"
#include "extensions.h"
#include "gc-internal.h"
#include "gsubr.h"
#include "hash.h"
#include "numbers.h"
#include "ports.h"
#include "threads.h"
#include "trace.h"
#include "version.h"

#include <gc-ephemeron.h>

#include "ephemerons.h"




#define SCM_EPHEMERON_P(X) (SCM_HAS_TYP7 (X, scm_tc7_ephemeron))

struct gc_ephemeron*
scm_c_make_ephemeron (SCM key, SCM val)
{
  struct scm_thread *thread = SCM_I_CURRENT_THREAD;
  struct gc_ephemeron *ephemeron = gc_allocate_ephemeron (thread->mutator);
  SCM_SET_CELL_WORD_0 (PTR2SCM (ephemeron), scm_tc7_ephemeron);
  gc_ephemeron_init (thread->mutator, ephemeron, scm_to_ref (key),
                     scm_to_ref (val));
  return ephemeron;
}

static struct gc_ephemeron*
scm_as_ephemeron (SCM x)
{
  return (struct gc_ephemeron*) SCM_UNPACK_POINTER (x);
}

SCM
scm_from_ephemeron (struct gc_ephemeron *e)
{
  return PTR2SCM (e);
}

struct gc_ephemeron*
scm_to_ephemeron (SCM e)
{
  if (!SCM_EPHEMERON_P (e))
    abort ();
  return scm_as_ephemeron (e);
}

SCM
scm_c_ephemeron_key (struct gc_ephemeron *e)
{
  struct gc_ref ret = gc_ephemeron_key (e);
  return gc_ref_is_null (ret) ? SCM_BOOL_F : scm_from_ref (ret);
}

SCM
scm_c_ephemeron_value (struct gc_ephemeron *e)
{
  struct gc_ref ret = gc_ephemeron_value (e);
  return gc_ref_is_null (ret) ? SCM_BOOL_F : scm_from_ref (ret);
}

void
scm_c_ephemeron_mark_dead_x (struct gc_ephemeron *e)
{
  gc_ephemeron_mark_dead (e);
}

SCM
scm_c_ephemeron_swap_x (struct gc_ephemeron *e, SCM new_val)
{
  struct gc_ref ret =
    gc_ephemeron_swap_value (SCM_I_CURRENT_THREAD->mutator, e,
                             scm_to_ref (new_val));
  return gc_ref_is_null (ret) ? SCM_BOOL_F : scm_from_ref (ret);
}

struct gc_ephemeron*
scm_c_ephemeron_next (struct gc_ephemeron *e)
{
  return gc_ephemeron_chain_next (e);
}

struct gc_ephemeron*
scm_c_ephemeron_load (struct gc_ephemeron **loc)
{
  return gc_ephemeron_chain_head (loc);
}

void
scm_c_ephemeron_push (struct gc_ephemeron **loc, struct gc_ephemeron *e)
{
  gc_ephemeron_chain_push (loc, e);
}




#define SCM_VALIDATE_EPHEMERON(pos, x) \
  SCM_MAKE_VALIDATE_MSG (pos, x, EPHEMERON_P, "ephemeron")

SCM_DEFINE_STATIC (scm_ephemeron_p, "ephemeron?", 1, 0, 0,
                   (SCM x),
                   "Return @code{#t} if @var{x} is an ephemeron, or "
                   "@code{#f} otherwise.")
#define FUNC_NAME s_scm_ephemeron_p
{
  return scm_from_bool (SCM_EPHEMERON_P (x));
}
#undef FUNC_NAME

SCM_DEFINE_STATIC (scm_make_ephemeron, "make-ephemeron", 2, 0, 0,
                   (SCM key, SCM val),
                   "Make an ephemeron that will reference @var{val} as long "
                   "as @var{key} and the ephemeron itself are alive.")
#define FUNC_NAME s_scm_make_ephemeron
{
  return PTR2SCM (scm_c_make_ephemeron (key, val));
}
#undef FUNC_NAME

SCM_DEFINE_STATIC (scm_ephemeron_key, "ephemeron-key", 1, 0, 0,
                   (SCM ephemeron),
                   "Return the key for an ephemeron, or @code{#f} if the "
                   "ephemeron is dead.")
#define FUNC_NAME s_scm_ephemeron_key
{
  SCM_VALIDATE_EPHEMERON (1, ephemeron);
  return scm_c_ephemeron_key (scm_as_ephemeron (ephemeron));
}
#undef FUNC_NAME

SCM_DEFINE_STATIC (scm_ephemeron_value, "ephemeron-value", 1, 0, 0,
                   (SCM ephemeron),
                   "Return the value for an ephemeron, or @code{#f} if the "
                   "ephemeron is dead.")
#define FUNC_NAME s_scm_ephemeron_value
{
  SCM_VALIDATE_EPHEMERON (1, ephemeron);
  return scm_c_ephemeron_value (scm_as_ephemeron (ephemeron));
}
#undef FUNC_NAME

SCM_DEFINE_STATIC (scm_ephemeron_swap_x, "ephemeron-swap!", 2, 0, 0,
                   (SCM ephemeron, SCM new_val),
                   "Update the value for this ephemeron, and return the "
                   "previous value.")
#define FUNC_NAME s_scm_ephemeron_swap_x
{
  SCM_VALIDATE_EPHEMERON (1, ephemeron);
  return scm_c_ephemeron_swap_x (scm_as_ephemeron (ephemeron), new_val);
}
#undef FUNC_NAME

SCM_DEFINE_STATIC (scm_ephemeron_mark_dead_x, "ephemeron-mark-dead!", 1, 0, 0,
                   (SCM ephemeron),
                   "Remove the key-value association for this ephemeron.")
#define FUNC_NAME s_scm_ephemeron_mark_dead_x
{
  SCM_VALIDATE_EPHEMERON (1, ephemeron);
  scm_c_ephemeron_mark_dead_x (scm_as_ephemeron (ephemeron));
  return SCM_UNSPECIFIED;
}
#undef FUNC_NAME

SCM_DEFINE_STATIC (scm_ephemeron_next, "ephemeron-next", 1, 0, 0,
                   (SCM ephemeron),
                   "Return the next ephemeron in a chain, or @code{#f} if none.")
#define FUNC_NAME s_scm_ephemeron_next
{
  SCM_VALIDATE_EPHEMERON (1, ephemeron);
  struct gc_ephemeron *e = scm_c_ephemeron_next (scm_as_ephemeron (ephemeron));
  return e ? PTR2SCM (e) : SCM_BOOL_F;
}
#undef FUNC_NAME

int
scm_i_print_ephemeron (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
{
  scm_puts ("#<ephemeron ", port);
  scm_uintprint (SCM_UNPACK (exp), 16, port);
  scm_puts (")>", port);
  return 1;
}




#define SCM_EPHEMERON_TABLE_P(X) (SCM_HAS_TYP7 (X, scm_tc7_ephemeron_table))
#define SCM_VALIDATE_EPHEMERON_TABLE(pos, x) \
  SCM_MAKE_VALIDATE_MSG (pos, x, EPHEMERON_TABLE_P, "ephemeron table")

static struct scm_ephemeron_table*
scm_as_ephemeron_table (SCM x)
{
  return (struct scm_ephemeron_table*) SCM_UNPACK_POINTER (x);
}

SCM
scm_from_ephemeron_table (struct scm_ephemeron_table *et)
{
  return PTR2SCM (et);
}

struct scm_ephemeron_table*
scm_to_ephemeron_table (SCM et)
{
  if (!SCM_EPHEMERON_TABLE_P (et))
    abort ();
  return scm_as_ephemeron_table (et);
}

struct scm_ephemeron_table
{
  scm_t_bits tag;
  size_t size;
  struct gc_ephemeron *contents[];
};

struct scm_ephemeron_table*
scm_c_make_ephemeron_table (size_t size)
{
  size_t byte_size = sizeof (struct scm_ephemeron_table);
  byte_size += sizeof (struct gc_ephemeron*) * size;
  struct scm_ephemeron_table *table = scm_gc_malloc (byte_size, NULL);
  table->tag = scm_tc7_ephemeron_table;
  table->size = size;
  return table;
}

size_t
scm_c_ephemeron_table_length (struct scm_ephemeron_table *et)
{
  return et->size;
}

struct gc_ephemeron*
scm_c_ephemeron_table_ref (struct scm_ephemeron_table *et, size_t idx)
{
  if (idx >= et->size)
    abort();

  return gc_ephemeron_chain_head (&et->contents[idx]);
}

void
scm_c_ephemeron_table_push_x (struct scm_ephemeron_table *et, size_t idx,
                              struct gc_ephemeron *e)
{
  if (idx >= et->size)
    abort();

  gc_ephemeron_chain_push (&et->contents[idx], e);
}

struct gc_ephemeron*
scm_c_ephemeron_table_try_push_x (struct scm_ephemeron_table *et, size_t idx,
                                  struct gc_ephemeron *e,
                                  struct gc_ephemeron *prev)
{
  if (idx >= et->size)
    abort();

  gc_ephemeron_chain_try_push (&et->contents[idx], e, &prev);

  return prev;
}

static struct gc_ephemeron*
scm_c_ephemeron_table_clear_x (struct scm_ephemeron_table *et, size_t idx)
{
  if (idx >= et->size)
    abort();

  return scm_atomic_swap_pointer ((void**) &et->contents[idx], NULL);
}

struct scm_ephemeron_table*
scm_c_ephemeron_table_copy (struct scm_ephemeron_table *et)
{
  struct scm_ephemeron_table *ret = scm_c_make_ephemeron_table (et->size);

  for (size_t idx = 0; idx < ret->size; idx++)
    for (struct gc_ephemeron *e = scm_c_ephemeron_table_ref (et, idx);
         e;
         e = scm_c_ephemeron_next (e))
      {
        SCM key = scm_c_ephemeron_key (e);
        SCM value = scm_c_ephemeron_value (e);
        struct gc_ephemeron *copy = scm_c_make_ephemeron (key, value);
        scm_c_ephemeron_table_push_x (ret, idx, copy);
      }

  return ret;
}

SCM_DEFINE_STATIC (scm_ephemeron_table_p, "ephemeron-table?", 1, 0, 0,
                   (SCM x),
                   "Return @code{#t} if @var{x} is an ephemeron table, or "
                   "@code{#f} otherwise.")
#define FUNC_NAME s_scm_ephemeron_table_p
{
  return scm_from_bool (SCM_EPHEMERON_TABLE_P (x));
}
#undef FUNC_NAME

SCM_DEFINE_STATIC (scm_make_ephemeron_table, "make-ephemeron-table", 1, 0, 0,
                   (SCM size),
                   "Make an ephemeron table of size @var{size}.")
#define FUNC_NAME s_scm_make_ephemeron_table
{
  return PTR2SCM (scm_c_make_ephemeron_table (scm_to_size_t (size)));
}
#undef FUNC_NAME

SCM_DEFINE_STATIC (scm_ephemeron_table_length, "ephemeron-table-length", 1, 0, 0,
                   (SCM et),
                   "Return the length of the ephemeron table @var{et}.")
#define FUNC_NAME s_scm_ephemeron_table_length
{
  SCM_VALIDATE_EPHEMERON_TABLE (1, et);

  return scm_from_size_t
    (scm_c_ephemeron_table_length (scm_as_ephemeron_table (et)));
}
#undef FUNC_NAME

SCM_DEFINE_STATIC (scm_ephemeron_table_ref, "ephemeron-table-ref", 2, 0, 0,
                   (SCM et, SCM idx),
                   "Return the ephemeron in slot @var{idx} of the ephemeron "
                   "table @var{et}, or @code{#f} if the slot is empty.")
#define FUNC_NAME s_scm_ephemeron_table_ref
{
  SCM_VALIDATE_EPHEMERON_TABLE (1, et);
  SCM_ASSERT_RANGE (2, idx,
                    scm_to_size_t (idx) < scm_as_ephemeron_table (et)->size);
  struct gc_ephemeron *ret =
    scm_c_ephemeron_table_ref (scm_as_ephemeron_table (et),
                               scm_to_size_t (idx));
  return ret ? PTR2SCM (ret) : SCM_BOOL_F;
}
#undef FUNC_NAME

SCM_DEFINE_STATIC (scm_ephemeron_table_push_x, "ephemeron-table-push!", 3, 0, 0,
                   (SCM et, SCM idx, SCM e),
                   "Push the ephemeron @var{e} onto slot @var{idx} of the "
                   "ephemeron table @var{et}.")
#define FUNC_NAME s_scm_ephemeron_table_push_x
{
  SCM_VALIDATE_EPHEMERON_TABLE (1, et);
  SCM_ASSERT_RANGE (2, idx,
                    scm_to_size_t (idx) < scm_as_ephemeron_table (et)->size);
  SCM_VALIDATE_EPHEMERON (3, e);
  scm_c_ephemeron_table_push_x (scm_as_ephemeron_table (et),
                                scm_to_size_t (idx), scm_as_ephemeron (e));
  return SCM_UNSPECIFIED;
}
#undef FUNC_NAME

SCM_DEFINE_STATIC (scm_ephemeron_table_try_push_x, "ephemeron-table-try-push!",
                   4, 0, 0, (SCM et, SCM idx, SCM e, SCM tail),
                   "Push the ephemeron @var{e} onto slot @var{idx} of the "
                   "ephemeron table @var{et}, whose current value is "
                   "@var{tail}.  On success, return @var{tail}.  On failure, "
                   "return the value of slot @var{idx}.")
#define FUNC_NAME s_scm_ephemeron_table_try_push_x
{
  SCM_VALIDATE_EPHEMERON_TABLE (1, et);
  SCM_ASSERT_RANGE (2, idx,
                    scm_to_size_t (idx) < scm_as_ephemeron_table (et)->size);
  SCM_VALIDATE_EPHEMERON (3, e);
  struct gc_ephemeron *expected = NULL;
  if (!scm_is_eq (tail, SCM_BOOL_F))
    {
      SCM_VALIDATE_EPHEMERON (4, tail);
      expected = scm_as_ephemeron (tail);
    }
  struct gc_ephemeron *res =
    scm_c_ephemeron_table_try_push_x (scm_as_ephemeron_table (et),
                                      scm_to_size_t (idx),
                                      scm_as_ephemeron (e),
                                      expected);
  return res ? PTR2SCM (res) : SCM_BOOL_F;
}
#undef FUNC_NAME

SCM_DEFINE_STATIC (scm_ephemeron_table_clear_x, "ephemeron-table-clear!",
                   2, 0, 0, (SCM et, SCM idx),
                   "Clear the slot @var{idx} of the ephemeron table @var{et} "
                   "and return its previous value.")
#define FUNC_NAME s_scm_ephemeron_table_clear_x
{
  SCM_VALIDATE_EPHEMERON_TABLE (1, et);
  SCM_ASSERT_RANGE (2, idx,
                    scm_to_size_t (idx) < scm_as_ephemeron_table (et)->size);

  struct gc_ephemeron *prev =
    scm_c_ephemeron_table_clear_x (scm_as_ephemeron_table (et),
                                   scm_to_size_t (idx));
  return prev ? PTR2SCM (prev) : SCM_BOOL_F;
}
#undef FUNC_NAME

int
scm_i_print_ephemeron_table (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
{
  scm_puts ("#<ephemeron-table ", port);
  scm_uintprint (SCM_UNPACK (exp), 16, port);
  scm_puts (")>", port);
  return 1;
}




SCM
scm_c_ephemeron_hash_table_refq (struct scm_ephemeron_table *et, SCM key,
                                 SCM default_value)
{
  size_t idx = scm_ihashq (key, et->size);

  for (struct gc_ephemeron *e = scm_c_ephemeron_table_ref (et, idx);
       e;
       e = scm_c_ephemeron_next (e))
    if (scm_is_eq (key, scm_c_ephemeron_key (e)))
      return scm_c_ephemeron_value (e);

  return default_value;
}

void
scm_c_ephemeron_hash_table_setq_x (struct scm_ephemeron_table *et, SCM key,
                                   SCM value)
{
  size_t idx = scm_ihashq (key, et->size);

  struct gc_ephemeron *prev = scm_c_ephemeron_table_ref (et, idx);
  struct gc_ephemeron *chain;
  do
    {
      chain = prev;
      for (struct gc_ephemeron *e = chain; e; e = scm_c_ephemeron_next (e))
        if (scm_is_eq (key, scm_c_ephemeron_key (e)))
          {
            scm_c_ephemeron_swap_x (e, value);
            return;
          }
      struct gc_ephemeron *new_head = scm_c_make_ephemeron (key, value);
      prev = scm_c_ephemeron_table_try_push_x (et, idx, new_head, chain);
    } while (prev != chain);
}




static void
scm_init_ephemerons (void)
{
#ifndef SCM_MAGIC_SNARFER
#include "ephemerons.x"
#endif
}

void
scm_register_ephemerons (void)
{
  scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
                            "scm_init_ephemerons",
                            (scm_t_extension_init_func)scm_init_ephemerons,
                            NULL);
}