// ---------------------------------------------------------------------------
// - Interp.cpp                                                              -
// - afnix engine - interpreter 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-2011 amaury darsch                                   -
// ---------------------------------------------------------------------------

#include "Set.hpp"
#include "Enum.hpp"
#include "Byte.hpp"
#include "Real.hpp"
#include "Meta.hpp"
#include "List.hpp"
#include "Fifo.hpp"
#include "Heap.hpp"
#include "Queue.hpp"
#include "Mutex.hpp"
#include "Regex.hpp"
#include "Plist.hpp"
#include "Logger.hpp"
#include "Interp.hpp"
#include "Thrset.hpp"
#include "Return.hpp"
#include "Reader.hpp"
#include "Module.hpp"
#include "System.hpp"
#include "Bitset.hpp"
#include "Symbol.hpp"
#include "Lexical.hpp"
#include "Relatif.hpp"
#include "Condvar.hpp"
#include "Library.hpp"
#include "Printer.hpp"
#include "Builtin.hpp"
#include "Boolean.hpp"
#include "Closure.hpp"
#include "Counter.hpp"
#include "Function.hpp"
#include "Instance.hpp"
#include "Librarian.hpp"
#include "Qualified.hpp"
#include "Character.hpp"
#include "HashTable.hpp"
#include "QuarkZone.hpp"
#include "Exception.hpp"
#include "PrintTable.hpp"
#include "BlockBuffer.hpp"

namespace afnix {

  // -------------------------------------------------------------------------
  // - private section                                                       -
  // -------------------------------------------------------------------------

