/* libsizzle/values.c - multiple value handling
 
  Copyright (C) 1999, 2000 Martin Grabmueller <mgrabmue@cs.tu-berlin.de>
 
  This is free software; you can redistribute it and/or modify
  it under the terms of the GNU General Public License as published by
  the Free Software Foundation; either version 2, or (at your option)
  any later version.
  
  This software 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 General Public License for more details.
  
  You should have received a copy of the GNU General Public License
  along with this package; see the file COPYING.  If not, write to
  the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  Boston, MA 02111-1307, USA.  */

#if HAVE_CONFIG_H
# include <config.h>
#endif 

#if ENABLE_NLS
# include <libintl.h>
# define _(String) gettext(String)
#else
# define _(String) (String)
#endif

#include "node.h"
#include "validate.h"
#include "port.h"
#include "capi.h"
#include "values.h"

/* The type tag for multiple value objects. */
zzz_object_t zzz_tagged_type_values;

zzz_scm_t
zzz_make_values (zzz_scm_t values)
{
  return zzz_create_tagged_cell (zzz_tagged_type_values, (void *) values,
				 NULL, NULL);
}

static void
values_print (zzz_scm_t port, zzz_tagged_t tagged, zzz_print_state_t state)
{
  zzz_scm_t result;

  zzz_port_puts (port, "#<values ", 9, &result);
  zzz_port_print (port, (zzz_scm_t) tagged_data0 (tagged), state, &result);
  zzz_port_puts (port, ">", 1, &result);
}

/*:doc
  values
  (values obj ...)
  Create multiple values.  Used to return more than one value from a
  procedure.
  doc:*/
#define FUNC_NAME "values"
static result_t
values_func (zzz_scm_t env, zzz_scm_t param, zzz_scm_t * result)
{
  if (cons_p (param) && !cons_p (cdr (param)))
    *result = car (param);
  else
    *result = zzz_make_values (param);
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  call-with-values
  (call-with-values producer consumer)
  Call @var{producer}, which must be a thunk returning any number of values,
  and apply @var{consumer} to the list of values returned by @var{producer}.
  This is the standard procedure for handling multiple values in Scheme.
  doc:*/
#define FUNC_NAME "call-with-values"
static result_t
call_with_values_func (zzz_scm_t env, zzz_scm_t producer, zzz_scm_t consumer,
		       zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  zzz_scm_t list;
  int err;

  CHECK_TYPE (1, procedure_p (producer), zzz_procedure_type_name);
  CHECK_TYPE (2, procedure_p (consumer), zzz_procedure_type_name);
  if ((err = zzz_apply (env, producer, NULL, result)) != RESULT_SUCCESS)
    return err;
  if (values_p (*result))
    list = values_val (*result);
  else
    list = zzz_cons (*result, NULL);
  return zzz_apply (env, consumer, list, result);
}
#undef FUNC_NAME

result_t
zzz_init_values (void)
{
  zzz_tagged_type_values =
    zzz_define_tagged_type (zzz_simple_constructor, values_print, NULL,
			    zzz_simple_mark, NULL);
  zzz_define_function ("values", values_func, argv_0_0_1);
  zzz_define_function ("call-with-values", (zzz_prim_t) call_with_values_func,
		       argv_2_0_0);
  return RESULT_SUCCESS;
}
