// ---------------------------------------------------------------------------
// - 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-2008 amaury darsch                                   -
// ---------------------------------------------------------------------------

#include "Set.hpp"
#include "Enum.hpp"
#include "Byte.hpp"
#include "Real.hpp"
#include "Meta.hpp"
#include "List.hpp"
#include "Heap.hpp"
#include "Queue.hpp"
#include "Mutex.hpp"
#include "Regex.hpp"
#include "Plist.hpp"
#include "Thread.hpp"
#include "Logger.hpp"
#include "Interp.hpp"
#include "Return.hpp"
#include "Reader.hpp"
#include "Module.hpp"
#include "System.hpp"
#include "Method.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 "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"

namespace afnix {

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

  // this procedure initialize the interpreter global nameset
  static void gset_init (Interp* interp) {
    // initialize the global set
    Nameset* nset = interp->getgset ();

    // bind standard constants
    nset->symcst  ("...",           nset);
    nset->symcst  ("nil",           (Object*) nilp);
    nset->symcst  ("true",          new Boolean (true));
    nset->symcst  ("false",         new Boolean (false));
    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 ("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 ("daemon",        new Function (builtin_daemon));
    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 ("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 ("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 ("string-p",      new Function (builtin_strp));
    interp->mkrsv ("thread-p",      new Function (builtin_thrp));
    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 ("logger-p",      new Function (builtin_logp));
    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 ("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));

    // 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 ("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 ("Vector",        new Meta (Vector::mknew));
    interp->mkrsv ("BitSet",        new Meta (BitSet::mknew));
    interp->mkrsv ("Symbol",        new Meta (Symbol::mknew));
    interp->mkrsv ("Logger",        new Meta (Logger::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 ("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));
  }

  // -------------------------------------------------------------------------
  // - 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 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";

  // 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', "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, 'v', V_OPT_MSG);
    opts->add (Options::UNIQ, 'h', H_OPT_MSG);

    // set the debug flag and return
    opts->setdbg ('f', "assert");
    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);
    gset_init (this);
    // create the execution stack
    p_stk = new Stack;
    // reset the runnable form
    p_rform = nilp;
    // create the library loader
    Object::iref (p_shld = new Loader);
    // bind the main thread
    Thread::setrobj (this);
  }

  // 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);
    gset_init (this);
    // create the execution stack
    p_stk = new Stack;
    // reset the runnable form
    p_rform = nilp;
    // create the libary loader
    Object::iref (p_shld = new Loader);
    // bind the main thread
    Thread::setrobj (this);
  }

  // create a new interpreter with the specified streams

  Interp::Interp (Input* is, Output* os, Output* 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);
    gset_init (this);
    // create the execution stack
    p_stk = new Stack;
    // reset the runnable form
    p_rform = nilp;
    // create the libary loader
    Object::iref (p_shld = new Loader);
    // bind the main thread
    Thread::setrobj (this);
  }

  // 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);
    // create the execution stack
    p_stk = new Stack;
    // 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);
    // clean the rest
    delete p_stk;
  }

  // return the class name

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

  // 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;
  }

  // clone this interpreter

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

  // 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 withthe associated stream

  Interp* Interp::dup (Input* is, Output* os, Output* 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;
  }