  // this procedure initialize the interpreter global nameset
  static void axi_gset_init (Interp* interp) {
    // always check for nil
    if (interp == nilp) return;
    // get the global nameset
    Nameset* nset = interp->getgset ();
    if (nset == nilp) return;

    // bind standard constants
    nset->symcst  ("...",            nset);
    nset->symcst  ("nil",            nilp);
    nset->symcst  ("interp",         interp);

    //  builtin functions
    interp->mkrsv ("if",             new Function (builtin_if));
    interp->mkrsv ("do",             new Function (builtin_do));
    interp->mkrsv ("for",            new Function (builtin_for));
    interp->mkrsv ("try",            new Function (builtin_try));
    interp->mkrsv ("eval",           new Function (builtin_eval));
    interp->mkrsv ("sync",           new Function (builtin_sync));
    interp->mkrsv ("loop",           new Function (builtin_loop));
    interp->mkrsv ("enum",           new Function (builtin_enum));
    interp->mkrsv ("const",          new Function (builtin_const));
    interp->mkrsv ("trans",          new Function (builtin_trans));
    interp->mkrsv ("unref",          new Function (builtin_unref));
    interp->mkrsv ("class",          new Function (builtin_class));
    interp->mkrsv ("block",          new Function (builtin_block));
    interp->mkrsv ("while",          new Function (builtin_while));
    interp->mkrsv ("gamma",          new Function (builtin_gamma));
    interp->mkrsv ("throw",          new Function (builtin_throw));
    interp->mkrsv ("force",          new Function (builtin_force));
    interp->mkrsv ("delay",          new Function (builtin_delay));
    interp->mkrsv ("lambda",         new Function (builtin_lambda));
    interp->mkrsv ("switch",         new Function (builtin_switch));
    interp->mkrsv ("return",         new Function (builtin_return));
    interp->mkrsv ("launch",         new Function (builtin_launch));
    interp->mkrsv ("protect",        new Function (builtin_protect));
    interp->mkrsv ("nameset",        new Function (builtin_nameset));

    // builtin operators
    interp->mkrsv ("+",              new Function (builtin_add));
    interp->mkrsv ("-",              new Function (builtin_sub));
    interp->mkrsv ("*",              new Function (builtin_mul));
    interp->mkrsv ("/",              new Function (builtin_div));
    interp->mkrsv ("==",             new Function (builtin_eql));
    interp->mkrsv ("!=",             new Function (builtin_neq));
    interp->mkrsv (">=",             new Function (builtin_geq));
    interp->mkrsv (">",              new Function (builtin_gth));
    interp->mkrsv ("<=",             new Function (builtin_leq));
    interp->mkrsv ("<",              new Function (builtin_lth));
    interp->mkrsv ("assert",         new Function (builtin_assert)); 

    // logical operators
    interp->mkrsv ("or",             new Function (builtin_or));
    interp->mkrsv ("not",            new Function (builtin_not));
    interp->mkrsv ("and",            new Function (builtin_and));
    
    // standard printer objects
    interp->mkrsv ("print",          new Printer  (Printer::OUTPUT));
    interp->mkrsv ("println",        new Printer  (Printer::OUTPUTLN));
    interp->mkrsv ("error",          new Printer  (Printer::ERROR));
    interp->mkrsv ("errorln",        new Printer  (Printer::ERRORLN));

    // standard predicates
    interp->mkrsv ("nil-p",          new Function (builtin_nilp));
    interp->mkrsv ("set-p",          new Function (builtin_setp));
    interp->mkrsv ("eval-p",         new Function (builtin_evlp));
    interp->mkrsv ("cons-p",         new Function (builtin_consp));
    interp->mkrsv ("form-p",         new Function (builtin_formp));
    interp->mkrsv ("list-p",         new Function (builtin_listp));
    interp->mkrsv ("byte-p",         new Function (builtin_bytep));
    interp->mkrsv ("real-p",         new Function (builtin_realp));
    interp->mkrsv ("enum-p",         new Function (builtin_enump));
    interp->mkrsv ("item-p",         new Function (builtin_itemp));
    interp->mkrsv ("hash-p",         new Function (builtin_hashp));
    interp->mkrsv ("fifo-p",         new Function (builtin_fifop));
    interp->mkrsv ("heap-p",         new Function (builtin_heapp));
    interp->mkrsv ("regex-p",        new Function (builtin_regexp));
    interp->mkrsv ("queue-p",        new Function (builtin_queuep));
    interp->mkrsv ("class-p",        new Function (builtin_clsp));
    interp->mkrsv ("plist-p",        new Function (builtin_plistp));
    interp->mkrsv ("combo-p",        new Function (builtin_cmbp));
    interp->mkrsv ("object-p",       new Function (builtin_objp));
    interp->mkrsv ("string-p",       new Function (builtin_strp));
    interp->mkrsv ("buffer-p",       new Function (builtin_bufp));
    interp->mkrsv ("thread-p",       new Function (builtin_thrp));
    interp->mkrsv ("thrset-p",       new Function (builtin_thrsp));
    interp->mkrsv ("strvec-p",       new Function (builtin_stvp));
    interp->mkrsv ("vector-p",       new Function (builtin_vecp));
    interp->mkrsv ("bitset-p",       new Function (builtin_bitsp));
    interp->mkrsv ("number-p",       new Function (builtin_nump));
    interp->mkrsv ("symbol-p",       new Function (builtin_symp));
    interp->mkrsv ("loader-p",       new Function (builtin_loadp));
    interp->mkrsv ("logger-p",       new Function (builtin_logp));
    interp->mkrsv ("former-p",       new Function (builtin_formrp));
    interp->mkrsv ("reader-p",       new Function (builtin_readrp));
    interp->mkrsv ("lexical-p",      new Function (builtin_lexp));
    interp->mkrsv ("condvar-p",      new Function (builtin_condp));
    interp->mkrsv ("promise-p",      new Function (builtin_prmp));
    interp->mkrsv ("boolean-p",      new Function (builtin_boolp));
    interp->mkrsv ("integer-p",      new Function (builtin_intp));
    interp->mkrsv ("relatif-p",      new Function (builtin_rltp));
    interp->mkrsv ("literal-p",      new Function (builtin_litp));
    interp->mkrsv ("closure-p",      new Function (builtin_clop));
    interp->mkrsv ("nameset-p",      new Function (builtin_nstp));
    interp->mkrsv ("counter-p",      new Function (builtin_cntrp));
    interp->mkrsv ("instance-p",     new Function (builtin_instp));
    interp->mkrsv ("resolver-p",     new Function (builtin_rslvp));
    interp->mkrsv ("property-p",     new Function (builtin_propp));
    interp->mkrsv ("hashtable-p",    new Function (builtin_ashp));
    interp->mkrsv ("character-p",    new Function (builtin_charp));
    interp->mkrsv ("qualified-p",    new Function (builtin_qualp));
    interp->mkrsv ("librarian-p",    new Function (builtin_lbrnp));
    interp->mkrsv ("print-table-p",  new Function (builtin_ptblp));
    interp->mkrsv ("block-buffer-p", new Function (builtin_bbufp));

    // standard objects
    interp->mkrsv ("Set",            new Meta (Set::mknew));
    interp->mkrsv ("Enum",           new Meta (Enum::mknew));
    interp->mkrsv ("Byte",           new Meta (Byte::mknew));
    interp->mkrsv ("Real",           new Meta (Real::mknew));
    interp->mkrsv ("Cons",           new Meta (Cons::mknew));
    interp->mkrsv ("List",           new Meta (List::mknew));
    interp->mkrsv ("Fifo",           new Meta (Fifo::mknew));
    interp->mkrsv ("Heap",           new Meta (Heap::mknew));
    interp->mkrsv ("Regex",          new Meta (Regex::mknew));
    interp->mkrsv ("Queue",          new Meta (Queue::mknew));
    interp->mkrsv ("Plist",          new Meta (Plist::mknew));
    interp->mkrsv ("String",         new Meta (String::mknew));
    interp->mkrsv ("Buffer",         new Meta (Buffer::mknew));
    interp->mkrsv ("Strvec",         new Meta (Strvec::mknew));
    interp->mkrsv ("Vector",         new Meta (Vector::mknew)); 
    interp->mkrsv ("Thread",         new Meta (Thread::mknew));
    interp->mkrsv ("Thrset",         new Meta (Thrset::mknew));
    interp->mkrsv ("Bitset",         new Meta (Bitset::mknew));
    interp->mkrsv ("Symbol",         new Meta (Symbol::mknew));
    interp->mkrsv ("Logger",         new Meta (Logger::mknew));
    interp->mkrsv ("Reader",         new Meta (Reader::mknew));
    interp->mkrsv ("Lexical",        new Meta (Lexical::mknew));
    interp->mkrsv ("Condvar",        new Meta (Condvar::mknew));    
    interp->mkrsv ("Relatif",        new Meta (Relatif::mknew));    
    interp->mkrsv ("Integer",        new Meta (Integer::mknew));
    interp->mkrsv ("Boolean",        new Meta (Boolean::mknew));
    interp->mkrsv ("Closure",        new Meta (Closure::mknew));
    interp->mkrsv ("Counter",        new Meta (Counter::mknew));
    interp->mkrsv ("Instance",       new Meta (Instance::mknew));
    interp->mkrsv ("Resolver",       new Meta (Resolver::mknew));
    interp->mkrsv ("Property",       new Meta (Property::mknew));
    interp->mkrsv ("Character",      new Meta (Character::mknew));
    interp->mkrsv ("HashTable",      new Meta (HashTable::mknew));
    interp->mkrsv ("Librarian",      new Meta (Librarian::mknew));
    interp->mkrsv ("Qualified",      new Meta (Qualified::mknew));
    interp->mkrsv ("PrintTable",     new Meta (PrintTable::mknew));
    interp->mkrsv ("BlockBuffer",    new Meta (BlockBuffer::mknew));
  }

