// ---------------------------------------------------------------------------
// - Apply.cpp                                                               -
// - afnix engine - builtin apply functions 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-2023 amaury darsch                                   -
// ---------------------------------------------------------------------------

#include "Cons.hpp"
#include "Lexical.hpp"
#include "Builtin.hpp"
#include "Evaluable.hpp"
#include "Exception.hpp"

namespace afnix {

  // apply an object directly

  Object* Builtin::sfapply (Evaluable* zobj, Nameset* nset, Cons* args) {
    // check for nil
    long alen = (args == nullptr) ? 0L : args->length ();
    if ((alen == 0L) || (alen > 3)) {
      throw Exception ("argument-error", 
		       "missing or too many argument with apply");
    }
    // collect/eval car
    Object* car = args->getcar ();
    Object* obj = (car == nullptr) ? nullptr : car->eval (zobj, nset);
    if (obj == nullptr) return nullptr;
    try {
      // project the object
      Object::iref (obj);
      // collect the cadr
      Object* cadr = args->getcadr ();
      if (cadr == nullptr) {
	Object* result = obj->apply (zobj, nset, nullptr);
	zobj->post (result);
	Object::dref (obj);
	return result;
      }
      // collect the arguments
      auto caddr = dynamic_cast<Cons*>(args->getcaddr());
      // check for a cons cell
      auto carg = dynamic_cast<Cons*>(cadr);
      if (carg != nullptr) {
	if (alen == 2L) {
	  Object* result = obj->apply (zobj, nset, carg);
	  zobj->post (result);
	  Object::dref (obj);
	  return result;
	}
      }
      // check for a lexical
      auto clex = dynamic_cast<Lexical*>(cadr);
      if (clex != nullptr) {
	Object* result = obj->apply (zobj, nset, clex->toquark(), caddr);
	zobj->post (result);
	Object::dref (obj);
	return result;
      }
      Object* result = obj->apply (zobj, nset, cadr, caddr);
      zobj->post (result);
      Object::dref (obj);
      return result;
    } catch (...) {
      Object::dref (obj);
      throw;
    }
  }
}
