// ---------------------------------------------------------------------------
// - Cons.cpp                                                                -
// - standard object library - cons cell class 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-2008 amaury darsch                                   -
// ---------------------------------------------------------------------------

#include "Cons.hpp"
#include "Input.hpp"
#include "Stdsid.hxx"
#include "Vector.hpp"
#include "Output.hpp"
#include "Recycle.hpp"
#include "Boolean.hpp"
#include "Integer.hpp"
#include "Runnable.hpp"
#include "QuarkZone.hpp"
#include "Exception.hpp"

namespace afnix {
 
  // -------------------------------------------------------------------------
  // - memory allocation section                                             -
  // -------------------------------------------------------------------------

  // the cons cell recycler
  static Recycle recycler;

  // allocate a new cons cell
  void* Cons::operator new (const t_size size) {
    return recycler.pop (size);
  }

  // delete a cons cell
  void Cons::operator delete (void* handle) {
    recycler.push (handle);
  }

  // -------------------------------------------------------------------------
  // - class section                                                         -
  // -------------------------------------------------------------------------

  // create a new cons cell initialized to nil

  Cons::Cons (void) {
    d_type = Cons::NORMAL;
    p_car  = nilp;
    p_cdr  = nilp;
    p_mon  = nilp;
    d_bpt  = false;
  }

  // create a new cons cell with a type

  Cons::Cons (t_type type) {
    d_type = type;
    p_car  = nilp;
    p_cdr  = nilp;
    p_mon  = nilp;
    d_bpt  = false;
  }

  // create a new cons cell with a car

  Cons::Cons (Object* car) {
    d_type = Cons::NORMAL;
    p_car  = Object::iref (car);
    p_cdr  = nilp;
    p_mon  = nilp;
    d_bpt  = false;
  }

  // create a new cons cell with a type and a car

  Cons::Cons (t_type type, Object* car) {
    d_type = type;
    p_car  = Object::iref (car);
    p_cdr  = nilp;
    p_mon  = nilp;
    d_bpt  = false;
  }

  // copy constructor for this cons cell

  Cons::Cons (const Cons& that) {
    that.rdlock ();
    d_type  = that.d_type;
    p_car   = Object::iref (that.p_car);
    p_cdr   = that.p_cdr;
    d_bpt   = that.d_bpt;
    Object::iref (that.p_cdr);
    p_mon   = (that.p_mon == nilp) ? nilp : new Monitor;
    that.unlock ();
  }

  // destroy this cons cell

  Cons::~Cons (void) {
    delete p_mon;
    Object::dref (p_car);
    Object::dref (p_cdr);
  }

  // return the class name
  String Cons::repr (void) const {
    return "Cons";
  }

  // return the cons cell serial code

  t_byte Cons::serialid (void) const {
    return SERIAL_CONS_ID;
  }

  // serialize this cons cell

  void Cons::wrstream (Output& os) const {
    rdlock ();
    // write the cons cell type
    switch (d_type) {
    case NORMAL:
      os.write ((char) 0x00);
      break;
    case BLOCK:
      os.write ((char) 0x01);
      break;
    }
    // try to serialize the car
    if (p_car == nilp) {
      Serial::wrnilid (os);
    } else {
      Serial* sobj = dynamic_cast <Serial*> (p_car);
      if (sobj == nilp) {
	unlock ();
	throw Exception ("serial-error", "cannot serialize object", 
			 p_car->repr ());
      }
      sobj->serialize (os);
    }
    // try to serialize the cdr
    if (p_cdr == nilp) {
      Serial::wrnilid (os);
    } else {
      Serial* sobj = dynamic_cast <Serial*> (p_cdr);
      if (sobj == nilp) {
	unlock ();
	throw Exception ("serial-error", "cannot serialize object", 
			 p_car->repr ());
      }
      sobj->serialize (os);
    }
    unlock ();
  }

  // deserialize this cons cell