  // -------------------------------------------------------------------------
  // - public section                                                        -
  // -------------------------------------------------------------------------

  // the options messages
  static const String U_CLS_MSG = "axi [options] [file] [arguments]";
  static const String H_OPT_MSG = "    [h]       \t print this help message";
  static const String V_OPT_MSG = "    [v]       \t print system version";
  static const String M_OPT_MSG = "    [m]       \t enable the start module";
  static const String I_OPT_MSG = "    [i   path]\t add a resolver path";
  static const String E_OPT_MSG = "    [e   mode]\t force the encoding mode";
  static const String F_ASR_MSG = "    [f assert]\t enable assertion checks";
  static const String F_NOP_MSG = "    [f nopath]\t do not set initial path";
  static const String F_SRE_MSG = "    [f   seed]\t seed random engine";
  static const String F_NOS_MSG = "    [f noseed]\t do not seed random engine";

  // get an interpreter option class

  Options* Interp::getopts (void) {
    // create the option class
    Options* opts = new Options (U_CLS_MSG);

    // add the list options
    opts->add ('f', "seed",   F_SRE_MSG);
    opts->add ('f', "noseed", F_NOS_MSG);
    opts->add ('f', "nopath", F_NOP_MSG);
    opts->add ('f', "assert", F_ASR_MSG);

    // add the string options
    opts->add (Options::SOPT, 'e', E_OPT_MSG);
    opts->add (Options::VOPT, 'i', I_OPT_MSG);

    // add the uniq options
    opts->add (Options::UNIQ, 'm', M_OPT_MSG);
    opts->add (Options::UNIQ, 'v', V_OPT_MSG);
    opts->add (Options::UNIQ, 'h', H_OPT_MSG);

    // set the debug flag and return
    opts->setdbg ('f', "assert");
    opts->setdbg ('f', "noseed");
    return opts;
  }

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

  // create a default interpreter
  
  Interp::Interp (void) {
    // initialize default values
    d_assert = false;
    d_cloned = false;
    d_next   = false;
    // create a default terminal
    Object::iref (p_term = new Terminal);
    // save streams
    Object::iref (p_is = p_term);
    Object::iref (p_os = p_term);
    Object::iref (p_es = new OutputTerm (OutputTerm::ERROR));
    // clear the post object
    p_posted = nilp;
    // initialize the arguments vector
    Object::iref (p_argv = new Vector);
    // initialize the resolver
    Object::iref (p_rslv = new Resolver);
    // initialize the global nameset
    Object::iref (p_gset = new Superset); axi_gset_init (this);
    // reset the runnable form
    p_rform = nilp;
    // create the library loader
    Object::iref (p_shld = new Loader);
  }

  // create a new interpreter with or without a terminal

  Interp::Interp (const bool tflg) {
    // initialize default values
    d_assert = false;
    d_cloned = false;
    d_next   = false;
    // set the streams
    if (tflg == true) {
      Object::iref (p_term = new Terminal);
      Object::iref (p_is = p_term);
      Object::iref (p_os = p_term);
      Object::iref (p_es = new OutputTerm (OutputTerm::ERROR));
    } else {
      p_term = nilp;
      p_is   = nilp;
      p_os   = nilp;
      p_es   = nilp;
    }
    // clear the post object
    p_posted = nilp;
    // initialize the arguments vector
    Object::iref (p_argv = new Vector);
    // initialize the resolver
    Object::iref (p_rslv = new Resolver);
    // initialize the global nameset
    Object::iref (p_gset = new Superset); axi_gset_init (this);
    // reset the runnable form
    p_rform = nilp;
    // create the libary loader
    Object::iref (p_shld = new Loader);
  }

  // create a new interpreter with the specified streams

