// ---------------------------------------------------------------------------
// - For.cpp                                                                 -
// - afnix engine - for builtin 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 "Symbol.hpp"
#include "Builtin.hpp"
#include "Lexical.hpp"
#include "Iterator.hpp"
#include "Localset.hpp"
#include "Exception.hpp"

namespace afnix {

  // this function check that the object is a lexical name
  static inline Lexical* get_lex (Object* object) {
    Lexical* lex = dynamic_cast <Lexical*> (object);
    if (lex == nilp) 
      throw Exception ("type-error", "invalid object in for symbol list",
		       Object::repr (object));
    return lex;
  }

  // this function check that a form is made only with lexical name and bind
  // the symbol in the specified nameset. The function returns list of 
  /// symbols which are later set during the iteration

  static Cons* get_itsym (Cons* itlist, Nameset* nset) {
    Cons* result = nilp;
    while (itlist != nilp) {
      // get lexical and create a symbol
      Lexical* lex = get_lex (itlist->getcar ());
      long quark   = lex->toquark ();
      Symbol* sym = new Symbol (quark);
      // bind the symbol and add it in the result list
      nset->bind (quark, sym);
      if (result == nilp)
	result = new Cons (sym);
      else
	result->append (sym);
      // next in list
      itlist = itlist->getcdr ();
    }
    return result;
  }

  // this function check that the object is an iterable object and return the
  // associated iterator
  static inline Iterator* get_ito (Object* object) {
    if (object == nilp) return nilp;
    Iterable* ito = dynamic_cast <Iterable*> (object);
    if (ito == nilp) 
      throw Exception ("type-error", "non iterable object found with for list",
		       Object::repr (object));
    return ito->makeit ();
  }

  // this function evaluates the list of iterable object and returns a list
  // of iterators
  static Cons* get_itobj (Runnable* robj, Cons* itlist, Nameset* lset) {
    Cons* result = nilp;
    while (itlist != nilp) {
      // get the iterable object
      Object*   obj = itlist->getcar ();
      Object*   eio = (obj == nilp) ? nilp : obj->eval (robj, lset);
      Iterator* ito = get_ito (eio);
      if (result == nilp)
	result = new Cons (ito);
      else
	result->append (ito);
      // next object
      itlist = itlist->getcdr ();
    }
    return result;
  }

  // this function return true if one of the iterator is at the end
  static bool get_itend (Cons* itlist) {
    while (itlist != nilp) {
      Iterator* ito = dynamic_cast <Iterator*> (itlist->getcar ());
      if (ito == nilp) return true;
      if (ito->isend () == true) return true;
      itlist = itlist->getcdr ();
    }
    return false;
  }

  // this procedure binds the symbols with the current iterator values
  static void get_itvalue (Cons* itsym, Cons* itobj) {
    while (itsym != nilp) {
      // set the symbol and iterator
      Symbol*   sym = dynamic_cast <Symbol*>   (itsym->getcar ());
      Iterator* ito = dynamic_cast <Iterator*> (itobj->getcar ());
      sym->setobj (ito == nilp ? nilp : ito->getobj ());
      // go to next position
      itsym = itsym->getcdr ();
      itobj = itobj->getcdr ();
    }
  }

  // this procedure moves the iterators to their next position
  static void get_itnext (Cons* itobj) {
    while (itobj != nilp) {
      Iterator* ito = dynamic_cast <Iterator*> (itobj->getcar ());
      if (ito != nilp) ito->next ();
      itobj = itobj->getcdr ();
    }
  }

  // this function implements the behavior of the for builtin function

  Object* builtin_for (Runnable* robj, Nameset* nset, Cons* args) {
    // check that we have at least 3 arguments
    if ((args == nilp) || (args->length () != 3))
      throw Exception ("argument-error", "invalid argument with for");

    // get the lexical name list
    Cons* lexlst = dynamic_cast <Cons*> (args->getcar ());
    if (lexlst == nilp) 
      throw Exception ("type-error", "lexical list expected with for");
    // get the iterable object list
    Cons* objlst = dynamic_cast <Cons*> (args->getcadr ());
    if (objlst == nilp) 
      throw Exception ("type-error", "lexical list expected with for");
    // check that both list have the same size
    if (lexlst->length () != objlst->length ())
      throw Exception ("argument-error", "for argument list size mismatch");
    // get the form to execute
    Object* form = args->getcaddr ();

    // evaluate the iterable object and reset the iterators
    Cons* itobj = get_itobj (robj, objlst, nset);
    // create a new local set for the symbol binding
    Localset* lset = new Localset;
    Object::iref (lset);
    lset->setparent (nset);

    // evaluate the symbol list binding
    Cons* itsym = nilp;
    try {
      itsym = get_itsym (lexlst, lset);
    } catch (...) {
      delete itobj;
      Object::dref (lset);
      throw;
    }

    // now we are ready to iterate
    Object* result = nilp;
    try {
      while (get_itend (itobj) == false) {
	get_itvalue (itsym, itobj);
	get_itnext  (itobj);
	Object::cref (result);
	result = form->eval (robj,lset);
      }
    } catch (...) {
      delete itsym;
      delete itobj;
      Object::dref (lset);
      throw;
    }

    // we are done - clean everything and return
    delete itsym;
    delete itobj;
    Object::dref (lset);
    return result;
  }
}