// ---------------------------------------------------------------------------
// - Lambda.cpp                                                              -
// - afnix engine - builtin lambda and gamma function implementation         -
// ---------------------------------------------------------------------------
// - This program is free software;  you can redistribute it  and/or  modify -
// - it provided that this copyright notice is kept intact.                  -
// -                                                                         -
// - 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.  In no event shall -
// - the copyright holder be liable for any  direct, indirect, incidental or -
// - special damages arising in any way out of the use of this software.     -
// ---------------------------------------------------------------------------
// - copyright (c) 1999-2007 amaury darsch                                   -
// ---------------------------------------------------------------------------

#include "Cons.hpp"
#include "Lexical.hpp"
#include "Closure.hpp"
#include "Builtin.hpp"
#include "Nameset.hpp"
#include "Runnable.hpp"
#include "Exception.hpp"

namespace afnix {

  // create a new closure 
  static Object* get_closure (Runnable* robj, Nameset* nset, Cons* args,
    			      const bool type) {
    // get number of arguments
    long len = (args == nilp) ? 0 : args->length ();
    if ((len != 2) && (len != 3))
      throw Exception ("argument-error", 
                       "invalid number of argument with closure");
    // extract the argument list
    Cons*    argl = nilp;
    Object*  car  = args->getcar ();
    Lexical* lex  = dynamic_cast <Lexical*> (car);
    if (lex != nilp) {
      if (lex->isnil () == false) 
	throw Exception ("argument-error", "only nil is a valid lexical");
    } else {
      argl = dynamic_cast <Cons*> (car);
      if (argl == nilp)
        throw Exception ("argument-error", "invalid object as argument list",
                         Object::repr (car));
    }
    // extract the closed variable and the execution form
    Cons*   clvl = nilp;
    Object* form = nilp;
    if (len == 3) {
      clvl = dynamic_cast <Cons*> (args->getcadr ());
      form = args->getcaddr ();
      if (clvl == nilp) 
        throw Exception ("argument-error", 
                         "invalid object as closed variable list");
    } else {
      form = args->getcadr ();
    }
    // create the closure
    Closure* result = new Closure (type, argl, form);
    // bind the closed variables
    try {
      while (clvl != nilp) {
        Object*  car = clvl->getcar ();
        Lexical* lex = dynamic_cast <Lexical*> (car);
        if (lex == nilp)
          throw Exception ("argument-error", 
			   "invalid object as closed variable",
                           Object::repr (car));
        Object* obj = car->eval (robj, nset);
        result->addclv (lex->toquark (), obj);
	clvl = clvl->getcdr ();
      }
    } catch (...) {
      delete result;
      throw;
    }
    robj->post (result);
    return result;
  }

  // create a new lambda expression

  Object* builtin_lambda (Runnable* robj, Nameset* nset, Cons* args) {
    return get_closure (robj, nset, args, true);
  }

  // create a new gamma expression

  Object* builtin_gamma (Runnable* robj, Nameset* nset, Cons* args) {
    return get_closure (robj, nset, args, false);
  }
}