  Interp::Interp (InputStream* is, OutputStream* os, OutputStream* es) {
    // initialize default values
    d_assert = false;
    d_cloned = false;
    d_next   = false;
    p_term   = nilp;
    // save streams
    Object::iref (p_is = is);
    Object::iref (p_os = os);
    Object::iref (p_es = es);
    // clear the post object
    p_posted = nilp;
    // initialize the arguments vector
    Object::iref (p_argv = new Vector);
    // initialize the resolver
    Object::iref (p_rslv = new Resolver);
    // initialize the global nameset
    Object::iref (p_gset = new Superset); axi_gset_init (this);
    // reset the runnable form
    p_rform = nilp;
    // create the libary loader
    Object::iref (p_shld = new Loader);
  }

  // copy constructor

  Interp::Interp (const Interp& that) {
    // initialize default value
    d_assert = that.d_assert;
    d_cloned = true;
    d_next   = false;
    // copy the terminal
    Object::iref (p_term = that.p_term);
    // copy the streams
    Object::iref (p_is = that.p_is);
    Object::iref (p_os = that.p_os);
    Object::iref (p_es = that.p_es);
    // clear the post object
    p_posted = nilp;
    // copy the vector arguments
    Object::iref (p_argv = that.p_argv);
    // copy the file path
    Object::iref (p_rslv = that.p_rslv);
    // copy the global nameset
    Object::iref (p_gset = that.p_gset);
    // reset the runnable form
    p_rform = nilp;
    // copy the library loader
    Object::iref (p_shld = that.p_shld);
  }

  // delete this interpreter

  Interp::~Interp (void) {
    // protect us
    Object::iref (this);
    // clear the posted object
    Object::dref (p_posted); p_posted = nilp;
    // eventually reset the globalset
    if (d_cloned == false) p_gset->reset ();
    // clean the objects first
    Object::dref (p_is);
    Object::dref (p_os);
    Object::dref (p_es);
    Object::dref (p_term);
    Object::dref (p_gset);
    Object::dref (p_argv);
    Object::dref (p_rslv);
    Object::dref (p_rform);
    Object::dref (p_shld);
    // check for a nil thread list - this is a tricky one here
    // it is designed to avoid a race condition between the thread
    // system and the cleanup handler where all threads might be marked
    // finished but have not yet release the lock and the global
    // destructors are called when the interpreter is released...
    if (d_cloned == false) {
      // wait for the nil thread list
      Thread::wnil ();
      // check if the thread list is nil
      if (Thread::isnil () == false) {
	if (p_os != nilp) p_os->panic ("thread list is not nil at exit");
	System::abort ();
      }
    }
  }

  // return the class name

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

  // return a clone of this object

  Object* Interp::clone (void) const {
    return new Interp (*this);
  }

  // evaluate the runnable form

  Object* Interp::run (void) {
    Object* result = nilp;
    try {
      result = (p_rform == nilp) ? nilp : p_rform->eval (this, p_gset);
    } catch (const Exception& e) {
      getes()->errorln (e);
      if (e.getabf () == true) Thread::exit ();
    } catch (const Return& r) {
      result = r.getobj ();
    } catch (...) {
      getes()->errorln ("fatal: unknown exception trapped");
      result = nilp;
    }
    this->post (result);
    return result;
  }

  // break the interpreter in a nameset with an object

  bool Interp::bpt (Nameset* nset, Object* object) {
    if (object != nilp) object->eval (this, nset);
    return true;
  }

  // loop on the standard input by doing a read-eval loop
  // this procedure return false is something bad happen

  bool Interp::loop (void) {
    // initialize status
    bool status = true;
    // loop in the standard input
    try {
      status = loop (p_gset, getis ());
    } catch (const Exception& e) {
      getes()->errorln (e);
      if (e.getabf () == true) System::exit (1);
    } catch (...) {
      status = false;
      getes()->errorln ("fatal: unknown exception trapped");
    }
    // wait for all threads to terminate - this works only for the
    // master thread - for the other threads, this does nothing
    Thread::wall ();
    return status;
  }

  // loop on the standard input in a nameset context

  bool Interp::loop (Nameset* nset, InputStream* is) {
    // initialize the status
    bool status = true;
    // create a new reader 
    Reader* rd = new Reader (is);
    // loop until we have an eos
    while (true) {
      Form* form = nilp;
      try {
	form = rd->parse ();
	if (form == nilp) break;
	Object::cref (form->eval (this, nset));
	Object::dref (form);
      } catch (const Exception& e) {
	if (e.getabf () == true) throw;
	status = false;
	getes()->errorln (e);
	Object::dref (form);
      } catch (const Return& r) {
	this->post (r.getobj ());
	Object::dref (form);
      } catch (...) {
	Object::dref (form);
	delete rd;
	throw;
      }
    }
    delete rd;
    return status;
  }

  // loop with an input file by doing a read-eval loop
  // this procedure return false is something bad happen
  
  bool Interp::loop (const String& fname) {
    // load the file
    bool status = true;
    try {
      load (fname);
    } catch (const Exception& e) {
      status = false;
      getes()->errorln (e);
      if (e.getabf () == true) System::exit (1);
    } catch (...) {
      status = false;
      getes()->errorln ("fatal: unknown exception trapped");
    }
    // wait for all threads to terminate
    if (status == true) Thread::wall ();
    return status;
  }

  // loop with an input file by doing a read-eval loop - no thread wait
  
