// ---------------------------------------------------------------------------
// - 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-2007 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 "Instance.hpp"
#include "Librarian.hpp"
#include "Function.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 ("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";
}
// make this interpreter a shared object
void Interp::mksho (void) {
if (p_shared != nilp) return;
Object::mksho ();
if (p_term != nilp) p_term->mksho ();
if (p_is != nilp) p_is->mksho ();
if (p_os != nilp) p_os->mksho ();
if (p_es != nilp) p_es->mksho ();
if (p_argv != nilp) p_argv->mksho ();
if (p_rslv != nilp) p_rslv->mksho ();
if (p_gset != nilp) p_gset->mksho ();
if (p_shld != nilp) p_shld->mksho ();
}
// 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) {
// mark everything shared
mksho ();
// make the form a shared object
if (form != nilp) form->mksho ();
// create a new thread
Interp* interp = dup (form);
return new Thread (Thread::NORMAL, interp);
}
// execute a form in a daemon thread by cloning this interpreter
Object* Interp::daemon (Object* form) {
// mark everything shared
mksho ();
// make the form a shared object
if (form != nilp) form->mksho ();
// create a new thread
Interp* interp = dup (form);
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);
}
}
syntax highlighted by Code2HTML, v. 0.9.1