#include <stdio.h>

#include <libguile.h>

static SCM my_constructor(SCM obj, SCM initargs)
{
  printf("constructor called!\n");
  scm_slot_set_x(obj, scm_str2symbol("a-slot"), SCM_BOOL_T);

  return obj;
}

static void set_constructor(SCM klass, SCM (*proc)(SCM, SCM))
{
  SCM initialize = scm_variable_ref(
          scm_c_module_lookup(scm_module_goops, "initialize"));
  SCM sym_obj = scm_str2symbol("obj");
  SCM sym_args = scm_str2symbol("args");
  SCM constr = scm_c_make_gsubr("constructor", 1, 0, 1, proc);
  SCM constrm = scm_closure(scm_list_2(scm_list_2(sym_obj, sym_args),
                                       scm_list_3(constr, sym_obj, sym_args)),
                            SCM_EOL);
  SCM meth = scm_make(scm_list_5(scm_class_method,
                                scm_c_make_keyword("specializers"),
                                scm_list_2(klass, scm_class_top),
                                scm_c_make_keyword("procedure"),
                                constrm));

  scm_add_method(initialize, meth);
}

static void real_main(void *closure, int argc, char *argv[])
{
  SCM klass, slots;

  scm_load_goops();
  
  slots = scm_list_1(scm_list_3(scm_str2symbol("a-slot"),
                                scm_c_make_keyword("init-value"),
                                SCM_BOOL_F));
  klass = scm_basic_make_class(scm_class_class, scm_makfrom0str("<my-object>"),
                               scm_list_1(scm_class_object),
                               slots);
  set_constructor(klass, my_constructor);

  scm_c_define("<my-object>", klass);

  scm_c_eval_string("(use-modules (oop goops))");
  scm_c_eval_string("(define-class <new-object> (<my-object>))");
  scm_c_eval_string("(make <new-object>)");

  // this produces the error
  scm_c_eval_string("(define-method (initialize (obj <new-object>) initargs)"
                    "  (next-method))");
}

int main(int argc, char *argv[])
{
  scm_boot_guile(argc, argv, real_main, NULL);

  return 0;
}