From: handa Date: Sat, 7 Nov 2009 03:23:32 +0000 (+0000) Subject: *** empty log message *** X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=b0944101586bc138ea4bd2df4ce4ee8f6cc8c2c4;p=m17n%2Fm17n-lib-cs.git *** empty log message *** --- diff --git a/XmlExpr.cs b/XmlExpr.cs index 0168e3f..f9e4a86 100644 --- a/XmlExpr.cs +++ b/XmlExpr.cs @@ -3,6 +3,7 @@ using System.Collections; using System.Collections.Generic; using System.IO; using System.Reflection; +using System.Text; using System.Xml; namespace System.Xml @@ -16,46 +17,28 @@ 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)) { @@ -71,6 +54,48 @@ namespace System.Xml 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 @@ -226,7 +251,7 @@ namespace System.Xml { private int[] range; - public void IsSubrange (int[] r) + public bool IsSubrange (int[] r) { if (range == null) return true; @@ -308,7 +333,7 @@ namespace System.Xml { if (range == null) return true; - string str = term.Strval; + string str = val.Strval; foreach (string s in range) if (str == s) return true; @@ -358,7 +383,7 @@ namespace System.Xml { if (range == null) return true; - Symbol sym = term.Symval; + Symbol sym = val.Symval; foreach (Symbol n in range) if (sym == n) return true; @@ -479,19 +504,19 @@ namespace System.Xml 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 list = new List (); - 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; } @@ -576,7 +601,7 @@ namespace System.Xml { Bindings b = new Bindings (vari); - b.vari.Value = val; + b.vari.SetValue (val); b.next = bindings; return b; } @@ -584,7 +609,7 @@ namespace System.Xml 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; } @@ -600,18 +625,13 @@ namespace System.Xml 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); } @@ -627,8 +647,6 @@ namespace System.Xml = new Dictionary (); internal Dictionary functions = new Dictionary (); - internal Dictionary macros - = new Dictionary (); internal Dictionary variables = new Dictionary (); internal Bindings bindings; @@ -644,22 +662,15 @@ namespace System.Xml { termtypes = new Dictionary (parent.termtypes); functions = new Dictionary (parent.functions); - macros = new Dictionary (parent.macros); variables = new Dictionary (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) { @@ -667,6 +678,8 @@ namespace System.Xml call_stack.Pop (); } + public Term[] CallStack { get { return call_stack.ToArray (); } } + internal void Bind (Variable vari, Term value) { bindings = Bindings.Bind (bindings, vari, value); @@ -714,12 +727,12 @@ namespace System.Xml } } - 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) @@ -728,23 +741,10 @@ namespace System.Xml { 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) @@ -758,41 +758,47 @@ namespace System.Xml 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 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); } @@ -801,15 +807,15 @@ namespace System.Xml 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); } @@ -819,36 +825,23 @@ namespace System.Xml 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; @@ -876,12 +869,12 @@ namespace System.Xml { 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;; } @@ -957,7 +950,6 @@ namespace System.Xml internal Function GetFunc (Symbol name) { Function func; - if (! functions.TryGetValue (name, out func)) throw new Error (Error.UnknownFunction, "Unknown function: {0}", name); @@ -978,16 +970,12 @@ namespace System.Xml 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; } @@ -1031,7 +1019,7 @@ namespace System.Xml { foreach (KeyValuePair kv in (Dictionary) values) - kv.Key.Value = kv.Value; + kv.Key.SetValue (kv.Value); } } @@ -1109,7 +1097,7 @@ namespace System.Xml 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]; } @@ -1386,15 +1374,15 @@ namespace System.Xml { 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) @@ -1471,8 +1459,7 @@ namespace System.Xml 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]; } @@ -1611,16 +1598,16 @@ namespace System.Xml { 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; @@ -1628,17 +1615,22 @@ namespace System.Xml } 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) @@ -1649,14 +1641,17 @@ namespace System.Xml 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); } @@ -1678,7 +1673,7 @@ namespace System.Xml public override Term Eval (Domain domain) { if (vari == null || vari.domain != domain) - vari = domain.GetVar (vname, true); + vari = domain.GetVar (vname); return vari.Value; } @@ -1743,21 +1738,25 @@ namespace System.Xml 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; } @@ -1787,7 +1786,11 @@ namespace System.Xml { 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 += ">"; @@ -1809,19 +1812,25 @@ namespace System.Xml 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 @@ -1853,9 +1862,9 @@ namespace System.Xml 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 () @@ -1883,6 +1892,22 @@ namespace System.Xml } } + 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; @@ -1893,7 +1918,7 @@ namespace System.Xml // ... public Term (Symbol name) { intval = 0; objval = name; } // ... - public Term (string str) { intval = 0; objval = str; } + public Term (string str) { intval = 0; objval = new StringBuilder (str); } // ... public Term (List list) { intval = 0; objval = list; } // ERROR-MESSASGE @@ -1905,52 +1930,6 @@ namespace System.Xml 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 list = new List (); - 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; - } - } - } - } - // public Term (Domain domain, Symbol vname) { @@ -1968,7 +1947,7 @@ namespace System.Xml 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) { @@ -1983,8 +1962,8 @@ namespace System.Xml 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; } } @@ -1992,7 +1971,7 @@ namespace System.Xml 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; } } @@ -2000,15 +1979,15 @@ namespace System.Xml 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; } } @@ -2016,7 +1995,7 @@ namespace System.Xml public List 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) objval; } } @@ -2034,7 +2013,7 @@ namespace System.Xml } 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); } } public bool IsError { get { return (objval is ErrorTerm); } } @@ -2044,20 +2023,24 @@ namespace System.Xml if (objval == null || objval is Symbol || objval is string || objval is List) 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) { List list = new List (); @@ -2081,10 +2064,14 @@ namespace System.Xml 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) @@ -2108,10 +2095,10 @@ namespace System.Xml { 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) @@ -2175,7 +2162,7 @@ namespace System.Xml 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 == '#')) @@ -2300,11 +2287,15 @@ namespace System.Xml 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 "); + nrest++; + } else throw new Error (Error.WrongType, n, "Not fixed, optional, nor rest: {0}", n.Name); @@ -2314,10 +2305,7 @@ namespace System.Xml 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; } @@ -2335,24 +2323,17 @@ namespace System.Xml 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); @@ -2361,7 +2342,7 @@ namespace System.Xml && 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); @@ -2371,48 +2352,56 @@ namespace System.Xml { 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 list = new List (); - 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 list = new List (); + 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 Parse (Domain domain, XmlNode node, - Func stop) + public static Term[] Parse (Domain domain, XmlNode node, + Func stop) { if (stop == null) stop = default_stop; @@ -2421,23 +2410,41 @@ namespace System.Xml 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 terms = new List (); 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 Parse (Domain domain, string url) + public static Term[] Parse (Domain domain, string url) { XmlDocument doc = new XmlDocument (Symbol.NameTable); XmlNode node; @@ -2456,17 +2463,23 @@ namespace System.Xml return Parse (domain, node.FirstChild, null); } - public static Term Eval (Domain domain, List 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"); + } } } } diff --git a/xex.cs b/xex.cs index 6bbf112..e54178c 100644 --- a/xex.cs +++ b/xex.cs @@ -10,11 +10,12 @@ public class Test { Xex.TraceDepth = 10; Xex.Domain domain = new Xex.Domain ("test", null); - Xex xex = new Xex (domain, "xex.xml"); + Xex.Term[] terms = Xex.Parse (domain, "xex.xml"); if (args.Length >= 2 && args[0] == "-d") Xex.TraceDepth = int.Parse (args[1]); - Console.WriteLine (xex); - Console.WriteLine (xex.Eval (domain)); + foreach (Xex.Term term in terms) + Console.WriteLine (term); + Console.WriteLine (Xex.Eval (domain, terms)); } } diff --git a/xex.xml b/xex.xml index 1ad4c16..3566ba7 100644 --- a/xex.xml +++ b/xex.xml @@ -1,7 +1,7 @@ - + 2 @@ -14,7 +14,7 @@ - + @@ -24,7 +24,7 @@ - + 10