using System.Collections.Generic;
using System.IO;
using System.Reflection;
+using System.Text;
using System.Xml;
namespace System.Xml
set { trace_depth = value; }
}
- public class Error : System.Exception
+ public class Error : Exception
{
- // All time errors.
- // System.OutOfMemoryException or System.InsufficientMemoryException
- public static Symbol MemoryError = "memory-error";
- // System.Exception
- public static Symbol UnknownError = "unknown-error";
- public static Symbol WrongArgument = "wrong-argument";
-
- // Load time errors.
- public static Symbol InvalidInteger = "invalid-integer";
- public static Symbol TermTypeInvalid = "term-type-invalid";
- public static Symbol FunctionConflict = "function-conflict";
- public static Symbol VariableTypeConfclit = "variable-type-conflict";
- public static Symbol VariableRangeConfclit = "variable-range-conflict";
- public static Symbol VariableWrongRange = "variable-wrong-range";
- public static Symbol VariableWrongValue = "variable-wrong-value";
- public static Symbol UnknownFunction = "unknown-function";
- public static Symbol MacroExpansionError = "macro-expansion-error";
- public static Symbol NoVariableName = "no-variable-anme";
-
- // Run time errors.
- public static Symbol ArithmeticError = "arithmetic-error";
- public static Symbol WrongType = "wrong-type";
- public static Symbol IndexOutOfRange = "index-out-of-range";
- public static Symbol ValueOutOfRange = "value-out-of-range";
- public static Symbol NoLoopToBreak = "no-loop-to-break";
- public static Symbol UncaughtThrow = "uncaught-throw";
-
private readonly Symbol name;
private Term[] stack;
private XmlNode node;
- public Error (Symbol name, XmlNode node, string fmt, params object[] args)
+ public Error (Symbol name, XmlNode node,
+ string fmt, params object[] args)
: base (String.Format (fmt, args))
{
this.name = name;
this.node = node;
}
+ public Error (Symbol name, XmlNode node, Exception e,
+ string fmt, params object[] args)
+ : base (String.Format (fmt, args), e)
+ {
+ this.name = name;
+ this.node = node;
+ }
+
public Error (Symbol name, string fmt, params object[] args)
: base (String.Format (fmt, args))
{
get { return stack; }
internal set { stack = value; }
}
+
+ public override string ToString ()
+ {
+ string str = (InnerException != null ? InnerException.ToString ()
+ : base.ToString ()) + "\n" + "Xexpression:" + name + "\n";
+ if (node != null)
+ str += " at " + node.OuterXml + "\n";
+ if (stack != null)
+ {
+ str += "Call stack: ";
+ foreach (Term term in stack)
+ str += term.ToString (false);
+ }
+ return str;
+ }
+
+ // All time errors.
+ // System.OutOfMemoryException or System.InsufficientMemoryException
+ public static Symbol MemoryError = "memory-error";
+ // System.Exception
+ public static Symbol UnknownError = "unknown-error";
+ public static Symbol WrongArgument = "wrong-argument";
+
+ // Load time errors.
+ public static Symbol InvalidInteger = "invalid-integer";
+ public static Symbol TermTypeInvalid = "term-type-invalid";
+ public static Symbol FunctionConflict = "function-conflict";
+ public static Symbol VariableTypeConflict = "variable-type-conflict";
+ public static Symbol VariableRangeConflict = "variable-range-conflict";
+ public static Symbol VariableWrongRange = "variable-wrong-range";
+ public static Symbol VariableWrongValue = "variable-wrong-value";
+ public static Symbol UnknownFunction = "unknown-function";
+ public static Symbol MacroExpansionError = "macro-expansion-error";
+ public static Symbol NoVariableName = "no-variable-anme";
+
+ // Run time errors.
+ public static Symbol ArithmeticError = "arithmetic-error";
+ public static Symbol WrongType = "wrong-type";
+ public static Symbol IndexOutOfRange = "index-out-of-range";
+ public static Symbol ValueOutOfRange = "value-out-of-range";
+ public static Symbol NoLoopToBreak = "no-loop-to-break";
+ public static Symbol UncaughtThrow = "uncaught-throw";
}
public struct Symbol : IEquatable<Symbol>
{
private int[] range;
- public void IsSubrange (int[] r)
+ public bool IsSubrange (int[] r)
{
if (range == null)
return true;
{
if (range == null)
return true;
- string str = term.Strval;
+ string str = val.Strval;
foreach (string s in range)
if (str == s)
return true;
{
if (range == null)
return true;
- Symbol sym = term.Symval;
+ Symbol sym = val.Symval;
foreach (Symbol n in range)
if (sym == n)
return true;
for (int i = 0; i < limit; i++)
{
result = args[i].Eval (domain);
- if (domain.Thrown)
+ if (domain.Thrown ())
return result;
domain.Bind (this.args[i], result);
}
if (max_args < 0)
{
List<Term> list = new List<Term> ();
- list.InsertRange (0, args[result].Listval);
+ list.InsertRange (0, args[limit].Listval);
for (int i = 0; i < list.Count; i++)
{
result = list[i].Eval (domain);
- if (domain.Thrown)
+ if (domain.Thrown ())
return result;
list[i] = result;
}
{
Bindings b = new Bindings (vari);
- b.vari.Value = val;
+ b.vari.SetValue (val);
b.next = bindings;
return b;
}
internal Bindings UnboundTo (Bindings boundary)
{
for (Bindings b = this; b != boundary; b = b.next)
- b.vari.Value = b.old_value;
+ b.vari.SetValue (b.old_value);
return boundary;
}
internal struct CatchTag
{
private Term tag;
+ public Term Tag { get { return tag; } }
// Normal symbolic catch-tag.
public CatchTag (Symbol sym) { tag = new Term (sym); }
- // Error catch-tag.
- public CatchTag (Symbol sym, string msg) { tag = new Term (sym, msg); }
- // Error catch-tag.
- public CatchTag (ErrorTerm e) { tag = new Term (e); }
- // Special catch-tag.
+ // Special catch-tag for return and break.
private CatchTag (int i) { tag = new Term (i); }
- public Term Tag { get { return tag; } }
-
public static CatchTag Return = new CatchTag (0);
public static CatchTag Break = new CatchTag (1);
}
= new Dictionary<Symbol, MethodInfo> ();
internal Dictionary<Symbol, Function> functions
= new Dictionary<Symbol, Function> ();
- internal Dictionary<Symbol, Function.Macro> macros
- = new Dictionary<Symbol, Function.Macro> ();
internal Dictionary<Symbol, Variable> variables
= new Dictionary<Symbol, Variable> ();
internal Bindings bindings;
{
termtypes = new Dictionary<Symbol, MethodInfo> (parent.termtypes);
functions = new Dictionary<Symbol, Function> (parent.functions);
- macros = new Dictionary<Symbol, Function.Macro> (parent.macros);
variables = new Dictionary<Symbol, Variable> (parent.variables);
this.context = context;
}
public int CallStackCount { get { return call_stack.Count; } }
- public void CallStackPush (Term term)
- {
- call_stack.Push (term);
- }
+ public void CallStackPush (Term term) { call_stack.Push (term); }
- public void CallStackPop ()
- {
- call_stack.Pop ();
- }
+ public void CallStackPop () { call_stack.Pop (); }
public void CallStackPop (int count)
{
call_stack.Pop ();
}
+ public Term[] CallStack { get { return call_stack.ToArray (); } }
+
internal void Bind (Variable vari, Term value)
{
bindings = Bindings.Bind (bindings, vari, value);
}
}
- internal bool ThrowBreak ()
+ internal void ThrowBreak ()
{
if (catch_stack.Peek ().Tag != CatchTag.Break.Tag)
- return false;
+ throw new Error (Error.NoLoopToBreak,
+ "No surrounding loop to break");
catch_count--;
- return true;
}
internal void ThrowSymbol (Term tag)
{
catch_count--;
if (elt.Tag.Matches (tag))
- break;
+ return;
}
- }
-
- internal Term ThrowError (Term tag)
- {
- tag = tag.Clone ();
- ErrorTerm e = tag.objval as ErrorTerm;
- e.CallStack = call_stack.ToArray ();
-
- foreach (CatchTag elt in catch_stack)
- {
- catch_count--;
- if (elt.Tag.Matches (tag))
- break;
- }
- return tag;
+ throw new Error (Error.UncaughtThrow,
+ "No corresponding catch: {0}", tag);
}
public void DefType (Type type)
throw new Error (Error.TermTypeInvalid,
"No \"name\" field of string type: {0}", type);
Symbol name = (Symbol) finfo.GetValue (null);
- if (termtypes.ContainsKey (name)
- || functions.ContainsKey (name)
- || macros.ContainsKey (name))
+ if (termtypes.ContainsKey (name))
throw new Error (Error.TermTypeInvalid,
"Already defined: {0}", name);
+ if (functions.ContainsKey (name))
+ throw new Error (Error.TermTypeInvalid,
+ "Already defined as a function or a macro: {0}",
+ name);
Type[] types = new Type[] { typeof (Domain), typeof (XmlNode) };
- MethodInfo minfo = type.GetMethod ("Parser", types);
- if (minfo == null || minfo.ReturnType != typeof (TermValue))
- throw new Error ("No \"Parser\" method of correct type: {0}", type);
- termtypes[name] = minfo;
+ MethodInfo parser = type.GetMethod ("Parser", types);
+ if (parser == null || parser.ReturnType != typeof (TermValue))
+ throw new Error (Error.TermTypeInvalid,
+ "No \"Parser\" method of correct type: {0}", type);
+ termtypes[name] = parser;
}
- static void check_func_head (Symbol name, bool with_var,
- int min_args, int max_args)
+ private void check_func_head (Symbol name, bool with_var,
+ int min_args, int max_args, bool as_macro)
{
if (termtypes.ContainsKey (name))
throw new Error (Error.FunctionConflict,
"Already defined as a term type: {0}", name);
- else if (macros.ContainsKey (name))
- throw new Error (Error.FunctionConflict,
- "Already defihed as a macro: {0}", name);
Function func;
- if (functions.TryGetValue (name, out func)
- && (func.with_var != with_var
+ if (functions.TryGetValue (name, out func))
+ {
+ if ((func is Function.Macro) != as_macro)
+ throw new Error (Error.FunctionConflict,
+ "Already defined as a {0}: {1}",
+ as_macro ? "function" : "macro", name);
+ if (func.with_var != with_var
|| func.min_args != min_args
- || func.max_args != max_args))
- throw new Error (Error.FunctionConflict,
- "Conflicting arguments: {0}", name);
+ || func.max_args != max_args)
+ throw new Error (Error.FunctionConflict,
+ "Conflicting arguments: {0}", name);
+ }
}
public void DefSubr (Func<Domain, Variable, Term[], Term> builtin,
Symbol name, bool with_var,
int min_args, int max_args)
{
- check_func_head (name, with_var, min_args, max_args);
+ check_func_head (name, with_var, min_args, max_args, false);
functions[name] = new Function.Subroutine (builtin, name, with_var,
min_args, max_args);
}
Symbol name, bool with_var,
int min_args, int max_args)
{
- check_func_head (name, with_var, min_args, max_args);
+ check_func_head (name, with_var, min_args, max_args, false);
functions[name] = new Function.SpecialForm (builtin, name, with_var,
min_args, max_args);
}
- public void Defun (Symbol name, int min_arg, int max_arg,
+ public void Defun (Symbol name, int min_args, int max_args,
Variable[] args, Term[] body)
{
- check_func_head (name, false, min_args, max_args);
+ check_func_head (name, false, min_args, max_args, false);
functions[name] = new Function.Lambda (name, min_args, max_args,
args, body);
}
functions[func.name] = func;
}
- public void Defmacro (Symbol name, int min_arg, int max_arg,
+ public void Defmacro (Symbol name, int min_args, int max_args,
Variable[] args, Term[] body)
{
- if (termtypes.ContainsKey (name))
- throw new Error (Error.FunctionConflict,
- "Already defined as a term type: {0}", name);
- else if (function.ContainsKey (name))
- throw new Error (Error.FunctionConflict,
- "Already defihed as a function: {0}", name);
- Function.Macro macro;
- if (macros.TryGetValue (name, out macro)
- && (macro.min_args != min_args
- || macro.max_args != max_args))
- throw new Error (Error.FunctionConflict,
- "Conflicting arguments: {0}", name);
- macros[name] = new Function.Macro (name, min_arg, max_arg, args, body);
+ check_func_head (name, false, min_args, max_args, true);
+ functions[name] = new Function.Macro (name, min_args, max_args,
+ args, body);
}
public void DefAlias (Symbol alias, Symbol fname)
{
Function func;
- if (termtypes.TryGetValue (alias, out func))
+ if (termtypes.ContainsKey (alias))
throw new Error (Error.FunctionConflict,
"Alread defined as a term type: {0}", alias);
- if (functions.TryGetValue (alias, out func))
+ if (functions.ContainsKey (alias))
throw new Error (Error.FunctionConflict,
"Alread defined as a function: {0}", alias);
- if (macros.TryGetValue (alias, out func))
- throw new Error (Error.FunctionConflict,
- "Alread defined as a macro: {0}", alias);
if (! functions.TryGetValue (fname, out func))
throw new Error (Error.UnknownFunction, fname);
functions[alias] = func;
{
Variable.Int intvari = vari as Variable.Int;
if (intvari == null)
- throw new Error (Error.VariableTypeConfclit,
+ throw new Error (Error.VariableTypeConflict,
"Not an integer variable: {0}", name);
if (range != null)
{
if (! intvari.IsSubrange (range))
- throw new Error (Error.VariableRangeConfclit,
+ throw new Error (Error.VariableRangeConflict,
"Conflicting variable range: {0}", name);
intvari.Range = range;;
}
internal Function GetFunc (Symbol name)
{
Function func;
-
if (! functions.TryGetValue (name, out func))
throw new Error (Error.UnknownFunction,
"Unknown function: {0}", name);
domain.functions[kv.Key] = kv.Value;
}
- public Variable GetVar (Symbol name, bool create)
+ public Variable GetVar (Symbol name)
{
Variable vari;
if (! variables.TryGetValue (name, out vari))
- {
- if (! create)
- return null;
- variables[name] = vari = new Variable (this, name, Zero);
- }
+ variables[name] = vari = new Variable (this, name, Zero);
return vari;
}
{
foreach (KeyValuePair<Variable,Term> kv
in (Dictionary<Variable,Term>) values)
- kv.Key.Value = kv.Value;
+ kv.Key.SetValue (kv.Value);
}
}
private static Term Fset (Domain domain, Variable vari, Term[] args)
{
if (vari == null)
- throw new Error (Error.NoVariableName, "No variable name to set"));
+ throw new Error (Error.NoVariableName, "No variable name to set");
vari.SetValue (args[0]);
return args[0];
}
{
if (vari == null)
throw new Error (Error.NoVariableName, "No variable name to set");
- Term term = vari.Value;
- if (term.IsStr)
- term.objval = term.Strval.Insert (args[0].Intval, args[1].Strval);
+ if (vari.Value.IsStr)
+ vari.Value
+ = vari.Value.Strval.Insert (args[0].Intval, args[1].Strval);
else if (vari.Value.IsList)
vari.Value.Listval.InsertRange (args[0].Intval, args[1].Listval);
else
throw new Error (Error.WrongType, "Not a string nor a list: {0}",
vari.Value);
- return term;
+ return vari.Value;
}
private static Term Fdel (Domain domain, Variable vari, Term[] args)
private static Term Fbreak (Domain domain, Variable vari, Term[] args)
{
- if (! domain.ThrowBreak ())
- return domain.ThrowError (new Term (Error.NoLoopToBreak, null));
+ domain.ThrowBreak ();
return args.Length == 0 ? Zero : args[0];
}
{
try {
result = eval_terms (domain, args, 1, out caught);
- } catch (Error e) {
- if (! args[0].Matches (e.ErrorTerm))
- throw e;
- if (vari != null)
- vari.SetValue (e.ErrorTerm);
- return One;
- } catch (System.Exception e) {
- Term term = new Term (new ErrorTerm (e));
+ } 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 e;
+ throw exception;
if (vari != null)
vari.SetValue (term);
return One;
}
else if (args[0].IsSymbol)
{
- domain.Catch (new CatchTag (args[0].Symval));
- result = eval_terms (domain, args, 1, out caught);
- domain.Uncatch ();
+ 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 ();
+ }
}
- else
- throw new Error (Error.WrongArgument,
- "Not a symbol nor an error: {0}", args[0]);
-
- if (vari != null)
- vari.SetValue (result);
- return Zero;
+ throw new Error (Error.WrongArgument,
+ "Not a symbol nor an error: {0}", args[0]);
}
public static Term Fthrow (Domain domain, Variable vari, Term[] args)
return (args[args.Length - 1]);
}
if (args[0].IsError)
- return domain.ThrowError (args[0]);
+ {
+ 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 this; }
+ 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 Term Eval (Domain domain)
{
if (vari == null || vari.domain != domain)
- vari = domain.GetVar (vname, true);
+ vari = domain.GetVar (vname);
return vari.Value;
}
Function func = domain.GetFunc (fname);
Variable vari;
attr = node.Attributes[Qvname];
- vari = attr == null ? null : domain.GetVar (attr.Value, true);
+ vari = attr == null ? null : domain.GetVar (attr.Value);
XmlNodeList nlist = node.ChildNodes;
int nargs = nlist.Count;
Term[] args = new Term[nargs];
for (int i = 0; i < nargs; i++)
- args[i] = new Term (domain, nlist[i]);
+ args[i] = Parse (domain, nlist[i]);
return new Funcall (func, vari, args);
}
public override Term Eval (Domain domain)
{
+ Term result;
domain.TraceWrite (ToString ());
- domain.depth++;
- Term result = func.Call (domain, vari, args);
- domain.depth--;
+ try {
+ domain.depth++;
+ result = func.Call (domain, vari, args);
+ } finally {
+ domain.depth--;
+ }
domain.TraceWrite ("=> {0}", result.ToString ());
return result;
}
{
string str = "<" + func.name;
if (vari != null)
- str += " vname=\"" + vari.name + "\"";
+ {
+ str += " vname=\"" + vari.name + "\"";
+ if (detail)
+ str += " val=" + vari.Value.ToString ();
+ }
if (args.Length == 0 || ! detail)
return str + "/>";
str += ">";
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.ArithmeticException;
+ ename = Error.ArithmeticError;
else if (e is IndexOutOfRangeException)
ename = Error.IndexOutOfRange;
else if (e is InsufficientMemoryException
public override bool Equals (object obj)
{
ErrorTerm e = obj as ErrorTerm;
- return (e != null && e.ename = ename && e.message != message
+ return (e != null && e.ename == ename && e.message == message
&& (e.stack == null ? stack == null
- : (stack != null && e.stack.Length == stack.Length)))
+ : (stack != null && e.stack.Length == stack.Length)));
}
public override int GetHashCode ()
}
}
+ internal class CharSeq
+ {
+ private string str;
+ private Regex regex;
+
+ public CharSeq (string str) { this.str = str; }
+ public Insert (int index, string str)
+ {
+ this.str = this.str.Insert (index, str);
+ }
+ public Delete (int from, int to)
+ {
+ this.str = this.str.Remove (from, to - from);
+ }
+ }
+
public struct Term
{
public int intval;
// <symbol>...</symbol>
public Term (Symbol name) { intval = 0; objval = name; }
// <string>...</string>
- public Term (string str) { intval = 0; objval = str; }
+ public Term (string str) { intval = 0; objval = new StringBuilder (str); }
// <list>...</list>
public Term (List<Term> list) { intval = 0; objval = list; }
// <error ename="ERROR-NAME">ERROR-MESSASGE</error>
public Term (TermValue obj) { intval = 0; objval = obj; }
- public Term (Domain domain, XmlNode node)
- {
- Symbol name = node.Name;
-
- if (name == Qinteger)
- {
- intval = parse_integer (node);
- objval = null;
- }
- else
- {
- intval = 0;
- if (name == Qsymbol)
- objval = (Symbol) node.InnerText;
- else if (name == Qstring)
- objval = node.InnerText.Clone ();
- else if (name == Qlist)
- {
- List<Term> list = new List<Term> ();
- for (node = node.FirstChild; node != null;
- node = node.NextSibling)
- list.Add (new Term (domain, node));
- objval = list;
- }
- else
- {
- MethodInfo minfo;
-
- if (domain.termtypes.TryGetValue (name, out minfo))
- objval = (TermValue) minfo.Invoke (null, new Object[] { domain, node});
- else
- {
- Funcall funcall = (Funcall) Funcall.Parser (domain, node);
- if (funcall.func is Function.Macro)
- {
- Term result = funcall.Eval (domain);
- intval = result.intval;
- objval = result.objval;
- }
- else
- objval = funcall;
- }
- }
- }
- }
-
// <varref vname="VNAME"/>
public Term (Domain domain, Symbol vname)
{
intval = 0;
Function func = domain.GetFunc (fname);
- Variable vari = vname == Qnull ? null : domain.GetVar (vname, true);
+ Variable vari = vname == Qnull ? null : domain.GetVar (vname);
Funcall funcall = new Funcall (func, vari, args);
if (func is Function.Macro)
{
public object Objval {
get {
if (objval == null)
- throw new Exception (Qwrong_type,
- "term is an integer: {0}", this);
+ throw new Error (Error.WrongType,
+ "term is an integer: {0}", this);
return objval;
}
}
public int Intval {
get {
if (objval != null)
- throw new Exception (Qwrong_type, "{0} is not an integer", this);
+ throw new Error (Error.WrongType, "{0} is not an integer", this);
return intval;
}
}
public string Strval {
get {
if (! IsStr)
- throw new Exception (Qwrong_type, "{0} is not a string", this);
- return (string) objval;
+ throw new Error (Error.WrongType, "{0} is not a string", this);
+ return (StringBuilder) objval;
}
}
public string Symval {
get {
if (! IsSymbol)
- throw new Exception (Qwrong_type, "{0} is not a symbol", this);
+ throw new Error (Error.WrongType, "{0} is not a symbol", this);
return (Symbol) objval;
}
}
public List<Term> Listval {
get {
if (! IsList)
- throw new Exception (Qwrong_type, "{0} is not a list");
+ throw new Error (Error.WrongType, "{0} is not a list");
return (List<Term>) objval;
}
}
}
public bool IsInt { get { return (objval == null); } }
- public bool IsStr { get { return (objval is string); } }
+ public bool IsStr { get { return (objval is StringBuilder); } }
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); } }
if (objval == null || objval is Symbol || objval is string
|| objval is List<Term>)
return this;
- domain.CallStackPush (this);
- Term result;
try {
- result = ((TermValue) objval).Eval (domain);
+ domain.CallStackPush (this);
+ return ((TermValue) objval).Eval (domain);
+ } catch (Error e) {
+ if (e.Stack == null)
+ e.Stack = domain.CallStack;
+ throw e;
} finally {
domain.CallStackPop ();
}
- return result;
}
public Term Clone ()
{
- if (objval == null || objval is Symbol || objval is string)
+ if (objval == null || objval is Symbol)
return this;
+ if (objval is StringBuilder)
+ return new Term (((StringBuilder) objval).ToString ());
if (objval is List<Term>)
{
List<Term> list = new List<Term> ();
Term term = (Term) obj;
if (IsInt)
return term.IsInt && term.Intval == Intval;
- if (IsStr)
- return term.IsStr && term.Strval == Strval;
if (IsSymbol)
return term.IsSymbol && term.Symval == Symval;
+ if (IsStr)
+ return (term.IsStr
+ && term.Strval.Length = Strval.Length
+ && (Strval.Length == 0
+ || (term.Strval.Chars[0] == Strval.Chars[0]
+ && term.Strval.ToString () == Strval.ToString ())));
if (IsList)
{
if (! term.IsList)
{
if (IsInt)
return term.IsInt && term.Intval == Intval;
- if (IsStr)
- return term.IsStr && term.Strval == Strval;
if (IsSymbol)
return term.IsSymbol && term.Symval == Symval;
+ if (IsStr)
+ return term.IsStr && term.Strval == Strval;
if (IsList)
{
if (! term.IsList)
int len = str.Length;
int i, c;
- if (len == 1 && str[0] == '?')
+ if (len == 2 && str[0] == '?')
return str[1];
if (len > 2
&& str[1] == 'x' && ((c = str[0]) == '0' || c == '#'))
for (n = node.FirstChild; n != null; n = n.NextSibling)
{
if (n.Name == Qfixed)
- nfixed += n.ChildNodes.Count;
+ nfixed++;
else if (n.Name == Qoptional)
- noptional += n.ChildNodes.Count;
+ noptional++;
else if (n.Name == Qrest)
- nrest++;
+ {
+ if (nrest > 0)
+ throw new Error (Error.WrongType, n, "Too many <rest>");
+ nrest++;
+ }
else
throw new Error (Error.WrongType, n,
"Not fixed, optional, nor rest: {0}", n.Name);
args = new Variable[max_args];
n = node.FirstChild;
for (int i = 0; i < max_args; n = n.NextSibling)
- {
- for (XmlNode nn = n.FirstChild; nn != null; nn = nn.NextSibling)
- args[i++] = domain.Defvar ((Symbol) nn.Attributes[0].Value);
- }
+ args[i++] = domain.Defvar ((Symbol) n.Attributes[0].Value);
if (nrest == 1)
max_args = - max_args;
}
int min_args, max_args;
Variable[] args;
- try {
- args = parse_args (domain, node, out min_args, out max_args);
- if (node.Name == Qdefun)
- domain.Defun (name, min_args, max_args, args, null);
- else
- domain.Defmacro (name, min_args, max_args, args, null);
- } catch (Error e) {
- if (e.ErrorNode == null)
- e.ErrorNode = node;
- throw e;
- } catch (Exception e) {
- throw new Exception (node, e);
- }
+ args = parse_args (domain, node, out min_args, out max_args);
+ if (node.Name == Qdefun)
+ domain.Defun (name, min_args, max_args, args, null);
+ else
+ domain.Defmacro (name, min_args, max_args, args, null);
return name;
}
public static void parse_defun_body (Domain domain, XmlNode node)
{
+ bool is_defun = node.Name == Qdefun;
Symbol name = node.Attributes[Qfname].Value;
Function func = domain.GetFunc (name);
&& node.Name != Qargs)
break;
Term[] body = Parse (domain, node, null);
- if (node.Name == Qdefun)
+ if (is_defun)
((Function.Lambda) func).SetBody (body);
else
((Function.Macro) func).SetBody (body);
{
Symbol name = node.Name;
- if (name == Qinteger)
- return new Term (parse_integer (node));
- if (name == Qsymbol)
- return new Term ((Symbol) node.InnerText);
- if (name == Qstring)
- return new Term (node.InnerText);
- if (name == Qlist)
- {
- List<Term> list = new List<Term> ();
- for (node = node.FirstChild; node != null;
- node = node.NextSibling)
- list.Add (Parse (domain, node));
- return new Term (list);
- }
- if (name == Qdefun || name == Qdefmacro)
- {
- name = parse_defun_head (domain, node);
- parse_defun_body (domain, node);
- return new Term (name);
- }
- if (name == Qdefvar)
- {
- name = parse_defvar (domain, node);
- return new Term (name);
- }
- MethodInfo minfo;
- if (domain.termtypes.TryGetValue (name, out minfo))
- {
- object[] arg = new object[] { domain, node };
- return new Term ((TermValue) minfo.Invoke (null, arg));
- }
+ try {
+ if (name == Qinteger)
+ return new Term (parse_integer (node));
+ if (name == Qsymbol)
+ return new Term ((Symbol) node.InnerText);
+ if (name == Qstring)
+ return new Term (node.InnerText);
+ if (name == Qlist)
+ {
+ List<Term> list = new List<Term> ();
+ for (node = node.FirstChild; node != null;
+ node = node.NextSibling)
+ list.Add (Parse (domain, node));
+ return new Term (list);
+ }
+ if (name == Qdefun || name == Qdefmacro)
+ {
+ name = parse_defun_head (domain, node);
+ parse_defun_body (domain, node);
+ return new Term (name);
+ }
+ if (name == Qdefvar)
+ {
+ name = parse_defvar (domain, node);
+ return new Term (name);
+ }
+ MethodInfo parser;
+ if (domain.termtypes.TryGetValue (name, out parser))
+ {
+ object[] arg = new object[] { domain, node };
+ return new Term ((TermValue) parser.Invoke (null, arg));
+ }
- Funcall funcall = (Funcall) Funcall.Parser (domain, node);
- if (funcall.func is Function.Macro)
- return funcall.Eval (domain);
- return new Term (funcall);
+ Funcall funcall = (Funcall) Funcall.Parser (domain, node);
+ if (funcall.func is Function.Macro)
+ return funcall.Eval (domain);
+ return new Term (funcall);
+ } catch (Error e) {
+ if (e.Node == null)
+ e.Node = node;
+ throw e;
+ } catch (Exception e) {
+ throw new Error (Error.UnknownError, node, e, "Parsing error");
+ }
}
private static bool default_stop (XmlNode n) { return n == null; }
- public static List<Term> Parse (Domain domain, XmlNode node,
- Func<XmlNode, bool> stop)
+ public static Term[] Parse (Domain domain, XmlNode node,
+ Func<XmlNode, bool> stop)
{
if (stop == null)
stop = default_stop;
for (n = node; ! stop (n); n = n.NextSibling)
if (n.NodeType == XmlNodeType.Element
&& (n.Name == Qdefun || n.Name == Qdefmacro))
- parse_defun_head (domain, n);
+ {
+ try {
+ parse_defun_head (domain, n);
+ } catch (Error e) {
+ if (e.Node == null)
+ e.Node = node;
+ throw e;
+ } catch (Exception e) {
+ throw new Error (Error.UnknownError, node, e, "Parsing error");
+ }
+ }
List<Term> terms = new List<Term> ();
for (; node != n; node = node.NextSibling)
if (node.NodeType == XmlNodeType.Element)
{
- if (node.Name == Qdefun || node.Name == Qdefmacro)
- parse_defun_body (domain, node);
- else if (node.Name == Qdefvar)
- parse_defvar (domain, node);
- else
- terms.Add (Parse (domain, node));
+ try {
+ if (node.Name == Qdefun || node.Name == Qdefmacro)
+ parse_defun_body (domain, node);
+ else if (node.Name == Qdefvar)
+ parse_defvar (domain, node);
+ else
+ terms.Add (Parse (domain, node));
+ } catch (Error e) {
+ if (e.Node == null)
+ e.Node = node;
+ throw e;
+ } catch (Exception e) {
+ throw new Error (Error.UnknownError, node, e, "Parsing error");
+ }
}
- return terms;
+ return terms.ToArray ();
}
- public static List<Term> Parse (Domain domain, string url)
+ public static Term[] Parse (Domain domain, string url)
{
XmlDocument doc = new XmlDocument (Symbol.NameTable);
XmlNode node;
return Parse (domain, node.FirstChild, null);
}
- public static Term Eval (Domain domain, List<Term> terms)
+ public static Term Eval (Domain domain, Term[] terms)
{
Term result = Zero;
- foreach (Term term in terms)
- {
- result = term.Eval (domain);
- if (domain.Thrown)
- return result;
- }
- return result;
+ try {
+ foreach (Term term in terms)
+ {
+ result = term.Eval (domain);
+ if (domain.Thrown ())
+ return result;
+ }
+ return result;
+ } catch (Error e) {
+ throw e;
+ } catch (Exception e) {
+ throw new Error (Error.UnknownError, null, e, "Runtime error");
+ }
}
}
}
projects / m17n / m17n-lib-cs.git / commitdiff