  void Interp::load (const String& fname) {
    // bind the input stream
    InputStream* ms = p_rslv->alplkp  (fname);
    // get the interpreter encoding/transcoding modes
    if (ms != nilp) {
      // check for forced encoding
      if (d_emod.isnil () == true) {
	if (p_is == nilp) {
	  ms->settmod (Encoding::getstm ());
	  ms->setemod (Encoding::getsem ());
	} else {
	  ms->settmod (p_is->gettmod ());
	  ms->setemod (p_is->getemod ());
	}
      } else {
	ms->setemod (d_emod);
      }
    }
    // try to open the module
    String mn = p_rslv->alpname (fname);
    Module mp (ms, mn);
    // loop until we have an eos
    while (true) {
      Form* form = nilp;
      try {
	form = mp.parse ();
	if (form == nilp) break;
	Object::cref (form->eval (this, p_gset));
	Object::dref (form);
      } catch (Exception& e) {
	e.updname (fname);
	if (form == nilp) {
	  e.updlnum (mp.getlnum ());
	} else {
	  e.updlnum (form->getlnum ());
	}
	Object::dref (form);
	throw;
      } catch (const Return& r) {
	Object::dref (form);
	this->post (r.getobj ());
      } catch (...) {
	Object::dref (form);
	throw;
      }
    }
  }

  // post an object in this interpreter
  void Interp::post (Object* object) {
    if (object == p_posted) return;
    Object::iref (object);
    Object::dref (p_posted);
    p_posted = object;
  }


  // execute a form in a thread by cloning this interpreter

  Object* Interp::launch (Object* form) {
    return launch (new Thread, form);
  }

  // execute a form in a thread by cloning this interpreter

  Object* Interp::launch (Object* tobj, Object* form) {
    // check for a thread object
    Thread* thread = dynamic_cast <Thread*> (tobj);
    if (thread == nilp) {
      throw Exception ("type-error", "invalid object as thread launcher",
		       Object::repr (tobj));
    }
    // duplicate the interpreter
    Interp* interp = dup (form);
    Object::iref (interp);
    // create a new thread
    try {
      thread->start (interp);
      this->post (thread);
      Object::dref (interp);
      return thread;
    } catch (...) {
      Object::dref (interp);
      throw;
    }
  }

  // return the interpreter input stream

  InputStream* Interp::getis (void) const {
    wrlock ();
    try {
      if (p_is != nilp) {
	unlock ();
	return p_is;
      }
      Object::iref (p_is = new InputTerm);
      p_is->setemod (d_emod); 
      unlock ();
      return p_is;
    } catch (...) {
      unlock ();
      throw;
    }
  }

  // return the interpreter output stream

  OutputStream* Interp::getos (void) const {
    wrlock ();
    try {
      if (p_os != nilp) {
	unlock ();
	return p_os;
      }
      Object::iref (p_os = new OutputTerm (OutputTerm::OUTPUT));
      p_os->setemod (d_emod); 
      unlock ();
      return p_os;
    } catch (...) {
      unlock ();
      throw;
    }
  }
  
  // return the interpreter error stream

  OutputStream* Interp::getes (void) const {
    wrlock ();
    try {
      if (p_es != nilp) {
	unlock ();
	return p_es;
      }
      Object::iref (p_es = new OutputTerm (OutputTerm::ERROR));
      p_es->setemod (d_emod); 
      unlock ();
      return p_es;
    } catch (...) {
      unlock ();
      throw;
    }
  }

  // return the interpreter global nameset

  Nameset* Interp::getgset (void) const {
    return p_gset;
  }

  // set the assert flag

  void Interp::setasrt (const bool flag) {
    wrlock ();
    try {
      d_assert = flag;
      unlock ();
    } catch (...) {
      unlock ();
      throw;
    }
  }

  // return the assert flag

  bool Interp::getasrt (void) const {
    rdlock ();
    try {
      bool result = d_assert;
      unlock ();
      return result;
    } catch (...) {
      unlock ();
      throw;
    }
  }

  // set the next flag
  
  void Interp::setnext (const bool flag) {
    wrlock ();
    try {
      d_next = flag;
      unlock ();
    } catch (...) {
      unlock ();
      throw;
    }
  }

  // return the next flag

  bool Interp::getnext (void) const {
    rdlock ();
    try {
      bool result = d_next;
      unlock ();
      return result;
    } catch (...) {
      unlock ();
      throw;
    }
  }

  // duplicate this interpreter and set the runnable form

  Interp* Interp::dup (Object* form) const {
    Interp* interp = new Interp (*this);
    interp->p_rform = Object::iref (form);
    return interp;
  }

  // duplicate this stream by setting the terminal

  Interp* Interp::dup (Terminal* term) const {
    Interp* interp = new Interp (*this);
    // check that we have a valid terminal
    if (term == nilp) term = new Terminal;
    // update the terminal and the other stream
    Object::iref (term);
    Object::dref (interp->p_term);
    interp->p_term = term;
    // update the input stream
    Object::iref (term);
    Object::dref (interp->p_is);
    interp->p_is = term;
    // update the output stream
    Object::iref (term);
    Object::dref (interp->p_os);
    interp->p_os = term;
    // update the error stream
    Object::iref (term);
    Object::dref (interp->p_es);
    interp->p_es = term;
    // the new interpeter
    return interp;
  }

