// ---------------------------------------------------------------------------
// - Operator.cpp                                                            -
// - afnix engine - operator builtin 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-2007 amaury darsch                                   -
// ---------------------------------------------------------------------------

#include "Cons.hpp"
#include "Real.hpp"
#include "Builtin.hpp"
#include "Boolean.hpp"
#include "Runnable.hpp"
#include "QuarkZone.hpp"
#include "Exception.hpp"

namespace afnix {

  // this procedure extract and evaluate the calling object for an operator
  static inline Object* getobj (Runnable* robj, Nameset* nset, Cons* args, 
				const char* opname) {
    Object* car = nilp;
    Object* obj = nilp;
    if ((args == nilp) || (args->length () != 2)) {
      throw Exception ("argument-error",
		       "missing or too many arguments with operator", opname);
    }
    car = args->getcar ();
    obj = (car == nilp) ? nilp : car->eval (robj,nset);
    if (obj == nilp) {
      throw Exception ("type-error", "invalid nil object with operator",
		       opname);
    }
    return Object::iref (obj);
  }

  // this procedure evaluates the cadr and return it
  static inline Object* getarg (Runnable* robj, Nameset* nset, Cons* args) {
    Object* car = (args == nilp) ? nilp : args->getcadr ();
    Object* obj = (car == nilp) ? nilp : car->eval (robj, nset);
    return Object::iref (obj);
  }

  // operator + 

  Object* builtin_add (Runnable* robj, Nameset* nset, Cons* args) {
    // get the objects
    Object* obj = getobj (robj, nset, args, "+");
    Object* arg = nilp;
    try {
      arg = getarg (robj, nset, args);
    } catch (...) {
      Object::dref (obj);
      throw;
    }
    // perform operation
    try {
      Object* result = obj->oper (Object::ADD, arg);
      robj->post (result);
      Object::dref (obj);
      Object::dref (arg);
      return result;
    } catch (...) {
      Object::dref (obj);
      Object::dref (arg);
      throw;
    }
  }

  // operator -

  Object* builtin_sub (Runnable* robj, Nameset* nset, Cons* args) {
    // check arguments
    long argc = 0;
    if ((args == nilp) || (((argc = args->length ()) != 1) && (argc != 2))) {
      throw Exception ("argument-error",
		       "missing or too many arguments with operator -");
    }
    // evaluate first argument
    Object* car = args->getcar ();
    Object* obj = (car == nilp) ? nilp : car->eval (robj, nset);
    if (obj == nilp) {
      throw Exception ("type-error", "invalid nil object with operator -");
    }
    Object::iref (obj);
    // process unary operator
    if (argc == 1) {
      try {
	Object* result = obj->oper (Object::UMN, (Object*) nilp);
	Object::dref (obj);
	robj->post (result);
	return result;
      } catch (...) {
	Object::dref (obj);
	throw;
      }
    }
    // process normal operator
    Object* arg = nilp;
    try {
      arg = getarg (robj, nset, args);
    } catch (...) {
      Object::dref (obj);
      throw;
    }
    try {
      Object* result = obj->oper (Object::SUB, arg);
      robj->post (result);
      Object::dref (obj);
      Object::dref (arg);
      return result;
    } catch (...) {
      Object::dref (obj);
      Object::dref (arg);
      throw;
    }
  }

  // operator * 

  Object* builtin_mul (Runnable* robj, Nameset* nset, Cons* args) {
    // get the objects
    Object* obj = getobj (robj, nset, args, "*");
    Object* arg = nilp;
    try {
      arg = getarg (robj, nset, args);
    } catch (...) {
      Object::dref (obj);
      throw;
    }
    // perform operation
    try {
      Object* result = obj->oper (Object::MUL, arg);
      robj->post (result);
      Object::dref (obj);
      Object::dref (arg);
      return result;
    } catch (...) {
      Object::dref (obj);
      Object::dref (arg);
      throw;
    }
  }

  // operator /

  Object* builtin_div (Runnable* robj, Nameset* nset, Cons* args) {
    // get the objects
    Object* obj = getobj (robj, nset, args, "/");
    Object* arg = nilp;
    try {
      arg = getarg (robj, nset, args);
    } catch (...) {
      Object::dref (obj);
      throw;
    }
    // perform operation
    try {
      Object* result = obj->oper (Object::DIV, arg);
      robj->post (result);
      Object::dref (obj);
      Object::dref (arg);
      return result;
    } catch (...) {
      Object::dref (obj);
      Object::dref (arg);
      throw;
    }
  }

  // operator ==

