// LISP Interpreter Evaluation Functions
//
// File:	eval.cc
// Author:      {your name} <{your e-mail address}>
// Assignment:	8

// This file contains the major procedures to evaluate
// LISP S-expressions.  Included are eval_sexpr, the
// main evaluator, apply, which applies functions to
// argument lists, bind_args for binding arguments,
// eval_args for evaluating arguments, check_funarg
// for checking function arguments to FUNCALL, APPLY,
// etc., and binding_pointer for finding the location
// of a symbol's binding.

#include "lisp.h"

static object * eval_args (object * arglist);
static void bind_args
	( object * args, object * formalargs );

// Note on Rewrite Rules:
//
// In rewrite rules meta-variables that stand for
// s-expressions denote C++ expressions that evaluate
// directly to the s-expressions.  Thus
//
//   N is a fixnum   means N is	make_fixnum (n)
//			        for some integer n from
//			        -2**31 through 2**31-1.
//
//   S is a symbol   means S is	make_symbol ("<text>")
//			        for any C++ string
//			        constant "<text>".
//
//   (S . X)	     means (S . X) is make_cons (S, X)
//
// Note that make_function (...) returns an atom.

// eval_sexpr -- the main evaluator. This routine has a
//    pointer to an s-expression passed to it and
//    returns a pointer to the evaluated s-expression.
//    The rewrite rules are as follows:
//
//    S is a symbol; A is an atom; ARGS, F, X are
//    s-expressions;
//
//    Rules are applied in order.
//
//	(eval_sexpr S)
//	    ===> ???
//		    if ! unboundp (* binding_pointer(S))
//	    ===> ???
//		    if unboundp (* binding_pointer (S))
//      (eval_sexpr A)
//	    ===> ???	if A is an atom
//      (eval_sexpr (S . ARGS))
//	    ===> ???
//		    if unboundp (symbol_function(S))
//	    ===> ???
//		    if symbol_function(S) ===> P
//		       and P is a special primitive
//		       function
//	    ===> ???
//		    if symbol_function(S) ===>
//					    (MACRO . X)
//	    ===> ???
//
//		    if symbol_function(S) ===> F
//      (eval_sexpr ((LAMBDA . X) . ARGS))
//	    ===> ???
//
//      (eval_sexpr (X . ARGS))
//	    ===> ???
//

	object *
eval_sexpr (object * sexpr)
{
    return sexpr;  // TBW
}

//  check_funarg -- takes a function argument given to
//    prim_funcall, prim_apply, or the like and makes
//    it ready to pass to apply; insists on being given
//    a LAMBDA list, primitive non-special function,
//    LAMBDA_CLOSURE, or a symbol with one of these as
//    its global function binding; and calls error in
//    other cases.
//
//    Returns the function binding of a symbol, or the
//    argument itself if that is not a symbol.
//
//    Note: check_funarg does NO memory allocation.
//
//  Rewrite Rules (apply in order):
//
//    S is a symbol, P a non-special primitive function,
//    X is an s-expression
//
//    check_funarg (S)
//        ===> check_funarg (symbol_function (S))
//		   if ! unboundp (symbol_function (S))
//	  ===> error ("EVAL, FUNCALL, APPLY:"
//			" Undefined function name: ", S)
//		   if unboundp (symbol_function (S))
//    check_funarg ((LAMBDA . X)) ===> (LAMBDA . X)
//    check_funarg ((LAMBDA-CLOSURE . X))
//	  ===> (LAMBDA-CLOSURE . X)
//    check_funarg (P) ===> P
//	  if P is a non-special primitive function
//    check_funarg (X)
//	  ===> error ("EVAL, FUNCALL, APPLY:"
//			" function argument must"
//		        " be a normal function: ", X)

	object *
check_funarg (object * func)
{
    symbol * sfunc = may_be_symbol (func);

    object * fbinding;
    if ( sfunc )
    {
	fbinding = symbol_function (sfunc);
	if ( unboundp (fbinding) )
	    error ( "EVAL, FUNCALL, APPLY:"
		    " Undefined function name: ",
		    func );
    }
    else fbinding = func;

    object_type * fbtype = type_of (fbinding);

    if (
	 (
	   fbtype == CONS_TYPE
	   &&
	   (
	     unchecked_car (fbinding) == LAMBDA
	     ||
	     unchecked_car (fbinding) == LAMBDA_CLOSURE
	   )
	 )
	 ||
	 ( 
	   fbtype == FUNCTION_TYPE
	   &&
	   ! unchecked_specialp (fbinding)
	 )
	    
       )
	return fbinding;
    else
	error ( "EVAL, APPLY, FUNCALL:"
		" function argument must"
	        " be normal function: ", func );
}

//  apply -- the functional applicator.  Takes a
//    function and an argument list (evaluated or not,
//    whichever is proper), and applies the function to
//    the arguments.
//
//    First sets the environment to NIL for all but
//    LAMBDA-CLOSUREs, for which the environment is
//    set as given.
//
//    The function should not be a primitive special
//    function (but may be a non-special primitive).
//    The function should be checked by check_funarg
//    before calling apply, except for cases when
//    eval_sexpr calls apply.
//
//    This routine preserves both its arguments from
//    garbage collection.
//

//  Pseudo-Code for apply:
//
//       TBW

	object *
apply (object * func, object * args)
{
    error ( "apply called" );  // TBW
}

//  bind_args -- takes a list of actual arguments and
//    a list of formal arguments and binds the formal
//    arguments to the actual arguments in the current
//    environment.
//
//  RR (apply in order):
//
//    X, Y, Z are s-expressions, S is a symbol,
//    A is an atom, &REST is the symbol &REST.
//
//    bind_args (X, (&REST S))
//	  ===> environment = make_cons
//		     (make_cons (S, X), environment);
//    bind_args (X, (&REST . Y))
//	  ===> error ( "APPLY: bad &REST parameters: ",
//		       (&REST . Y) );
//    bind_args ((X . Y), (S . Z))
//	  ===> environment = make_cons
//		     (make_cons (S, X), environment);
//	       bind_args (Y, Z)
//    bind_args (NIL, NIL) ===> ;
//    bind_args ((X . Y), NIL) ===>
//	  ===> error ( "APPLY: actual argument list is"
//		       " too long: ", (X . Y))
//    bind_args (NIL, X) ===>
//	  ===> error ( "APPLY: actual argument list is"
//		       " too short")
//    bind_args (A, X) ===>
//	  ===> error ( "APPLY: actual argument list is"
//		       " dotted: ", A)
//    bind_args (X, Y) ===>
//	  ===> error ( "APPLY: bad formal parameters: ",
//		       Y );
//

	static void
bind_args ( object * args, object * formalargs )
{
    // TBW
}

//  eval_args -- takes a list of arguments and returns
//    a list containing the values resulting from
//    evaluating each of the elements in the original
//    list.
//
//  RR (apply in order):
//
//    TBW
//
//
//
//
	static object *
eval_args (object * arglist)
{
    // TBW

    return arglist;
}

//  binding_pointer -- returns a pointer to the symbol's
//    current binding (location where the symbol's value
//    is stored) in the environment, if any.  Otherwise
//    returns a pointer to the symbol's symbol_value
//    component, the symbol's global binding.
//
	object **
binding_pointer (object * sym)
{
    // TBW

    symbol * ssym = must_be_symbol (sym);

    return symbol_value_pointer (ssym);
}