  // duplicate this interpreter with the associated streams

  Interp* Interp::dup (InputStream* is, 
		       OutputStream* os, OutputStream* es) const {
    Interp* interp = new Interp (*this);
    // update the input stream
    if (is != nilp) {
      Object::iref (is);
      Object::dref (interp->p_is);
      interp->p_is = is;
    }
    // update the output stream
    if (os != nilp) {
      Object::iref (os);
      Object::dref (interp->p_os);
      interp->p_os = os;
    }
    // update the output stream
    if (es != nilp) {
      Object::iref (es);
      Object::dref (interp->p_es);
      interp->p_es = es;
    }
    return interp;
  }

  // create a new reserved entry in the global nameset
  
  void Interp::mkrsv (const String& name, Object* object) {
    wrlock ();
    try {
      p_gset->symcst (name, object);
      Token::mkrsv   (name);
    } catch (...) {
      unlock ();
      throw;
    }
  }

  // create a child nameset by name

  Nameset* Interp::mknset (const String& name) {
    wrlock ();
    try {
      Nameset* result = p_gset->mknset (name);
      unlock ();
      return result;
    } catch (...) {
      unlock ();
      throw;
    }
  }
  
  // set the primary prompt

  void Interp::setpp (const String& value) {
    wrlock ();
    if (p_term != nilp) p_term->setpp (value);
    unlock ();
  }

  // get the primary prompt

  String Interp::getpp (void) const {
    rdlock ();
    String result;
    if (p_term != nilp) result = p_term->getpp ();
    unlock ();
    return result;
  }

  // set the secondary prompt

  void Interp::setsp (const String& value) {
    wrlock ();
    if (p_term != nilp) p_term->setsp (value);
    unlock ();
  }

  // get the secondary prompt

  String Interp::getsp (void) const {
    rdlock ();
    String result;
    if (p_term != nilp) result = p_term->getsp ();
    unlock ();
    return result;
  }

  // set the interpreter encoding mode

  void Interp::setemod (const String& emod) {
    wrlock ();
    try {
      // save the encodig mode
      d_emod = emod;
      // set the terminal
      if (p_term != nilp) p_term->InputStream::setemod  (emod);
      if (p_term != nilp) p_term->OutputStream::setemod (emod);
      // set the base streams
      if (p_is != nilp) p_is->setemod (emod);
      if (p_os != nilp) p_os->setemod (emod);
      if (p_es != nilp) p_es->setemod (emod);
    } catch (...) {
      unlock ();
      throw;
    }
  }

  // set the interpreter options

  String Interp::setopts (const Options& opts) {
    wrlock ();
    try {
      // initialize the name result
      String result = "";
      // get the program name
      String pgmn = opts.getpgmn ();
      // get the seed flag
      bool sflg = !opts.getoflg ('f', "noseed");
      sflg |= opts.getoflg ('f', "seed");
      // preset the afnix system
      System::preset (pgmn, sflg);
      // get the options arguments
      Strvec args = opts.getargs ();
      // check for an optional file name
      bool tflg = args.empty ();
      bool mflg = opts.getoflg ('m');
      bool pflg = opts.getoflg ('f', "nopath");
      // eventually extract the module name
      if ((tflg == false) && (mflg == false) && (pflg == false)) {
	// get the path name
	result = args.pop ();
	// add the directory path
	addpath (System::xdir (result));
      }
      // set the arguments
      setargs (args);
      // set the assert flag
      setasrt (opts.getoflg ('f', "assert"));
      // get the resolver path
      setpath (opts.getoptv ('i'));
      // set the encoding mode
      if (opts.getoflg ('e') == true) setemod (opts.getopts ('e'));
      // eventually extract the start module since the resolver is set
      if (mflg == true) {
	result = p_rslv->getstm ();
	if (result.isnil () == true) {
	  throw Exception ("option-error", "cannot resolve implicit module");
	}
      }
      // unlock and return file name to execute if any
      unlock ();
      return result;
    } catch (...) {
      unlock ();
      throw;
    }
  }

  // set the interpreter arguments

  void Interp::setargs (const Strvec& args) {
    wrlock ();
    try {
      // reset the vector
      p_argv->reset ();
      // fill in the arguments
      long len = args.length ();
      for (long i = 0; i < len; i++) {
	p_argv->add (new String (args.get (i)));
      }
    } catch (...) {
      unlock ();
      throw;
    }
  }

  // get the interpreter arguments

  Strvec Interp::getargs (void) const {
    rdlock ();
    try {
      Strvec result;
      long len = p_argv->length ();
      for (long i = 0; i < len; i++) {
	String* str = dynamic_cast <String*> (p_argv->get (i));
	if (str == nilp) continue;
	result.add (*str);
      }
      return result;
    } catch (...) {
      unlock ();
      throw;
    }
  }

  // add a new path entry in the resolver

  void Interp::addpath (const String& path) {
    wrlock ();
    try {
      p_rslv->add (path);
    } catch (...) {
      unlock ();
      throw;
    }
  }

  // set the path resolver

  void Interp::setpath (const Strvec& path) {
    wrlock ();
    try {
      long len = path.length ();
      for (long i = 0; i < len; i++) p_rslv->add (path.get (i));
    } catch (...) {
      unlock ();
      throw;
    }
  }

