+ try {
+ result = eval_terms (domain, args, 1, out caught);
+ } catch (System.Exception exception) {
+ Term term;
+
+ Error e = exception as Error;
+ if (e != null)
+ term = new Term (new ErrorTerm (e.Name, e.Message, e.Stack));
+ else
+ term = new Term (new ErrorTerm (exception));
+ if (! args[0].Matches (term))
+ throw exception;
+ if (vari != null)
+ vari.SetValue (term);
+ return One;
+ }
+ }
+ else if (args[0].IsSymbol)
+ {
+ try {
+ domain.Catch (new CatchTag (args[0].Symval));
+ result = eval_terms (domain, args, 1, out caught);
+ if (caught)
+ {
+ if (vari != null)
+ vari.SetValue (result);
+ return One;
+ }
+ return Zero;
+ } finally {
+ domain.Uncatch ();
+ }
+ }
+ throw new Error (Error.WrongArgument,
+ "Not a symbol nor an error: {0}", args[0]);
+ }
+
+ public static Term Fthrow (Domain domain, Variable vari, Term[] args)
+ {
+ if (args[0].IsSymbol)
+ {
+ domain.ThrowSymbol (args[0]);
+ return (args[args.Length - 1]);
+ }
+ if (args[0].IsError)
+ {
+ ErrorTerm err = (ErrorTerm) args[0].objval;
+ throw new Error (err.ErrorName, err.ErrorMessage);
+ }
+ throw new Error (Error.WrongArgument,
+ "Not a symbol nor an error: {0}", args[0]);
+ }
+
+ public abstract class TermValue
+ {
+ public virtual Term Eval (Domain domain) { return new Term (this); }
+ public virtual TermValue Clone () { return this; }
+ public virtual bool IsTrue { get { return true; } }
+ public virtual bool Matches (TermValue other) { return Equals (other); }
+ public override abstract bool Equals (object obj);
+ public override abstract int GetHashCode ();
+ public virtual string ToString (bool detail) { return ToString (); }
+ }
+
+ private class Varref : TermValue
+ {
+ private static Symbol name = "varref";
+ public static Symbol Name { get { return name; } }
+
+ private Symbol vname;
+ private Variable vari;
+
+ public Varref (Symbol vname) { this.vname = vname; }
+
+ public override Term Eval (Domain domain)
+ {
+ if (vari == null || vari.domain != domain)
+ vari = domain.GetVarCreate (vname);
+ return vari.Value;
+ }
+
+ public static TermValue Parser (Domain domain, XmlNode node)
+ {
+ return new Varref ((Symbol) node.Attributes[Qvname].Value);
+ }
+
+ public override bool Equals (object obj)
+ {
+ Varref varref = obj as Varref;
+ return (varref != null && varref.vari.name == vari.name);
+ }
+
+ public override int GetHashCode ()
+ {
+ return vari.name.GetHashCode ();
+ }
+
+ public override string ToString () { return ToString (true); }
+
+ public override string ToString (bool detail)
+ {
+ return "<varref vname=\"" + vname + "\"/>";
+ }
+ }
+
+ private class Funcall : TermValue
+ {
+ private static Symbol name = "funcall";
+ public static Symbol Name { get { return name; } }
+ private static Term[] null_args = new Term[0];
+
+ internal Function func;
+ internal Variable vari;
+ internal Term[] args;
+
+ public Funcall (Function func, Variable vari, Term[] args)
+ {
+ if (args == null)
+ args = null_args;
+ int nargs = args.Length;
+ if (nargs < func.min_args
+ || (func.max_args >= 0 && nargs > func.max_args))
+ throw new Error (Error.WrongArgument,
+ "Wrong number of arguments to {0}: {1}",
+ func.name, nargs);
+ if (! func.with_var && vari != null)
+ throw new Error (Error.WrongArgument,
+ "Wrong vname attribute to {0}: {1}",
+ func.name, vari.name);
+ this.func = func;
+ this.vari = vari;
+ this.args = args;
+ }
+
+ public static TermValue Parser (Domain domain, XmlNode node)
+ {
+ Symbol fname = node.Name;
+ XmlAttribute attr;
+
+ if (fname == Qfuncall)
+ fname = node.Attributes[Qfname].Value;
+ Function func = domain.GetFunc (fname);
+ Variable vari;
+ attr = node.Attributes[Qvname];
+ vari = attr == null ? null : domain.GetVarCreate (attr.Value);
+ XmlNodeList nlist = node.ChildNodes;
+ int nargs = nlist.Count;
+ Term[] args = new Term[nargs];
+ for (int i = 0; i < nargs; i++)
+ args[i] = Parse (domain, nlist[i]);
+ return new Funcall (func, vari, args);
+ }
+
+ public override Term Eval (Domain domain)
+ {
+ Term result;
+ domain.TraceWrite (ToString ());
+ try {
+ domain.depth++;
+ result = func.Call (domain, vari, args);
+ } finally {
+ domain.depth--;
+ }
+ domain.TraceWrite ("=> {0}", result.ToString ());
+ return result;
+ }
+
+ public override TermValue Clone ()
+ {
+ return new Funcall (func, vari, args);
+ }
+
+ public override bool Equals (object obj)
+ {
+ Funcall funcall = obj as Funcall;
+ return (obj != null
+ && funcall.func == func
+ && funcall.vari == vari
+ && funcall.args.Length == args.Length);
+ }
+
+ public override int GetHashCode ()
+ {
+ return func.GetHashCode () ^ args.Length;
+ }
+
+ public override string ToString () { return ToString (true); }
+
+ public override string ToString (bool detail)
+ {
+ string str = "<" + func.name;
+ if (vari != null)
+ {
+ str += " vname=\"" + vari.name + "\"";
+ if (detail)
+ str += " val=" + vari.Value.ToString ();
+ }
+ if (args.Length == 0 || ! detail)
+ return str + "/>";
+ str += ">";
+ if (func is Function.SpecialForm)
+ {
+ for (int i = 0; i < args.Length; i++)
+ str += ".";
+ }
+ else
+ foreach (Term e in args)
+ str += e;
+ return (str + "</" + func.name + ">");
+ }
+ }
+
+ internal class ErrorTerm : TermValue
+ {
+ private static Symbol name = "error";
+ public static Symbol Name { get { return name; } }
+
+ private readonly Symbol ename;
+ public Symbol ErrorName { get { return ename; } }
+ private string message;
+ public string ErrorMessage { get { return message; } }
+ private Term[] stack;
+
+ public ErrorTerm (Symbol ename, string message)
+ : this (ename, message, null) { }
+
+ internal ErrorTerm (Symbol ename, string message, Term[] stack)
+ {
+ this.ename = ename;
+ this.message = message;
+ this.stack = stack;
+ }
+
+ internal ErrorTerm (Exception e)
+ {
+ if (e is ArithmeticException)
+ ename = Error.ArithmeticError;
+ else if (e is IndexOutOfRangeException)
+ ename = Error.IndexOutOfRange;
+ else if (e is InsufficientMemoryException
+ || e is OutOfMemoryException)
+ ename = Error.MemoryError;
+ else
+ ename = Error.UnknownError;
+ message = e.Message;
+ }
+
+ public static TermValue Parser (Domain domain, XmlNode node)
+ {
+ XmlAttribute attr = node.Attributes[Qename];
+ Symbol ename = attr == null ? Qnull : (Symbol) attr.Value;
+ string message = node.InnerText;
+ return new ErrorTerm (ename, message);
+ }
+
+ public Term[] CallStack {
+ get { return stack; }
+ internal set { stack = value; }
+ }
+
+ public override TermValue Clone ()
+ {
+ return new ErrorTerm (ename, message);
+ }
+
+ public override bool Equals (object obj)
+ {
+ ErrorTerm e = obj as ErrorTerm;
+ return (e != null && e.ename == ename && e.message == message
+ && (e.stack == null ? stack == null
+ : (stack != null && e.stack.Length == stack.Length)));
+ }
+
+ public override int GetHashCode ()
+ {
+ return ename.GetHashCode ();
+ }
+
+ public override bool Matches (TermValue term)
+ {
+ ErrorTerm e = term as ErrorTerm;
+ return (e != null && (ename == Qnull || e.ename == ename));
+ }
+
+ public override string ToString () { return ToString (true); }
+
+ public override string ToString (bool detail)
+ {
+ string str = "<error type=\"" + ename + "\">";
+ if (message != null)
+ str += message;
+ if (stack != null)
+ for (int i = 0; i < stack.Length; i++)
+ str += stack[i].ToString (false);
+ return str + "</error>";
+ }
+ }
+
+ public class Str
+ {
+ private string str;
+ private Regex regex;
+
+ public Str (string str) { this.str = str; }
+
+ public Str Clone (Str str) { return new Str (str.str); }
+
+ public bool Equals (string str) { return this.str == str; }
+
+ public bool Equals (Str str) { return this.str == str.str; }
+
+ public bool Matches (Str str)
+ {
+ if (regex != null)
+ regex = new Regex (this.str);
+ return regex.IsMatch (str.str);
+ }
+
+ public int Nth (int index) { return (int) str[index]; }
+
+ public void Insert (int index, Str str)
+ {
+ if (index < 0)
+ this.str = this.str + str.str;
+ else
+ this.str = this.str.Insert (index, str.str);
+ regex = null;
+ }
+
+ public void Insert (int index, char c)
+ {
+ if (index < 0)
+ this.str = this.str + c;
+ else
+ this.str = this.str.Insert (index, new string (c, 1));
+ regex = null;
+ }
+
+ public void Delete (int from, int to)
+ {
+ this.str = this.str.Remove (from, to - from);
+ regex = null;
+ }
+
+ public override string ToString () { return str; }
+ }
+
+ /// <summary> Structure of term object.</summary>
+ public struct Term
+ {
+ internal int intval;
+ internal object objval;
+
+ /// <summary>Create an integer term.</summary>
+ /// <param name='i'>Integer value of the term.</param>
+ /// <returns>An integer term.</returns>
+ /// <remarks>Create an integer term that has the integer value
+ /// specified by <paramref name="i"/>. This is an constant
+ /// term; i.e. the integer value never changes.</remarks>
+ public Term (int i) { intval = i; objval = null; }
+
+ /// <summary>Create a symbol term.</summary>
+ /// <param name='name'>Symbol value of the term.</param>
+ /// <returns>A symbol term.</returns>
+ /// <remarks>Create a symbol term that has the symbol value
+ /// specified by <paramref name="name"/>. This is an constant
+ /// term; i.e. the symbol value never changes. It is evaluated
+ /// to itself.</remarks>
+ public Term (Symbol name) { intval = 0; objval = name; }
+
+ /// <summary>Create a string term.</summary>
+ /// <param name='str'>String value of the term.</param>
+ /// <returns>A string term.</returns>
+ /// <remarks>Create a string term that has the string value
+ /// specified by <paramref name="str"/>. It is evaluated to
+ /// itself. The string value can be modified by "ins", "del",
+ /// and "concat" functions.</remarks>
+ public Term (string str) { intval = 0; objval = new Str (str); }
+ // <list>...</list>
+
+ /// <summary>Create a list term.</summary>
+ /// <param name='list'>List value of the term.</param>
+ /// <returns>A list term.</returns>
+ /// <remarks>Create a list term that has the list value
+ /// specified by <paramref name="list"/>. It is evaluated to
+ /// itself. The list value can be modified by "ins", "del", and
+ /// "append" functions.</remarks>
+ public Term (List<Term> list) { intval = 0; objval = list; }
+ // <error ename="ERROR-NAME">ERROR-MESSASGE</error>
+
+ /// <summary>Create an error term.</summary>
+ /// <param name='name'>Name of the error.</param>
+ /// <param name='message'>Error message.</param>
+ /// <returns>An error term.</returns>
+ /// <remarks>Create an error term whose error name is <paramref
+ /// name="name"/> and error message is <paramref
+ /// name="message"/>. It is evaluated to itself.</remarks>
+ public Term (Symbol name, string message)
+ {
+ intval = 0;
+ objval = new ErrorTerm (name, message);
+ }
+
+ /// <summary>Create a term of a specific value</summary>
+ /// <param name='val'>Value of the term.</param>
+ /// <returns>A term.</returns>
+ /// <remarks>Create a term whose value is <paramref name="val">.
+ /// It is evaluated to a term that is returned by "Eval" method
+ /// of <paramref name="val">.</remarks>
+ public Term (TermValue val) { intval = 0; objval = val; }
+
+ internal Term (Str str) { intval = 0; objval = str; }
+
+ /// <summary>Create a varref term.</summary>
+ /// <param name='domain'>Domain to create the term in.</param>
+ /// <param name='vname'>Name of the referred variable.</param>
+ /// <returns>A varref term.</returns>
+ /// <remarks>Create a varref term that is evaluated to the value
+ /// of the referring variable.</remarks>
+ public Term (Domain domain, Symbol vname)
+ {
+ intval = 0;
+ objval = new Varref (vname);
+ }
+
+ /// <summary>Create a funcall term.</summary>
+ /// <param name='domain'>Domain to create the term in.</param>
+ /// <param name='fname'>Name of the calling function.</param>
+ /// <param name='args'>Array of terms that are given to the
+ /// function as arguments.</param>
+ /// <returns>A funcall term.</returns>
+ /// <remarks>Create a funcall term that is evaluated to a term
+ /// returned by the function <paramref name="fname"> when called
+ /// with <paramref name="args">.<remarks>
+ public Term (Domain domain, Symbol fname, Term[] args)
+ : this (domain, fname, Qnull, args) { }
+
+ // <funcall fname="FNAME" vname="VNAME">...</funcall>
+ public Term (Domain domain, Symbol fname, Symbol vname, Term[] args)
+ {
+ intval = 0;
+
+ Function func = domain.GetFunc (fname);
+ Variable vari = vname == Qnull ? null : domain.GetVarCreate(vname);
+ Funcall funcall = new Funcall (func, vari, args);
+ if (func is Function.Macro)
+ {
+ Term result = funcall.Eval (domain);
+ intval = result.intval;
+ objval = result.objval;
+ }
+ else
+ objval = funcall;
+ }
+
+ public object Objval {
+ get {
+ if (objval == null)
+ throw new Error (Error.WrongType,
+ "term is an integer: {0}", this);
+ return objval;
+ }
+ }
+
+ public int Intval {
+ get {
+ if (objval != null)
+ throw new Error (Error.WrongType, "{0} is not an integer", this);
+ return intval;
+ }
+ }
+
+ public Str Strval {
+ get {
+ if (! IsStr)
+ throw new Error (Error.WrongType, "{0} is not a string", this);
+ return (Str) objval;
+ }
+ }
+
+ public string Symval {
+ get {
+ if (! IsSymbol)
+ throw new Error (Error.WrongType, "{0} is not a symbol", this);
+ return (Symbol) objval;
+ }
+ }
+
+ public List<Term> Listval {
+ get {
+ if (! IsList)
+ throw new Error (Error.WrongType, "{0} is not a list");
+ return (List<Term>) objval;
+ }
+ }
+
+ public bool IsTrue {
+ get {
+ return (objval == null
+ ? (intval != 0)
+ : objval is List<Term>
+ ? (((List<Term>) objval).Count != 0)
+ : objval is TermValue
+ ? ((TermValue) objval).IsTrue
+ : true);
+ }
+ }
+
+ public bool IsInt { get { return (objval == null); } }
+ public bool IsStr { get { return (objval is Str); } }
+ public bool IsSymbol { get { return (objval is Symbol); } }
+ public bool IsList { get { return (objval is List<Term>); } }
+ public bool IsError { get { return (objval is ErrorTerm); } }
+
+ internal Term Eval (Domain domain)
+ {
+ if (objval == null || objval is Symbol || objval is Str
+ || objval is List<Term>)
+ return this;
+ try {
+ domain.CallStackPush (this);
+ return ((TermValue) objval).Eval (domain);
+ } catch (Error e) {
+ if (e.Stack == null)
+ e.Stack = domain.CallStack;
+ throw e;
+ } finally {
+ domain.CallStackPop ();
+ }
+ }
+
+ public Term Clone ()
+ {
+ if (objval == null || objval is Symbol)
+ return this;
+ if (objval is Str)
+ return new Term (((Str) objval).ToString ());
+ if (objval is List<Term>)
+ {
+ List<Term> list = new List<Term> ();
+ list.InsertRange (0, ((List<Term>) objval));
+ return new Term (list);
+ }
+ return new Term (((TermValue) objval).Clone ());
+ }
+
+ public static bool operator== (Term t1, Term t2)
+ {
+ return t1.Equals (t2);
+ }
+
+ public static bool operator!= (Term t1, Term t2) { return ! (t1 == t2); }
+
+ public override bool Equals (object obj)
+ {
+ if (! (obj is Term))
+ return false;
+ Term term = (Term) obj;
+ if (IsInt)
+ return term.IsInt && term.Intval == Intval;
+ if (IsSymbol)
+ return term.IsSymbol && term.Symval == Symval;
+ if (IsStr)
+ return (term.IsStr && term.Strval.Equals (Strval));
+ if (IsList)
+ {
+ if (! term.IsList)
+ return false;
+ List<Term> l1 = objval as List<Term>;
+ List<Term> l2 = term.objval as List<Term>;
+
+ if (l1.Count != l2.Count)
+ return false;
+ for (int i = 0; i < l1.Count; i++)
+ if (! l1[i].Equals (l2[i]))
+ return false;
+ return true;
+ }
+ return ((TermValue) objval).Equals (obj);
+ }
+
+ public override int GetHashCode () { return intval; }
+
+ public bool Matches (Term term)
+ {
+ if (IsInt)
+ return term.IsInt && Intval == term.Intval;
+ if (IsSymbol)
+ return term.IsSymbol && Symval == term.Symval;
+ if (IsStr)
+ return term.IsStr && Strval.Matches (term.Strval);
+ if (IsList)
+ {
+ if (! term.IsList)
+ return false;
+ List<Term> l1 = objval as List<Term>;
+ List<Term> l2 = term.objval as List<Term>;
+
+ if (l1.Count > l2.Count)
+ return false;
+ for (int i = 0; i < l1.Count; i++)
+ if (! l1[i].Equals (l2[i]))
+ return false;
+ return true;
+ }
+ return ((TermValue) objval).Matches ((TermValue) term.objval);
+ }
+
+ public override string ToString () { return ToString (true); }
+
+ public string ToString (bool detail)
+ {
+ string str;
+
+ if (objval == null)
+ str = "<integer>" + intval + "</integer>";
+ else if (objval is Symbol)
+ str = "<symbol>" + objval + "</symbol>";
+ else if (objval is Str)
+ str = "<string>" + objval + "</string>";
+ else if (objval is List<Term>)
+ {
+ if (detail)
+ {
+ str = "<list>";
+ foreach (Term e in (List<Term>) objval)
+ str += e;
+ str += "</list>";
+ }
+ else
+ str = "<list/>";
+ }
+ else if (objval is Term)
+ str = "<quote>" + objval + "</quote>";
+ else
+ str = ((TermValue) objval).ToString (detail);
+ return str;
+ }
+ }
+
+ private static Term Zero = new Term (0);
+ private static Term One = new Term (1);
+ private static Term TermInt = new Term (Qinteger);
+ private static Term TermStr = new Term (Qstring);
+ private static Term TermSymbol = new Term (Qsymbol);
+ private static Term TermList = new Term (Qlist);
+ private static Term TermTerm = new Term ((Symbol) "term");
+
+ private static int parse_integer (XmlNode node)
+ {
+ string str = node.InnerText;
+ int len = str.Length;
+ int i, c;
+
+ if (len == 2 && str[0] == '?')
+ return str[1];
+ if (len > 2
+ && str[1] == 'x' && ((c = str[0]) == '0' || c == '#'))