  void Cons::rdstream (Input& is) {
    wrlock ();
    // deserialize the type
    switch (is.read ()) {
    case 0x00:
      d_type = NORMAL;
      break;
    case 0x01:
      d_type = BLOCK;
      break;
    default:
      unlock ();
      throw Exception ("serial-error", "invalid cons cell type found");
      break;
    }
    // deserialize the car
    setcar (Serial::deserialize (is));
    // deserialize the cdr
    Object* obj = Serial::deserialize (is);
    if (obj == nilp) {
      setcdr ((Cons*) nilp);
    } else {
      Cons* cdr = dynamic_cast <Cons*> (obj);
      if (cdr == nilp) {
	unlock ();
	throw Exception ("deserialize-error", "non cons cell to deserialize",
			 obj->repr ());
      }
      setcdr (cdr);
    }
    unlock ();
  }

  // assign a cons cell to this one

  Cons& Cons::operator = (const Cons& that) {
    wrlock ();
    that.rdlock ();
    // protect again same assignation
    Object::dref (p_car);
    Object::dref (p_cdr);
    // assign cell
    d_type = that.d_type;
    p_car  = Object::iref (that.p_car);
    p_cdr  = that.p_cdr; Object::iref (p_cdr);
    p_mon  = (that.p_mon == nilp) ? nilp : new Monitor;
    that.unlock ();
    unlock ();
    return *this;
  }

  // append an object to the last cdr of this cons cell

  void Cons::append (Object* object) {
    wrlock ();
    try {
      // create a new cons cell 
      Cons* cons = new Cons (object);
      // find the last cons cell
      Cons* last = this;
      while (last->p_cdr != nilp) last = last->p_cdr;
      // attach this new cons cell
      last->p_cdr = cons;
      Object::iref (cons);
      // unlock the cons cell
      unlock ();
    } catch (...) {
      unlock ();
      throw;
    }
  }

  // set the car if the object is nil or append the object

  void Cons::lnkobj (Object* object) {
    wrlock ();
    try {
      // set the car or append
      if ((p_car == nilp) && (p_cdr == nilp)) {
	setcar (object);
	unlock ();
	return;
      }
      append (object);
      unlock ();
    } catch (...) {
      unlock ();
      throw;
    }
  }

  // set the car of this cons cell

  void Cons::setcar (Object* object) {
    wrlock ();
    try {
      // set the car
      Object::dref (p_car);
      p_car = Object::iref (object);
      // unlock the cons cell
      unlock ();
    } catch (...) {
      unlock ();
      throw;
    }
  }

  // set the cdr of this cons cell

  void Cons::setcdr (Cons* cdr) {
    wrlock ();
    try {
      // set the cdr
      Object::dref (p_cdr);
      p_cdr = cdr; Object::iref (cdr);
      // unlock the cons cell
      unlock ();
    } catch (...) {
      unlock ();
      throw;
    }
  }

  // return the car of this cons cell

  Object* Cons::getcar (void) const {
    rdlock ();
    Object* result = p_car;
    unlock ();
    return result;
  }

  // return the cdr of this cons cell

  Cons* Cons::getcdr (void) const {
    rdlock ();
    Cons* result = p_cdr;
    unlock ();
    return result;
  }


  // return the car of the cdr of this cons cell

  Object* Cons::getcadr (void) const {
    rdlock ();
    if (p_cdr == nilp) {
      unlock ();
      return nilp;
    }
    Object* result = p_cdr->p_car;
    unlock ();
    return result;
  }

  // return the car of the cdr of the cdr of this cons cell

  Object* Cons::getcaddr (void) const {
    rdlock ();
    if (p_cdr == nilp) {
      unlock ();
      return nilp;
    }
    Cons* cdr = p_cdr->p_cdr;
    if (cdr == nilp) {
      unlock ();
      return nilp;
    }
    Object* result = cdr->p_car;
    unlock ();
    return result;
  }

  // return the car of the cdr of the cdr of the cdr of this cons cell

