#include <libguile.h>

#define SCM_SMOB(c_name, scheme_name, size) \
  SCM_SNARF_HERE(static scm_t_bits scm_##c_name##_tag) \
  SCM_SNARF_INIT(scm_##c_name##_tag=scm_make_smob_type((scheme_name), size);)
#define SCM_SMOB_MARK(c_name, arg) \
  SCM_SNARF_HERE(static SCM scm_##c_name##_mark(SCM arg)) \
  SCM_SNARF_INIT(scm_set_smob_mark(scm_##c_name##_tag, scm_##c_name##_mark);)
#define SCM_SMOB_APPLY(c_name, args, req, opt, rest) \
  SCM_SNARF_HERE(static SCM scm_##c_name##_apply args) \
  SCM_SNARF_INIT(scm_set_smob_apply(scm_##c_name##_tag, scm_##c_name##_apply, \
                                    req, opt, rest);)

/* define one static smob, to be used as a generator */

SCM_SMOB(dynsmob_static, "dynsmob", 0);

SCM_SMOB_MARK(dynsmob_static, s_smob)
{
  scm_gc_mark(SCM_CELL_OBJECT_2(s_smob));
  return SCM_CELL_OBJECT_3(s_smob);
}

SCM_SMOB_APPLY(dynsmob_static, (SCM s_smob, SCM s_data), 1, 0, 0)
{
  SCM_RETURN_NEWSMOB2(SCM_CELL_WORD_1(s_smob), s_smob, SCM_UNPACK(s_data));
}

/* these are for Scheme-defined smobs */

static SCM mark_dynsmob(SCM s_smob) {
  SCM const s_type=SCM_CELL_OBJECT_1(s_smob);
  SCM const s_data=SCM_CELL_OBJECT_2(s_smob);
  scm_gc_mark(s_type);
  return s_data;
}

static int print_dynsmob(SCM s_smob, SCM s_port, scm_print_state* pstate) {
  SCM const s_type   =SCM_CELL_OBJECT_1(s_smob);
  SCM const s_printer=SCM_CELL_OBJECT_2(s_type);
  SCM const s_data   =SCM_CELL_OBJECT_2(s_smob);
  (void)pstate; /* silence "unused parameter" warning */
  scm_call_3(s_printer, s_data, s_port, SCM_UNSPECIFIED/*pstate*/);
  return 1;
}

static SCM equalp_dynsmob(SCM s_smob1, SCM s_smob2) {
  SCM const s_type  =SCM_CELL_OBJECT_1(s_smob1);
  SCM const s_equalp=SCM_CELL_OBJECT_3(s_type);
  SCM const s_data1 =SCM_CELL_OBJECT_2(s_smob1);
  SCM const s_data2 =SCM_CELL_OBJECT_2(s_smob2);
  return scm_call_2(s_equalp, s_data1, s_data2);
}

static SCM apply_dynsmob(SCM s_smob, SCM s_newdata) {
  if (SCM_UNBNDP(s_newdata)) {
    SCM const s_data=SCM_CELL_OBJECT_2(s_smob);
    return s_data;
  }
  SCM_SET_CELL_OBJECT_2(s_smob, s_newdata);
  return SCM_UNSPECIFIED;
}

#define FUNC_NAME s_scm_dynsmob_make_smob_type
SCM_DEFINE(scm_dynsmob_make_smob_type, "make-smob-type", 3, 0, 0,
           (SCM s_name, SCM s_printer, SCM s_equalp),
           "Define a new smob type and return a generator for it.")
{
  scm_t_bits tag;
  SCM_VALIDATE_STRING(SCM_ARG1, s_name);
  if (!SCM_FALSEP(s_printer)) SCM_VALIDATE_PROC(SCM_ARG2, s_printer);
  if (!SCM_FALSEP(s_equalp )) SCM_VALIDATE_PROC(SCM_ARG3, s_equalp);
  SCM_STRING_COERCE_0TERMINATION_X(s_name);
  tag=scm_make_smob_type(SCM_STRING_CHARS(s_name), 0);
  scm_set_smob_mark(tag, mark_dynsmob);
  if (!SCM_FALSEP(s_printer)) scm_set_smob_print (tag, print_dynsmob);
  if (!SCM_FALSEP(s_equalp )) scm_set_smob_equalp(tag, equalp_dynsmob);
  scm_set_smob_apply(tag, apply_dynsmob, 0, 1, 0);
  SCM_RETURN_NEWSMOB3(scm_dynsmob_static_tag, tag, SCM_UNPACK(s_printer),
                      SCM_UNPACK(s_equalp));
}
#undef FUNC_NAME

void dynsmob__load__init(void) {
#ifndef SCM_MAGIC_SNARFER
#include "dynsmob.x"
#endif
}