/*
     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"

/* locals */
static Scheme_Object *scheme_eval_combination (Scheme_Object *comb, Scheme_Env *env);
static Scheme_Object *eval (int argc, Scheme_Object *argv[]);

void
scheme_init_eval (Scheme_Env *env)
{
  scheme_add_global ("eval", scheme_make_prim (eval), env);
}

Scheme_Object *
scheme_eval (Scheme_Object *obj, Scheme_Env *env)
{
  Scheme_Object *type;

  scheme_env = env;
  type = SCHEME_TYPE (obj);
  if (type == scheme_symbol_type)
    {
      Scheme_Object *val;

      val = scheme_lookup_value (obj, env);
      if (! val)
	{
	  scheme_signal_error ("reference to unbound symbol: %s", SCHEME_STR_VAL(obj));
	}
      return (val);
    }
  else if (type == scheme_pair_type)
    {
      return (scheme_eval_combination (obj, env));
    }
  else if (type == scheme_c_char_type)
    {
      return scheme_make_c_char(SCHEME_C_CHAR_VAL(obj));
    }
  else if (type == scheme_c_integer_type)
    {
      return scheme_make_c_integer(SCHEME_C_INT_VAL(obj));
    }
  else if (type == scheme_c_double_type)
    {
      return scheme_make_c_double(SCHEME_C_DOUBLE_VAL(obj));
    }
  else
    {
      return (obj);
    }
}

/* local functions */

static Scheme_Object *
scheme_eval_combination (Scheme_Object *comb, Scheme_Env *env)
{
  Scheme_Object *rator, *type, *rands, *evaled_rands, *last;
  Scheme_Object *rand, *fun, *form;

  rator = scheme_eval (SCHEME_CAR (comb), env);
  type = SCHEME_TYPE (rator);
  if (type == scheme_syntax_type)
    {
      return (SCHEME_SYNTAX(rator)(comb, env));
    }
  else if (type == scheme_macro_type)
    {
      fun = (Scheme_Object *) SCHEME_PTR_VAL (rator);
      rands = SCHEME_CDR (comb);
      form = scheme_apply (fun, rands);
      return (scheme_eval (form, env));
    }
  else
    {
      rands = SCHEME_CDR (comb);
      evaled_rands = last = scheme_null;
      while (rands != scheme_null)
	{
	  rand = scheme_make_pair (scheme_eval (SCHEME_CAR (rands), env), scheme_null);
	  if (evaled_rands == scheme_null)
	    {
	      evaled_rands = last = rand;
	    }
	  else
	    {
	      SCHEME_CDR (last) = rand;
	      last = rand;
	    }
	  rands = SCHEME_CDR (rands);
	}
      return (scheme_apply (rator, evaled_rands));
    }
}

static Scheme_Object *
eval (int argc, Scheme_Object *argv[])
{
  SCHEME_ASSERT ((argc == 1), "eval: wrong number of args");
  return (scheme_eval (argv[0], scheme_env));
}