  Object* builtin_eql (Runnable* robj, Nameset* nset, Cons* args) {
    // get the objects
    Object* obj = getobj (robj, nset, args, "==");
    Object* arg = nilp;
    try {
      arg = getarg (robj, nset, args);
    } catch (...) {
      Object::dref (obj);
      throw;
    }
    // perform operation
    try {
      Object* result = obj->oper (Object::EQL, arg);
      robj->post (result);
      Object::dref (obj);
      Object::dref (arg);
      return result;
    } catch (...) {
      Object::dref (obj);
      Object::dref (arg);
      throw;
    }
  }

  // operator !=

  Object* builtin_neq (Runnable* robj, Nameset* nset, Cons* args) {
    // get the objects
    Object* obj = getobj (robj, nset, args, "!=");
    Object* arg = nilp;
    try {
      arg = getarg (robj, nset, args);
    } catch (...) {
      Object::dref (obj);
      throw;
    }
    // perform operation
    try {
      Object* result = obj->oper (Object::NEQ, arg);
      robj->post (result);
      Object::dref (obj);
      Object::dref (arg);
      return result;
    } catch (...) {
      Object::dref (obj);
      Object::dref (arg);
      throw;
    }
  }
  
  // operator >=

  Object* builtin_geq (Runnable* robj, Nameset* nset, Cons* args) {
    // get the objects
    Object* obj = getobj (robj, nset, args, ">=");
    Object* arg = nilp;
    try {
      arg = getarg (robj, nset, args);
    } catch (...) {
      Object::dref (obj);
      throw;
    }
    // perform operation
    try {
      Object* result = obj->oper (Object::GEQ, arg);
      robj->post (result);
      Object::dref (obj);
      Object::dref (arg);
      return result;
    } catch (...) {
      Object::dref (obj);
      Object::dref (arg);
      throw;
    }
  }
  
  // operator >

  Object* builtin_gth (Runnable* robj, Nameset* nset, Cons* args) {
    // get the objects
    Object* obj = getobj (robj, nset, args, ">");
    Object* arg = nilp;
    try {
      arg = getarg (robj, nset, args);
    } catch (...) {
      Object::dref (obj);
      throw;
    }
    // perform operation
    try {
      Object* result = obj->oper (Object::GTH, arg);
      robj->post (result);
      Object::dref (obj);
      Object::dref (arg);
      return result;
    } catch (...) {
      Object::dref (obj);
      Object::dref (arg);
      throw;
    }
  }
  
  // operator <=

  Object* builtin_leq (Runnable* robj, Nameset* nset, Cons* args) {
    // get the objects
    Object* obj = getobj (robj, nset, args, "<=");
    Object* arg = nilp;
    try {
      arg = getarg (robj, nset, args);
    } catch (...) {
      Object::dref (obj);
      throw;
    }
    // perform operation
    try {
      Object* result = obj->oper (Object::LEQ, arg);
      robj->post (result);
      Object::dref (obj);
      Object::dref (arg);
      return result;
    } catch (...) {
      Object::dref (obj);
      Object::dref (arg);
      throw;
    }
  }

  // operator <

  Object* builtin_lth (Runnable* robj, Nameset* nset, Cons* args) {
    // get the objects
    Object* obj = getobj (robj, nset, args, "<");
    Object* arg = nilp;
    try {
      arg = getarg (robj, nset, args);
    } catch (...) {
      Object::dref (obj);
      throw;
    }
    // perform operation
    try {
      Object* result = obj->oper (Object::LTH, arg);
      robj->post (result);
      Object::dref (obj);
      Object::dref (arg);
      return result;
    } catch (...) {
      Object::dref (obj);
      Object::dref (arg);
      throw;
    }
  }
  
  // process an assert command - this does nothing if the assert flag is false

  Object* builtin_assert (Runnable* robj, Nameset* nset, Cons* args) {
    // process first object
    Object* car1 = (args == nilp) ? nilp : args->getcar ();
    Object* obj1 = (car1 == nilp) ? nilp : car1->eval (robj, nset);
    Object::iref (obj1);
    // process object 2
    Object* car2 = (args == nilp) ? nilp : args->getcadr ();
    Object* obj2 = (car2 == nilp) ? nilp : car2->eval (robj, nset);
    Object::iref (obj2);
    // check for nil
    if ((obj1 == nilp) && (obj2 == nilp)) return nilp;
    // do nothing if assert flag is false
    if (robj->getasrt () == false) {
      Object::dref (obj1);
      Object::dref (obj2);
      return nilp;
    }
    // normal compare
    bool status = false;
    if (obj1 != nilp) {
      Object*  aobj = obj1->oper (Object::EQL, obj2);
      Boolean* bobj = dynamic_cast <Boolean*> (aobj);
      status = bobj->toboolean ();
      Object::cref (bobj);
    }
    Object::dref (obj1);
    Object::dref (obj2);
    if (status == true) return nilp;
    Exception e ("assert-error");
    e.setabf (true);
    throw e;  
  }
}