/*
     libscheme	
     Copyright (C) 1994 Brent Benson

     This program 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 1, or (at your option)
     any later version.

     This program 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 program; if not, write to the Free Software
     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*/

#include "scheme.h"

struct Scheme_Promise
{
  int forced;
  Scheme_Object *val;
  Scheme_Env *env;
};
typedef struct Scheme_Promise Scheme_Promise;

/* globals */
Scheme_Object *scheme_promise_type;

/* locals */
static Scheme_Object *force (int argc, Scheme_Object *argv[]);

void
scheme_init_promise (Scheme_Env *env)
{
  scheme_promise_type = scheme_make_type ("<promise>");
  scheme_add_global ("<promise>", scheme_promise_type, env);
  scheme_add_global ("force", scheme_make_prim (force), env);
}

Scheme_Object *
scheme_make_promise (Scheme_Object *expr, Scheme_Env *env)
{
  Scheme_Object *obj;
  Scheme_Promise *promise;

  promise = (Scheme_Promise *) scheme_malloc (sizeof (Scheme_Promise));
  promise->forced = 0;
  promise->val = expr;
  promise->env = env;
  obj = scheme_alloc_object ();
  SCHEME_TYPE (obj) = scheme_promise_type;
  SCHEME_PTR_VAL (obj) = promise;
  return (obj);
}

static Scheme_Object *
force (int argc, Scheme_Object *argv[])
{
  Scheme_Promise *promise;

  SCHEME_ASSERT ((argc == 1), "force: wrong number of args");
  SCHEME_ASSERT (SCHEME_PROMP(argv[0]), "force: arg must be a promise");
  promise = (Scheme_Promise *) SCHEME_PTR_VAL (argv[0]);
  if (promise->forced)
    {
      return (promise->val);
    }
  else
    {
      promise->val = scheme_eval (promise->val, promise->env);
      return (promise->val);
    }
}
