/* libsizzle/promise.c - promise handling -- force/delay
 
  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 

#include <assert.h>

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

#include "alloc.h"
#include "node.h"
#include "validate.h"
#include "port.h"
#include "capi.h"
#include "promise.h"

zzz_object_t zzz_tagged_type_promise;

zzz_scm_t
zzz_make_promise (zzz_scm_t env, zzz_scm_t expression)
{
  return zzz_create_tagged_cell (zzz_tagged_type_promise, env, expression,
				 NULL);
}

static void *
promise_constructor (zzz_tagged_t tagged, void * data0,
		     void * data1, void * data2)
{
  zzz_scm_t env = (zzz_scm_t) data0;
  zzz_scm_t expr = (zzz_scm_t) data1;
  promise_desc_t desc;

  desc = zzz_malloc (sizeof (struct promise_descriptor));
  desc->environment = env;
  desc->thawed = 0;
  desc->result = NULL;
  desc->expression = expr;
  tagged->fill[1] = (zzz_object_t) desc;
  return tagged;
}

static void
promise_print (zzz_scm_t port, zzz_tagged_t tagged, zzz_print_state_t state)
{
  zzz_scm_t result;
  promise_desc_t desc = tagged_data0 (tagged);

  zzz_port_puts (port, "#<promise:", 10, &result);
  zzz_port_print (port, desc->expression, state, &result);
  if (desc->thawed)
    zzz_port_puts (port, ":(forced)", 9, &result);
  zzz_port_puts (port, ">", 1, &result);
}

static void
promise_mark (zzz_tagged_t tagged)
{
  promise_desc_t desc = tagged_data0 (tagged);

  zzz_mark_cell (desc->environment);
  zzz_mark_cell (desc->result);
  zzz_mark_cell (desc->expression);
}

static void
promise_free (zzz_tagged_t tagged)
{
  zzz_free (tagged_data0 (tagged), sizeof (struct promise_descriptor));
}

/*:doc
  delay
  (delay expression) => promise
  Delays the evaluation of expression. Returns a promise, which when later
  forced by a call to @code{force} will evaluate @var{expression} and
  return the result. Evaluation is performed in the same environment in
  which the promise was created.
  doc:*/
#define FUNC_NAME "delay"
static result_t
delay_form (zzz_scm_t env, zzz_scm_t param, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  zzz_scm_t param_list = param;
  zzz_scm_t expression;

  param = cdr (param);		/* Skip form name. */
  NEXT_ARG (expression);
  LAST_ARG ();
  set_car (param_list, (zzz_scm_t) imm_delay);
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  force
  (force promise) => value(s)
  Force the evaluation of @var{promise}, which must be created with a
  prior call to @code{delay}.  The value of the promise is cached so that
  a second force will return the cached value without evaluating it again.
  doc:*/
#define FUNC_NAME "force"
static result_t
force_func (zzz_scm_t env, zzz_scm_t promise, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  zzz_scm_t answer;
  int err;

  CHECK_TYPE (1, promise_p (promise), zzz_promise_type_name);
  if (!promise_thawed(promise))
    {
      if ((err = zzz_evaluate (promise_env (promise),
			   promise_expr (promise),
			   &answer)) != RESULT_SUCCESS)
	{
	  *result = answer;
	  return err;
	}
      if (!promise_thawed (promise))
	{
	  promise_result (promise) = answer;
	  promise_thawed (promise) = 1;
	}
    }
  *result = promise_result (promise);
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

result_t
zzz_init_promise (void)
{
  zzz_tagged_type_promise = zzz_define_tagged_type (promise_constructor,
						    promise_print,
						    promise_free,
						    promise_mark, NULL);
  zzz_define_form ("delay", delay_form, 1);
  zzz_define_function ("force", force_func, argv_1_0_0);
  return RESULT_SUCCESS;
}