  Object* Cons::getcadddr (void) const {
    rdlock ();
    if (p_cdr == nilp) {
      unlock ();
      return nilp;
    }
    Cons* cdr = p_cdr->p_cdr;
    if (cdr == nilp) {
      unlock ();
      return nilp;
    }
    cdr = cdr->p_cdr;
    if (cdr == nilp) {
      unlock ();
      return nilp;
    }
    Object* result = cdr->p_car;
    unlock ();
    return result;
  }

  // return true if the car is nil

  bool Cons::isnil (void) const {
    rdlock ();
    bool result = (p_car == nilp);
    unlock ();
    return result;
  }

  // return true if the cons cell is a block cell

  bool Cons::isblock (void) const {
    rdlock ();
    bool result = (d_type == BLOCK);
    unlock ();
    return result;
  }
  
  // return the length of this cons cell

  long Cons::length (void) const {
    rdlock ();
    long result      = 0;
    const Cons* cons = this;
    do {
      result++;
    } while ((cons = cons->p_cdr) != nilp);
    unlock ();
    return result;
  }

  // return an object by index

  Object* Cons::get (const long index) const {
    rdlock ();
    try {
      long count       = 0;
      const Cons* cons = this;
      if (index < 0) throw Exception ("index-error",
				      "invalid negative index in cons get");
      // loop in the cons cell list
      while (cons != nilp) {
	if (count == index) {
	  Object* result = cons->p_car;
	  unlock ();
	  return result;
	}
	count++;
	cons = cons->p_cdr;
      }
      throw Exception ("index-error", "invalid index in cons get method");
    } catch (...) {
      unlock ();
      throw;
    }
  }

  // set the form synchronizer
  
  void Cons::mksync (void) {
    wrlock ();
    if (p_mon == nilp) p_mon = new Monitor;
    unlock ();
  }

  // set the form breakpoint

  void Cons::setbpt (const bool bpt) {
    wrlock ();
    d_bpt = bpt;
    unlock ();
  }

  // return a cons iterator

  Iterator* Cons::makeit (void) {
    return new Consit (this);
  }

  // -------------------------------------------------------------------------
  // - object section                                                        -
  // -------------------------------------------------------------------------

  // the quark zone
  static const long QUARK_ZONE_LENGTH = 13;
  static QuarkZone  zone (QUARK_ZONE_LENGTH);

  // the object supported quarks
  static const long QUARK_GET       = zone.intern ("get");
  static const long QUARK_NILP      = zone.intern ("nil-p");
  static const long QUARK_LINK      = zone.intern ("link");
  static const long QUARK_BLOCKP    = zone.intern ("block-p");
  static const long QUARK_APPEND    = zone.intern ("append");
  static const long QUARK_LENGTH    = zone.intern ("length");
  static const long QUARK_GETCAR    = zone.intern ("get-car");
  static const long QUARK_SETCAR    = zone.intern ("set-car");
  static const long QUARK_GETCDR    = zone.intern ("get-cdr");
  static const long QUARK_SETCDR    = zone.intern ("set-cdr");
  static const long QUARK_GETCADR   = zone.intern ("get-cadr");
  static const long QUARK_GETCADDR  = zone.intern ("get-caddr");
  static const long QUARK_GETCADDDR = zone.intern ("get-cadddr");

  // evaluate each car of a cons cell and return a new form

  Cons* Cons::mkcons (Runnable* robj, Nameset* nset, Cons* args) {
    // check for nil and lock
    if (args == nilp) return nilp;
    args->rdlock ();
    // create the result cell and loop
    Cons* cons = args;
    Cons* form = new Cons;
    try {
      while (cons != nilp) {
	Object* car = cons->getcar ();
	Object* obj = (car == nilp) ? nilp : car->eval (robj, nset);
	form->lnkobj (obj);
	cons = cons->getcdr ();
      }
      // unlock and return
      args->unlock ();
      return form;
    } catch (...) {
      delete form;
      args->unlock ();
      throw;
    }
  }

