#include "guile.h"

static sizet
free_var (obj)
     SCM obj;
{
  return 0;
}

static int
prin_var (exp, port, writing)
     SCM exp;
     SCM port;
     int writing;
{
  scm_lputs("#<variable ", port);
  scm_intprint(exp, 16, port);
  {
    SCM val_cell;
    val_cell = CDR(exp);
    if (CAR (val_cell) != SCM_UNDEFINED)
      {
	scm_lputs(" name: ", port);
	scm_iprin1 (CAR (val_cell), port, writing);
      }
    scm_lputs(" binding: ", port);
    scm_iprin1 (CDR (val_cell), port, writing);
  }
  scm_lputc('>', port);
  return 1;
}


int scm_tc16_variable;
static scm_smobfuns variable_smob = {scm_markcdr, free_var, prin_var, 0};

static char s_make_variable[] = "make-variable";

static SCM variable_sym;

static SCM
make_vcell_variable (vcell)
{
  SCM answer;
  NEWCELL(answer);
  DEFER_INTS;
  CAR(answer) = scm_tc16_variable;
  CDR(answer) = vcell;
  ALLOW_INTS;
  return answer;
}

SCM
scm_make_variable (init, name_hint)
     SCM init;
     SCM name_hint;
{
  SCM val_cell;
  NEWCELL(val_cell);
  DEFER_INTS;
  CAR(val_cell) = name_hint;
  CDR(val_cell) = init;
  ALLOW_INTS;
  return make_vcell_variable (val_cell);
}

static char s_make_udvariable[] = "make-undefined-variable";
SCM
scm_make_udvariable (name_hint)
     SCM name_hint;
{
  SCM vcell;

  if (name_hint == SCM_UNDEFINED)
    name_hint = variable_sym;

  NEWCELL (vcell);
  DEFER_INTS;
  CAR (vcell) = name_hint;
  CDR (vcell) = SCM_UNDEFINED;
  ALLOW_INTS;
  return make_vcell_variable (vcell);
}

static char s_variablep[] = "variable?";
SCM
scm_variablep (obj)
     SCM obj;
{
  return ( (NIMP(obj) && VARIABLEP (obj))
	  ? BOOL_T
	  : BOOL_F);
}

static char s_variable_ref[] = "variable-ref";

SCM
scm_variable_ref (var)
     SCM var;
{
  ASSERT (VARIABLEP(var), var, ARG1, s_variable_ref);
  return CDR (CDR (var));
}



static char s_variable_set[] = "variable-set!";

SCM
scm_variable_set (var, val)
     SCM var;
     SCM val;
{
  ASSERT (NIMP(var) && VARIABLEP (var), var, ARG1, s_variable_set);
  CDR (CDR (var)) = val;
  return UNSPECIFIED;
}

static char s_builtin_var[] = "builtin-variable";

SCM
scm_builtin_var (name)
     SCM name;
{
  SCM vcell;
  SCM var_slot;
  SCM var;

  ASSERT (SYMBOLP (name), name, ARG1, s_builtin_var);
  vcell = scm_sym2vcell (name, BOOL_F, BOOL_F);
  if (vcell == BOOL_F)
    return BOOL_F;

  scm_intern_symbol (symhash_vars, name);
  var_slot = scm_sym2ovcell (name, symhash_vars);

  if (   IMP (CDR (var_slot))
      || (VARVCELL (var_slot) != vcell))
    CDR (var_slot) = make_vcell_variable (vcell);

  return CDR (var_slot);
}


static char s_var_boundp[] = "variable-bound?";

SCM 
scm_var_boundp (var)
     SCM var;
{
  ASSERT (VARIABLEP (var), var, ARG1, s_var_boundp);
  return (UNBNDP (CDR (VARVCELL (var)))
	  ? BOOL_F
	  : BOOL_T);
}

void
scm_init_variable ()
{
  scm_tc16_variable = scm_newsmob (&variable_smob);
  variable_sym = CAR (scm_sysintern ("anonymous-variable", SCM_UNDEFINED));
  scm_make_subr (s_variablep, tc7_subr_1, scm_variablep);
  scm_make_subr (s_var_boundp, tc7_subr_1, scm_var_boundp);
  scm_make_subr (s_builtin_var, tc7_subr_1, scm_builtin_var);
  scm_make_subr (s_make_variable, tc7_subr_2o, scm_make_variable);
  scm_make_subr (s_make_udvariable, tc7_subr_1o, scm_make_udvariable);
  scm_make_subr (s_variable_ref, tc7_subr_1, scm_variable_ref);
  scm_make_subr (s_variable_set, tc7_subr_2, scm_variable_set);
}