  // return the interpreter loader

  Loader* Interp::getld (void) const {
    return p_shld;
  }

  // register a library by name and handle
  
  void Interp::reglib (const String& name, void* hand) {
    wrlock ();
    try {
      p_shld->add (name, hand);
      unlock ();
    } catch (...) {
      unlock ();
      throw;
    }
  }

  // open a new dynamic library by name
 
  Object* Interp::library (const String& name, Vector* argv) {
    wrlock ();
    try {
      // optionnal add the libary and find it
      p_shld->add (name);
      Library* lib = p_shld->lookup (name);
      // call the initialize procedure now
      Object::cref (lib->dlinit (this, argv));
      // post and return the library
      post (lib);
      unlock ();
      return lib;
    } catch (...) {
      unlock ();
      throw;
    }
  }

  // compile from an input stream into an output stream
  
  void Interp::compile (const String& name, OutputStream& os) {
    // bind the input stream
    InputStream*  ms = p_rslv->lookup  (name);
    // get the interpreter encoding/transcoding modes
    if (ms != nilp) {
      // check for forced encoding
      if (d_emod.isnil () == true) {
	if (p_is == nilp) {
	  ms->settmod (Encoding::getstm ());
	  ms->setemod (Encoding::getsem ());
	} else {
	  ms->settmod (p_is->gettmod ());
	  ms->setemod (p_is->getemod ());
	}
      } else {
	ms->setemod (d_emod);
      }
    }
    // try to open the module
    String mn = p_rslv->getpath (name);
    Module mp (ms, mn);
    // write the compiled code
    try {
      mp.write (os);
    } catch (const Exception& e) {
      Integer line = mp.getlnum ();
      String  msg  = name + ':' + line.tostring ();
      throw Exception (msg, e.getval ());
    }
  }

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

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

  // the interpreter supported quarks
  static const long QUARK_DUP     = zone.intern ("dup");
  static const long QUARK_URI     = zone.intern ("afnix-uri");
  static const long QUARK_LOAD    = zone.intern ("load");
  static const long QUARK_ROLL    = zone.intern ("roll");
  static const long QUARK_ARGV    = zone.intern ("argv");
  static const long QUARK_WAIT    = zone.intern ("wait");
  static const long QUARK_RSLV    = zone.intern ("resolver");
  static const long QUARK_MACHS   = zone.intern ("machine-size");
  static const long QUARK_MAJOR   = zone.intern ("major-version");
  static const long QUARK_MINOR   = zone.intern ("minor-version");
  static const long QUARK_PATCH   = zone.intern ("patch-version");
  static const long QUARK_GETIS   = zone.intern ("get-input-stream");
  static const long QUARK_GETOS   = zone.intern ("get-output-stream");
  static const long QUARK_GETES   = zone.intern ("get-error-stream");
  static const long QUARK_GETPP   = zone.intern ("get-primary-prompt");
  static const long QUARK_GETSP   = zone.intern ("get-secondary-prompt");
  static const long QUARK_SETPP   = zone.intern ("set-primary-prompt");
  static const long QUARK_SETSP   = zone.intern ("set-secondary-prompt");
  static const long QUARK_LOADER  = zone.intern ("loader");
  static const long QUARK_LAUNCH  = zone.intern ("launch");
  static const long QUARK_OSNAME  = zone.intern ("os-name");
  static const long QUARK_OSTYPE  = zone.intern ("os-type");
  static const long QUARK_GETAEPS = zone.intern ("get-absolute-precision");
  static const long QUARK_GETREPS = zone.intern ("get-relative-precision");
  static const long QUARK_SETAEPS = zone.intern ("set-absolute-precision");
  static const long QUARK_SETREPS = zone.intern ("set-relative-precision");
  static const long QUARK_VERSION = zone.intern ("version");
  static const long QUARK_PGMNAME = zone.intern ("program-name");
  static const long QUARK_LIBRARY = zone.intern ("library");
  static const long QUARK_SETMDBG = zone.intern ("set-memory-debug");
  static const long QUARK_SETMLBL = zone.intern ("set-memory-label");

  // return true if the given quark is defined

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

  // evaluate an object in this interpreter

  Object* Interp::eval (Object* object) {
    if (object == nilp) return nilp;
    rdlock ();
    try {
      Object* result = object->eval (this, p_gset);
      post (result);
      unlock ();
      return result;
    } catch (...) {
      unlock ();
      throw;
    }
  }

  // evaluate an interpreter method by quark

  Object* Interp::eval (Runnable* robj, Nameset* nset, const long quark) {
    // standard builtin name
    if (quark == QUARK_URI)     return new String (System::geturi  ());
    if (quark == QUARK_MACHS)   return new String (System::machs   ());
    if (quark == QUARK_MAJOR)   return new String (System::major   ());
    if (quark == QUARK_MINOR)   return new String (System::minor   ());
    if (quark == QUARK_PATCH)   return new String (System::patch   ());
    if (quark == QUARK_OSTYPE)  return new String (System::ostype  ());
    if (quark == QUARK_OSNAME)  return new String (System::osname  ());
    if (quark == QUARK_VERSION) return new String (System::version ());
    if (quark == QUARK_PGMNAME) return new String (System::getpgm  ());
    if (quark == QUARK_ARGV) {
      Object* result = p_argv;
      post (result);
      return result;
    }
    if (quark == QUARK_RSLV) {
      Object* result = p_rslv;
      post (result);
      return result;
    }
    if (quark == QUARK_LOADER) {
      Object* result = p_shld;
      post (result);
      return result;
    }
    // look the object
    return Object::eval (robj, nset, quark);
  }

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

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