  // evaluate each car of a cons cell - if the object is not a cons cell
  // the object is returned

  Object* Cons::mkform (Runnable* robj, Nameset* nset, Object* object) {
    // try to get a cons cell
    Cons* cons = dynamic_cast <Cons*> (object);
    if (cons == nilp) return object;
    // create an evaluated form
    return Cons::mkcons (robj, nset, cons);
  }

  // create a new object in a generic way

  Object* Cons::mknew (Vector* argv) {
    long len = 0;
    if ((argv == nilp) || ((len = argv->length ()) == 0)) return nilp;
    // build the cons cell
    Cons* result = nilp;
    for (long i = 0; i < len; i++) {
      if (result == nilp)
	result = new Cons (argv->get (i));
      else
	result->append (argv->get (i));
    }
    return result;
  }

  // return true if the given quark is defined

  bool Cons::isquark (const long quark, const bool hflg) const {
    rdlock ();
    if (zone.exists (quark) == true) {
      unlock ();
      return true;
    }
    bool result = hflg ? Iterable::isquark (quark, hflg) : false;
    unlock ();
    return result;
  }

  // set an object to the car of this cons cell

  Object* Cons::vdef (Runnable* robj, Nameset* nset, Object* object) {
    setcar (object);
    return object;
  }

  // evaluate this object in the current nameset

  Object* Cons::eval (Runnable* robj, Nameset* nset) {
    // check for breakpoint
    if (d_bpt == true) robj->bpt (nset, this);
    // synchronize the form
    if (p_mon != nilp) p_mon->enter ();
    Object* result = nilp;
    try {
      if (d_type == Cons::BLOCK) {
	Cons* cons = this;
	while (cons != nilp) {
	  Object::cref (result);
	  Object* car = cons->getcar ();
	  if (robj->getnext () == true) {
	    robj->setnext (false);
	    robj->bpt (nset, car);
	  }
	  result = (car == nilp) ? nilp : car->eval (robj,nset);
	  cons   = cons->getcdr ();
	}
      } else {
	if (p_car == nilp) {
	  if (p_mon != nilp) p_mon->leave ();
	  return nilp;
	}
	Object* func = Object::iref (p_car->eval (robj, nset));
	if (func == nilp) {
	  if (p_mon != nilp) p_mon->leave ();
	  return nilp;
	}
	try {
	  result = func->apply (robj, nset, p_cdr);
	  Object::dref (func);
	} catch (...) {
	  Object::dref (func);
	  throw;
	}
      }
    } catch (...) {
      if (p_mon != nilp) p_mon->leave ();
      throw;
    }
    if (p_mon != nilp) p_mon->leave ();
    return result;
  }

  // apply this object with a set of arguments and a quark