  // 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;
  }

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

  Object* Interp::launch (Object* form) {
    // duplicate the interpreter
    Interp* interp = dup (form);
    // create a new thread
    return new Thread (Thread::NORMAL, interp);
  }

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

  Object* Interp::daemon (Object* form) {
    // duplicate the interpreter
    Interp* interp = dup (form);
    // create a new thread
    return new Thread (Thread::DAEMON, interp);
  }

  // return the interpreter input stream

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

  // return the interpreter output stream

  Output* Interp::getos (void) const {
    wrlock ();
    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;
  }
  
  // return the interpreter error stream

  Output* Interp::getes (void) const {
    wrlock ();
    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;
  }

  // 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->Input::setemod  (emod);
      if (p_term != nilp) p_term->Output::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;
    }
  }

  // return the interpreter stack

  Stack* Interp::getstk (void) const {
    return p_stk;
  }

  // return the interpreter global nameset

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

  // set the assert flag

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

  // return the assert flag

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

  // 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->append (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;
    }
  }

  // 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;
    }
  }
  
  // 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;
    }
  }

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

  // return the next flag

  bool Interp::getnext (void) const {
    rdlock ();
    bool result = d_next;
    unlock ();
    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 other threads, this does nothing
    Thread::waitall ();
    return status;
  }

  // loop on the standard input in a nameset context

  bool Interp::loop (Nameset* nset, Input* is) {
    // initialize the status
    bool status = true;
    // create a new reader 
    Reader* rd = new Reader (is);
    // loop until we have an eof
    while (true) {
      Form* form = nilp;
      try {
	form = rd->parse ();
	if (form == nilp) break;
	Object::cref (form->eval (this, p_gset));
	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::waitall ();
    return status;
  }

  // loop with an input file by doing a read-eval loop - no thread wait
  
  void Interp::load (const String& fname) {
    // try to open the module
    Input*  ms = p_rslv->alplkp  (fname);
    String  mn = p_rslv->alpname (fname);
    Module* mp = new Module (ms, mn);
    // get the interpreter encoding/transcoding modes
    if (ms != nilp) {
      // set encoding mode
      if (p_is == nilp) {
	ms->settmod (System::getstm ());
	ms->setemod (System::getsem ());
      } else {
	ms->settmod (p_is->gettmod ());
	ms->setemod (p_is->getemod ());
      }
      // eventually overwrite it
      ms->setemod (d_emod);
    }
    // loop until we have an eof
    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 ());
	delete mp;
	throw;
      } catch (const Return& r) {
	Object::dref (form);
	this->post (r.getobj ());
      } catch (...) {
	Object::dref (form);
	delete mp;
	throw;
      }
    }
    // clean the module
    delete mp;
  }

  // compile from an input stream into an output stream
  
  void Interp::compile (const String& name, Output& os) {
    // try to open the module and write
    Input*  ms = p_rslv->lookup  (name);
    String  mn = p_rslv->getpath (name);
    Module* mp = new Module (ms, mn);
    // get the interpreter encoding/transcoding modes
    if (ms != nilp) {
      // set the encoding mode
      if (p_is == nilp) {
	ms->settmod (System::getstm ());
	ms->setemod (System::getsem ());
      } else {
	ms->settmod (p_is->gettmod ());
	ms->setemod (p_is->getemod ());
      }
      // eventually overwrite it
      ms->setemod (d_emod);
    }
    try {
      mp->write (os);
    } catch (const Exception& e) {
      Integer line = mp->getlnum ();
      String  msg  = name + ':' + line.tostring ();
      delete mp;
      throw Exception (msg, e.getval ());
    }
  }

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

  // the quark zone
  static const long QUARK_ZONE_LENGTH = 27;
  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_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_DAEMON  = zone.intern ("daemon");
  static const long QUARK_OSNAME  = zone.intern ("os-name");
  static const long QUARK_OSTYPE  = zone.intern ("os-type");
  static const long QUARK_GETEPS  = zone.intern ("get-epsilon");
  static const long QUARK_SETEPS  = zone.intern ("set-epsilon");
  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");

  // 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_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_GETEPS) return new Real    (Real::d_eps);
      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_SETEPS) {
	Real::d_eps = 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_DAEMON) {
	Object* form = argv->get(0);
	Object* result = this->daemon (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;
      }
    }
    // check for 2 arguments
    if (argc == 2) {
      if (quark == QUARK_DUP) {
	// get the input stream
	Object* iobj = argv->get (0);
	Input*    is = dynamic_cast <Input*> (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);
	Output*   os = dynamic_cast <Output*> (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);
	Input*    is = dynamic_cast <Input*> (iobj);
	if (is == nilp) {
	  throw Exception ("type-error", "invalid input stream object",
			   Object::repr (iobj));
	}
	// get the output stream
	Object* oobj = argv->get (1);
	Output*   os = dynamic_cast <Output*> (oobj);
	if (os == nilp) {
	  throw Exception ("type-error", "invalid output stream object",
			   Object::repr (oobj));
	}
	// get the error stream
	Object* eobj = argv->get (2);
	Output*   es = dynamic_cast <Output*> (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);
  }
}