    // special case for library with any arguments
    if ((quark == QUARK_LIBRARY) && (argc > 0)) {
      String lname = argv->getstring (0);
      return library (lname, argv);
    }

    // check for 0 argument
    if (argc == 0) {
      if (quark == QUARK_ROLL)    return new Boolean (loop (p_gset, p_is));
      if (quark == QUARK_GETPP)   return new String  (getpp ());
      if (quark == QUARK_GETSP)   return new String  (getsp ());
      if (quark == QUARK_GETAEPS) return new Real    (Real::d_aeps);
      if (quark == QUARK_GETREPS) return new Real    (Real::d_reps);
      if (quark == QUARK_WAIT) {
	Thread::wall ();
	return nilp;
      }
      if (quark == QUARK_GETIS) {
	wrlock ();
	try {
	  Object* result = getis ();
	  post (result);
	  unlock ();
	  return result;
	} catch (...) {
	  unlock ();
	  throw;
	}
      }
      if (quark == QUARK_GETOS) {
	wrlock ();
	try {
	  Object* result = getos ();
	  post (result);
	  unlock ();
	  return result;
	} catch (...) {
	  unlock ();
	  throw;
	}
      }
      if (quark == QUARK_GETES) {
	wrlock ();
	try {
	  Object* result = getes ();
	  post (result);
	  unlock ();
	  return result;
	} catch (...) {
	  unlock ();
	  throw;
	}
      }
      if (quark == QUARK_DUP){
	Terminal* term = nilp;
	return dup (term);
      }
    }

    // check for 1 argument
    if (argc == 1) {
      if (quark == QUARK_WAIT) {
	String tgn = argv->getstring (0);
	Thread::wall (tgn);
	return nilp;
      }
      if (quark == QUARK_SETAEPS) {
	Real::d_aeps = argv->getreal (0);
	return nilp;
      }
      if (quark == QUARK_SETREPS) {
	Real::d_reps = argv->getreal (0);
	return nilp;
      }
      if (quark == QUARK_LOAD) {
	String name = argv->getstring (0);
	load (name);
	return nilp;
      }
      if (quark == QUARK_LAUNCH) {
	Object* form = argv->get(0);
	Object* result = this->launch (form);
	return result;
      }
      if (quark == QUARK_DUP) {
	Object*    obj = argv->get (0);
	Terminal* term = dynamic_cast <Terminal*> (obj);
	if (term == nilp) {
	  throw Exception ("type-error", "invalid terminal object",
			   Object::repr (obj));
	}
	return dup (term);
      }
      if (quark == QUARK_SETPP) {
        String val = argv->getstring (0);
        setpp (val);
        return nilp;
      }
      if (quark == QUARK_SETSP) {
        String val = argv->getstring (0);
        setsp (val);
        return nilp;
      }
      if (quark == QUARK_SETMDBG) {
        bool flag = argv->getbool (0);
        Object::setmdbg (flag);
        return nilp;
      }
      if (quark == QUARK_SETMLBL) {
        String label = argv->getstring (0);
        Object::setmlbl (label);
        return nilp;
      }
    }
    // check for 2 arguments
    if (argc == 2) {
      if (quark == QUARK_DUP) {
	// get the input stream
	Object* iobj = argv->get (0);
	InputStream* is = dynamic_cast <InputStream*> (iobj);
	if (is == nilp) {
	  throw Exception ("type-error", "invalid input stream object",
			   Object::repr (iobj));
	}
	// get the output/error stream
	Object* oobj = argv->get (1);
	OutputStream* os = dynamic_cast <OutputStream*> (oobj);
	if (os == nilp) {
	  throw Exception ("type-error", "invalid output stream object",
			   Object::repr (oobj));
	}
	return dup (is, os, os);
      }
    }
    // check for 3 arguments
    if (argc == 3) {
      if (quark == QUARK_DUP) {
	// get the input stream
	Object* iobj = argv->get (0);
	InputStream* is = dynamic_cast <InputStream*> (iobj);
	if (is == nilp) {
	  throw Exception ("type-error", "invalid input stream object",
			   Object::repr (iobj));
	}
	// get the output stream
	Object* oobj = argv->get (1);
	OutputStream* os = dynamic_cast <OutputStream*> (oobj);
	if (os == nilp) {
	  throw Exception ("type-error", "invalid output stream object",
			   Object::repr (oobj));
	}
	// get the error stream
	Object* eobj = argv->get (2);
	OutputStream* es = dynamic_cast <OutputStream*> (eobj);
	if (es == nilp) {
	  throw Exception ("type-error", "invalid error stream object",
			   Object::repr (eobj));
	}
	return dup (is, os, es);
      }
    }
    // call the object method
    return Object::apply (robj, nset, quark, argv);
  }
}