  Object* Cons::apply (Runnable* robj, Nameset* nset, const long quark,
		       Vector* argv) {
    // get the number of arguments
    long argc = (argv == nilp) ? 0 : argv->length ();

    // dispatch 0 argument
    if (argc == 0) {
      if (quark == QUARK_GETCAR)   {
	rdlock ();
	try {
	  Object* result = getcar ();
	  robj->post (result);
	  unlock ();
	  return result;
	} catch (...) {
	  unlock ();
	  throw;
	}
      }
      if (quark == QUARK_GETCDR) {
	rdlock ();
	try {
	  Object* result = getcdr ();
	  robj->post (result);
	  unlock ();
	  return result;
	} catch (...) {
	  unlock ();
	  throw;
	}
      }
      if (quark == QUARK_GETCADR) {
	rdlock ();
	try {
	  Object* result = getcadr ();
	  robj->post (result);
	  unlock ();
	  return result;
	} catch (...) {
	  unlock ();
	  throw;
	}
      } 
      if (quark == QUARK_GETCADDR) {
	rdlock ();
	try {
	  Object* result = getcaddr ();
	  robj->post (result);
	  unlock ();
	  return result;
	} catch (...) {
	  unlock ();
	  throw;
	}
      }
      if (quark == QUARK_GETCADDDR) {
	rdlock ();
	try {
	  Object* result = getcadddr ();
	  robj->post (result);
	  unlock ();
	  return result;
	} catch (...) {
	  unlock ();
	  throw;
	}
      }
      if (quark == QUARK_LENGTH) return new Integer (length ());
      if (quark == QUARK_NILP)   return new Boolean (isnil ());
      if (quark == QUARK_BLOCKP) return new Boolean (isblock ());
    }

    // dispatch 1 argument
    if (argc == 1) {
      if (quark == QUARK_SETCAR) {
	Object* result = argv->get (0);
	setcar (result);
	robj->post (result);
	return result;
      }

      if (quark == QUARK_SETCDR) {
	Object* result = argv->get (0);
	if (result == nilp) {
	  setcdr ((Cons*) nilp);
	  robj->post (result);
	  return nilp;
	}
	Cons* cdr = dynamic_cast <Cons*> (result);
	if (cdr == nilp) 
	  throw Exception ("type-error", "invalid object with set-cdr method",
			   Object::repr (result));
	
	setcdr (cdr);
	robj->post (cdr);
	return result;
      }

      if (quark == QUARK_APPEND) {
	Object* result = argv->get (0);
	append (result);
	robj->post (result);
	return result;
      }

      if (quark == QUARK_LINK) {
	Object* result = argv->get (0);
	lnkobj (result);
	robj->post (result);
	return result;
      }

      if (quark == QUARK_GET) {
	wrlock ();
	try {
	  long val = argv->getint (0);
	  Object* result = get (val);
	  robj->post (result);
	  unlock ();
	  return result;
	} catch (...) {
	  unlock ();
	  throw;
	}
      }
    }
    
    // call the object method
    return Iterable::apply (robj, nset, quark, argv);
  }

  // -------------------------------------------------------------------------
  // - iterator section                                                      -
  // -------------------------------------------------------------------------

  // create a new cons iterator

  Consit::Consit (Cons* cons) {
    Object::iref (p_cons = cons);
    Object::iref (p_cell = cons);
    if (p_cell != nilp) p_cell->rdlock ();
  }

  // destroy this cons iterator

  Consit::~Consit (void) {
    if (p_cell != nilp) p_cell->unlock ();
    Object::dref (p_cell);
    Object::dref (p_cons);
  }

  // return the class name

  String Consit::repr (void) const {
    return "Consit";
  }

  // reset the iterator to the begining

  void Consit::begin (void) {
    wrlock ();
    if (p_cell != nilp) p_cell->unlock ();
    Object::dref (p_cell);
    Object::iref (p_cell = p_cons);
    if (p_cell != nilp) p_cell->rdlock ();
    unlock ();
  }

  // reset the iterator to the end

  void Consit::end (void) {
    throw Exception ("iterator-error", "cannot set a cons iterator to end");
  }

  // go to the next object

  void Consit::next (void) {
    wrlock ();
    if (p_cell == nilp) {
      unlock ();
      return;
    }
    Cons* cdr = p_cell->p_cdr;
    if (cdr != nilp) {
      cdr->rdlock ();
      Object::iref (cdr);
    }
    p_cell->unlock ();
    Object::dref (p_cell);
    p_cell = cdr;
    unlock ();
  }

  // go to the previous object
  void Consit::prev (void) {
    throw Exception ("iterator-error", "cannot move back a cons iterator");
  }

  // get the object at the current position

  Object* Consit::getobj (void) const {
    rdlock ();
    Object* result = (p_cell == nilp) ? nilp : p_cell->getcar ();
    unlock ();
    return result;
  }

  // return true if the iterator is at the end

  bool Consit::isend (void) {
    rdlock ();
    bool result =  (p_cell == nilp);
    unlock ();
    return result;
  }
}
