From: handa Date: Wed, 4 Nov 2009 11:04:13 +0000 (+0000) Subject: *** empty log message *** X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=5886b86d4068fbd3a1d87d3e19a298689d65c62a;p=m17n%2Fm17n-lib-cs.git *** empty log message *** --- diff --git a/Makefile b/Makefile index c2b2490..e0f22ef 100644 --- a/Makefile +++ b/Makefile @@ -45,3 +45,6 @@ clean: temp.exe: temp.cs $(CS) temp.cs + +test.exe: test.cs + $(CS) test.cs diff --git a/XmlExpr.cs b/XmlExpr.cs index 906057b..2db0b43 100644 --- a/XmlExpr.cs +++ b/XmlExpr.cs @@ -16,60 +16,55 @@ namespace System.Xml set { trace_depth = value; } } - public static partial class Error + public class Error : System.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 TypeConflict = "type-conflict"; - public static Symbol AlreadyDefined = "already-defined"; - public static Symbol WrongCallingFormat = "wrong-calling-format"; - public static Symbol ArgumentMismatch = "argument-mismatch"; + 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 WrongRange = "wrong-range"; - public static Symbol OutOfRange = "out-of-range"; - - public static Symbol InvalidVariableType = "invalid variable type"; - public static Symbol NoOuterLoop = "no outer loop"; - public static Symbol UnknownError = "unknown error"; - } - - public class Exception : System.Exception - { - public Symbol ErrorName; - public string ErrorNode; - public Term ErrorTerm; - - internal Exception (Symbol name, string fmt, params object[] args) - : this (name, Zero, fmt, args) { } + 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"; - internal Exception (Symbol name, XmlNode node, - string fmt, params object[] args) - : this (name, node, Zero, fmt, args) { } + private readonly Symbol name; + private Term term = Zero; + private XmlNode node; - internal Exception (Symbol name, Term term, - string fmt, params object[] args) - : this (name, null, term, fmt, args) { } - - internal Exception (Symbol name, XmlNode node, Term term, - string fmt, params object[] args) - : base (String.Format (message, args)) + public Error (Symbol name, XmlNode node, string fmt, params object[] args) + : base (String.Format (fmt, args)) { - ErrorName = name; - if (node != null) - ErrorNode = node.OuterXml; - ErrorTerm = term; + this.name = name; + this.node = node; } - internal Exception (XmlNode node, System.Exception e) - : base ("System error", e) + public Error (Symbol name, string fmt, params object[] args) + : base (String.Format (fmt, args)) { - ErrorName = Qsystem_error; - ErrorNode = node; - ErrorTerm = Zero; + this.name = name; } + + public Symbol ErrorName { get { return name; } } + public XmlNode ErrorNode { get { return node; } set { node = value; } } + public Term ErrorTerm { get { return term; } set { term = value; } } } public struct Symbol : IEquatable @@ -163,6 +158,217 @@ namespace System.Xml private static Symbol Qename = "ename"; + public class Variable + { + public Domain domain; + public readonly Symbol name; + protected Term val; + + public Variable (Domain domain, Symbol name, Term val) + { + this.domain = domain; + this.name = name; + this.val = val; + } + + public Term Value { get { return val; } } + + public virtual Term SetValue (Term val) { this.val = val; return val; } + + public virtual Variable Clone (Domain domain) + { + return new Variable (domain, name, val); + } + + public virtual void Reset () { val = Zero; } + + public override string ToString () { return name + "(" + val + ")"; } + + public abstract class Typed : Variable + { + protected string desc; + private Term default_val; + + protected Typed (Domain domain, Symbol name, Term val, string desc) + : base (domain, name, val) + { + this.desc = desc; + default_val = val; + } + + public override void Reset () { val = default_val; } + + public string Description { + get { return desc; } + set { desc = value; } + } + + public override Term SetValue (Term val) + { + if (! CheckValue (val)) + throw new Error (Error.VariableWrongValue, + "Wrong value for variable {0}: {1}", + name, val); + this.val = val; + return val; + } + + public abstract bool CheckValue (Term val); + } + + public class Int : Typed + { + private int[] range; + + public void IsSubrange (int[] r) + { + if (range == null) + return true; + for (int i = 0; i < r.Length; i += 2) + { + int j; + for (j = 0; j < range.Length; j += 2) + if (range[j] <= r[i] && range[j + 1] >= r[i + 1]) + break; + if (j >= range.Length) + return false; + } + return true; + } + + public Int (Domain domain, Symbol name, int n, string desc, int[] range) + : base (domain, name, new Term (n), desc) + { + if (range != null && range.Length % 2 == 1) + throw new Error (Error.VariableWrongRange, + "Range length for {0} not even", name); + this.range = range; + CheckValue (val); + } + + public override bool CheckValue (Term term) + { + if (term.IsInt) + { + if (range == null) + return true; + int n = term.Intval; + for (int i = 0; i < range.Length; i += 2) + if (range[i] <= n && range[i + 1] >= n) + return true; + } + return false; + } + + public override Variable Clone (Domain domain) + { + return new Int (domain, name, val.Intval, desc, range); + } + + public int[] Range { get { return range; } set { range = value; } } + } + + public class Str : Typed + { + private string[] range; + + public bool IsSubrange (string[] r) + { + if (range == null) + return true; + for (int i = 0; i < r.Length; i++) + { + int j; + for (j = 0; j < range.Length; j++) + if (range[j] == r[i]) + break; + if (j >= range.Length) + return false; + } + return true; + } + + public Str (Domain domain, Symbol name, string str, string desc, + string[] range) + : base (domain, name, new Term (str), desc) + { + this.range = range; + CheckValue (val); + } + + public override bool CheckValue (Term val) + { + if (val.IsStr) + { + if (range == null) + return true; + string str = term.Strval; + foreach (string s in range) + if (str == s) + return true; + } + return false; + } + + public override Variable Clone (Domain domain) + { + return new Str (domain, name, val.Strval, desc, range); + } + + public string[] Range { get { return range; } set { range = value; } } + } + + public class Sym : Typed + { + public Symbol[] range; + + public bool IsSubrange (Symbol[] r) + { + if (range == null) + return true; + for (int i = 0; i < r.Length; i++) + { + int j; + for (j = 0; j < range.Length; j++) + if (range[j] == r[i]) + break; + if (j >= range.Length) + return false; + } + return true; + } + + public Sym (Domain domain, Symbol name, Symbol sym, string desc, + Symbol[] range) + : base (domain, name, new Term (sym), desc) + { + this.range = range; + CheckValue (val); + } + + public override bool CheckValue (Term val) + { + if (val.IsSymbol) + { + if (range == null) + return true; + Symbol sym = term.Symval; + foreach (Symbol n in range) + if (sym == n) + return true; + } + return false; + } + + public override Variable Clone (Domain domain) + { + return new Sym (domain, name, val.Symval, desc, range); + } + + public Symbol[] Range { get { return range; } set { range = value; } } + } + } + public abstract class Function { public Symbol name; @@ -336,232 +542,6 @@ namespace System.Xml } } - public class Variable - { - public Domain domain; - public readonly Symbol name; - protected Term val; - - public Variable (Domain domain, Symbol name, Term val) - { - this.domain = domain; - this.name = name; - this.val = val; - } - - public virtual bool ValueP (Term val) { return true; } - - public virtual Variable Clone (Domain domain) - { - return new Variable (domain, name, val); - } - - public virtual void Reset () { val = Zero; } - - public Term Value - { - get { return val; } - set { - if (! ValueP (value)) - throw new Exception ("Invalid value: " + value); - val = value; - } - } - - public Term SetValue (int i) - { - val.intval = i; - val.objval = null; - return val; - } - - public Term SetValue (string s) - { - val.objval = s; - return val; - } - - public override string ToString () { return name + "(" + val + ")"; } - - public abstract class Typed : Variable - { - protected string desc; - private Term default_val; - - protected Typed (Domain domain, Symbol name, Term val, string desc) - : base (domain, name, val) - { - this.desc = desc; - default_val = val; - } - - public override void Reset () { val = default_val; } - - public string Description { - get { return desc; } - set { desc = value; } - } - } - - public class Int : Typed - { - private int[] range; - - public bool IsSubrange (int[] r) - { - if (range == null) - return true; - for (int i = 0; i < r.Length; i += 2) - { - int j; - for (j = 0; j < range.Length; j += 2) - if (range[j] <= r[i] && range[j + 1] >= r[i + 1]) - break; - if (j >= range.Length) - return false; - } - return true; - } - - public Int (Domain domain, Symbol name, int n, string desc, int[] range) - : base (domain, name, new Term (n), desc) - { - if (range != null && range.Length % 2 == 1) - throw new Exception (Qinvalid_range, - "Range length for {0} not even", name); - this.range = range; - if (! ValueP (val)) - throw new Exception (Qout_of_range, - "Invalid integer value for {0}: {1}", - name, val); - } - - public override bool ValueP (Term term) - { - if (! term.IsInt) - return false; - if (range == null) - return true; - int n = term.Intval; - for (int i = 0; i < range.Length; i += 2) - if (range[i] <= n && range[i + 1] >= n) - return true; - return false; - } - - public override Variable Clone (Domain domain) - { - return new Int (domain, name, val.Intval, desc, range); - } - - public int[] Range { get { return range; } set { range = value; } } - } - - public class Str : Typed - { - private string[] range; - - public bool IsSubrange (string[] r) - { - if (range == null) - return true; - for (int i = 0; i < r.Length; i++) - { - int j; - for (j = 0; j < range.Length; j++) - if (range[j] == r[i]) - break; - if (j >= range.Length) - return false; - } - return true; - } - - public Str (Domain domain, Symbol name, string str, string desc, - string[] range) - : base (domain, name, new Term (str), desc) - { - this.range = range; - if (! ValueP (val)) - throw new Exception (Qout_of_range, - "Invalid string value for {0}: {1}", - name, val); - } - - public override bool ValueP (Term term) - { - if (! term.IsStr) - return false; - if (range == null) - return true; - string str = term.Strval; - foreach (string s in range) - if (str == s) - return true; - return false; - } - - public override Variable Clone (Domain domain) - { - return new Str (domain, name, val.Strval, desc, range); - } - - public string[] Range { get { return range; } set { range = value; } } - } - - public class Sym : Typed - { - public Symbol[] range; - - public bool IsSubrange (Symbol[] r) - { - if (range == null) - return true; - for (int i = 0; i < r.Length; i++) - { - int j; - for (j = 0; j < range.Length; j++) - if (range[j] == r[i]) - break; - if (j >= range.Length) - return false; - } - return true; - } - - public Sym (Domain domain, Symbol name, Symbol sym, string desc, - Symbol[] range) - : base (domain, name, new Term (sym), desc) - { - this.range = range; - if (! ValueP (val)) - throw new Exception (Qout_of_range, - "Invalid symbol value for {0}: {1}", - name, val); - } - - public override bool ValueP (Term term) - { - if (! term.IsSymbol) - return false; - if (range == null) - return true; - Symbol name = term.Symval; - foreach (Symbol n in range) - if (name == n) - return true; - return false; - } - - public override Variable Clone (Domain domain) - { - return new Sym (domain, name, val.Symval, desc, range); - } - - public Symbol[] Range { get { return range; } set { range = value; } } - } - } - internal class Bindings { private Variable vari; @@ -603,9 +583,13 @@ namespace System.Xml { private Term 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. private CatchTag (int i) { tag = new Term (i); } public Term Tag { get { return tag; } } @@ -748,20 +732,23 @@ namespace System.Xml public void DefType (Type type) { if (! type.IsSubclassOf (typeof (TermValue))) - throw new Exception ("Not a subclass of TermValue: " + type); + throw new Error (Error.TermTypeInvalid, + "Not a subclass of TermValue: {0}", type); BindingFlags flags = BindingFlags.Static | BindingFlags.NonPublic; FieldInfo finfo = type.GetField ("name", flags); if (finfo == null || finfo.FieldType != typeof (Symbol)) - throw new Exception ("No \"name\" field of string 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)) - throw new Exception ("already defined: " + name); + throw new Error (Error.TermTypeInvalid, + "Already defined: {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 Exception ("No \"Parser\" method of correct type: " + type); + throw new Error ("No \"Parser\" method of correct type: {0}", type); termtypes[name] = minfo; } @@ -769,16 +756,18 @@ namespace System.Xml int min_args, int max_args) { if (termtypes.ContainsKey (name)) - throw new Exception (Qtype_conflict, "{0} is a Term type", name); + throw new Error (Error.FunctionConflict, + "Already defined as a term type: {0}", name); else if (macros.ContainsKey (name)) - throw new Exception (Qtype_conflict, "{0} is a macro", 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 || func.min_args != min_args || func.max_args != max_args)) - throw new Exception (Qargument_mismatch, ""); + throw new Error (Error.FunctionConflict, + "Conflicting arguments: {0}", name); } public void DefSubr (Func builtin, @@ -816,118 +805,37 @@ namespace System.Xml Variable[] args, Term[] body) { if (termtypes.ContainsKey (name)) - throw new Exception (Qtype_conflict, "{0} is a Term type", name); + throw new Error (Error.FunctionConflict, + "Already defined as a term type: {0}", name); else if (function.ContainsKey (name)) - throw new Exception (Qtype_conflict, "{0} is a function", 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 Exception (Qargument_mismatch, ""); - + throw new Error (Error.FunctionConflict, + "Conflicting arguments: {0}", name); macros[name] = new Function.Macro (name, min_arg, max_arg, args, body); } public void DefAlias (Symbol alias, Symbol fname) { Function func; + if (termtypes.TryGetValue (alias, out func)) + throw new Error (Error.FunctionConflict, + "Alread defined as a term type: {0}", alias); if (functions.TryGetValue (alias, out func)) - throw new Exception (Qalready_defined, - "Alread defined: {0}", 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 Exception (Qunknown_function, - "Unknown fucntion: {0}", fname); + throw new Error (Error.UnknownFunction, fname); functions[alias] = func; } - public Variable Defvar (XmlNode node) - { - Symbol name = node.Attributes[0].Value; - String desc; - Variable vari; - - node = node.FirstChild; - if (node != null && node.Name == Qdescription) - { - desc = node.InnerText; - node = node.NextSibling; - } - else - desc = null; - if (node != null) - { - Symbol type = node.Name; - XmlNodeList range_list = null; - int nranges = 0; - XmlNode n = node.NextSibling; - - if (n != null) - { - range_list = n.ChildNodes; - nranges = range_list.Count; - } - - if (type == Qinteger) - { - int val = parse_integer (node); - int[] range = null; - if (range_list != null) - { - range = new int[nranges * 2]; - for (int i = 0; i < nranges; i++) - { - XmlNode nd = range_list[i]; - if (nd.Name == Qrange) - { - range[i * 2] = parse_integer (nd.FirstChild); - range[i * 2 + 1] = parse_integer (nd.LastChild); - } - else - { - range[i * 2] = range[i * 2 + 1] - = parse_integer (nd.FirstChild); - } - } - } - vari = DefvarInt (name, val, desc, range); - } - else if (type == Qstring) - { - string[] range = null; - if (range_list != null) - { - range = new string[nranges]; - for (int i = 0; i < nranges; i++) - range[i] = range_list[i].FirstChild.InnerText; - } - vari = DefvarStr (name, node.InnerText, desc, range); - } - else if (type == Qsymbol) - { - Symbol[] range = null; - if (range_list != null) - { - range = new Symbol[nranges]; - for (int i = 0; i < nranges; i++) - range[i] = range_list[i].FirstChild.InnerText; - } - vari = DefvarSym (name, (Symbol) node.InnerText, desc, range); - } - else - Exception.Throw (Qparse_error, node, "Unknown type: {0}", type); - } - else - { - if (variables.TryGetValue (name, out vari)) - vari = vari.Clone (this); - else - vari = new Variable (this, name, Zero); - variables[name] = vari; - } - return vari; - } - public Variable Defvar (Variable vari) { vari = vari.Clone (this); @@ -950,11 +858,13 @@ namespace System.Xml { Variable.Int intvari = vari as Variable.Int; if (intvari == null) - throw new Exception ("Variable type mismatch: " + name); + throw new Error (Error.VariableTypeConfclit, + "Not an integer variable: {0}", name); if (range != null) { if (! intvari.IsSubrange (range)) - throw new Exception ("Variable range mismatch: " + name); + throw new Error (Error.VariableRangeConfclit, + "Conflicting variable range: {0}", name); intvari.Range = range;; } if (desc != null) @@ -977,11 +887,13 @@ namespace System.Xml { Variable.Str strvari = vari as Variable.Str; if (strvari == null) - throw new Exception ("Variable type mismatch: " + name); + throw new Error (Error.VariableTypeConflict, + "Not a string variable: {0}", name); if (range != null) { if (! strvari.IsSubrange (range)) - throw new Exception ("Variable range mismatch: " + name); + throw new Error (Error.VariableRangeConflict, + "Conflicting variable range: {0}", name); strvari.Range = range; } if (desc != null) @@ -1004,11 +916,13 @@ namespace System.Xml { Variable.Sym symvari = vari as Variable.Sym; if (symvari == null) - throw new Exception ("Variable type mismatch: " + name); + throw new Error (Error.VariableTypeConflict, + "Not a symbol variable: {0}", name); if (range != null) { if (! symvari.IsSubrange (range)) - throw new Exception ("Variable range mismatch: " + name); + throw new Error (Error.VariableRangeConflict, + "Conflicting variable range: {0}", name); symvari.Range = range; } if (desc != null) @@ -1027,7 +941,8 @@ namespace System.Xml Function func; if (! functions.TryGetValue (name, out func)) - throw new Exception (Qunknown_function, (strign) name); + throw new Error (Error.UnknownFunction, + "Unknown function: {0}", name); return func; } @@ -1176,8 +1091,9 @@ namespace System.Xml private static Term Fset (Domain domain, Variable vari, Term[] args) { if (vari == null) - return new Term (new ErrorTerm (Error.NoVariable, "")); - vari.Value = args[0]; + return new Term (new ErrorTerm (Error.NoVariableName, + "No variable name to set")); + vari.SetValue (args[0]); return args[0]; } @@ -1186,13 +1102,22 @@ namespace System.Xml return args[0].IsTrue ? Zero : One; } + static Term maybe_set_intvar (Variable vari, int n) + { + Term term = new Term (n); + if (vari != null) + vari.SetValue (term); + return term; + } + + private static Term Fadd (Domain domain, Variable vari, Term[] args) { int n = vari == null ? 0 : vari.Value.Intval; foreach (Term arg in args) n += arg.Intval; - return (vari == null ? new Term (n) : vari.SetValue (n)); + return maybe_set_intvar (vari, n); } private static Term Fmul (Domain domain, Variable vari, Term[] args) @@ -1200,7 +1125,7 @@ namespace System.Xml int n = vari == null ? 1 : vari.Value.Intval; foreach (Term arg in args) n *= arg.Intval; - return (vari == null ? new Term (n) : vari.SetValue (n)); + return maybe_set_intvar (vari, n); } private static Term Fsub (Domain domain, Variable vari, Term[] args) @@ -1219,7 +1144,7 @@ namespace System.Xml } while (i < args.Length) n -= args[i++].Intval; - return (vari == null ? new Term (n) : vari.SetValue (n)); + return maybe_set_intvar (vari, n); } private static Term Fdiv (Domain domain, Variable vari, Term[] args) @@ -1238,14 +1163,12 @@ namespace System.Xml } while (i < args.Length) n /= args[i++].Intval; - return (vari == null ? new Term (n) : vari.SetValue (n)); + return maybe_set_intvar (vari, n); } private static Term Fmod (Domain domain, Variable vari, Term[] args) { - int n = args[0].Intval % args[1].Intval; - - return (vari == null ? new Term (n) : vari.SetValue (n)); + return maybe_set_intvar (vari, args[0].Intval % args[1].Intval); } private static Term Flogior (Domain domain, Variable vari, Term[] args) @@ -1253,7 +1176,7 @@ namespace System.Xml int n = vari == null ? 0 : vari.Value.Intval; foreach (Term arg in args) n |= arg.Intval; - return (vari == null ? new Term (n) : vari.SetValue (n)); + return maybe_set_intvar (vari, n); } private static Term Flogand (Domain domain, Variable vari, Term[] args) @@ -1272,19 +1195,17 @@ namespace System.Xml } while (i < args.Length) n &= args[i++].Intval; - return (vari == null ? new Term (n) : vari.SetValue (n)); + return maybe_set_intvar (vari, n); } private static Term Flsh (Domain domain, Variable vari, Term[] args) { - int n = args[0].Intval << args[1].Intval; - return (vari == null ? new Term (n) : vari.SetValue (n)); + return maybe_set_intvar (vari, args[0].Intval << args[1].Intval); } private static Term Frsh (Domain domain, Variable vari, Term[] args) { - int n = args[0].Intval >> args[1].Intval; - return (vari == null ? new Term (n) : vari.SetValue (n)); + return maybe_set_intvar (vari, args[0].Intval >> args[1].Intval); } private static Term Feq (Domain domain, Variable vari, Term[] args) @@ -1410,14 +1331,10 @@ namespace System.Xml str += (char) arg.Intval; } - if (vari == null) - { - Term term; - term.intval = 0; - term.objval = str; - return term; - } - return vari.SetValue (str); + Term strterm = new Term (str); + if (vari != null) + vari.SetValue (strterm); + return strterm; } private static Term Fnth (Domain domain, Variable vari, Term[] args) @@ -1434,8 +1351,8 @@ namespace System.Xml result = ((List) args[1].objval)[args[0].Intval]; } else - throw new Exception (Qwrong_type, - "{0} is not a string nor a list", args[1]); + throw new Error (Error.WrongType, + "Not a string nor a list: {0}", args[1]); return result; } @@ -1451,39 +1368,33 @@ namespace System.Xml private static Term Fins (Domain domain, Variable vari, Term[] args) { if (vari == null) - throw new Exception (Qwrong_calling_format, "No vname attribute"); + throw new Error (Error.NoVariableName, "No variable name to set"); Term term = vari.Value; if (term.IsStr) - { - string str = term.Strval.Insert (args[0].Intval, args[1].Strval); - vari.SetValue (str); - } + term.objval = term.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 Exception (Qwrong_type, "{0} is not a string nor list", - vari.Value); - return vari.Value; + throw new Error (Error.WrongType, "Not a string nor a list: {0}", + vari.Value); + return term; } private static Term Fdel (Domain domain, Variable vari, Term[] args) { if (vari == null) - throw new Exception (Qwrong_calling_format, "No vname attribute"); - if (vari.Value.IsStr) - { - string str - = vari.Value.Strval.Remove (args[0].Intval, - args[1].Intval - args[0].Intval); - vari.SetValue (str); - } + throw new Error (Error.NoVariableName, "No variable name to set"); + Term term = vari.Value; + if (term.IsStr) + term.objval = term.Strval.Remove (args[0].Intval, + args[1].Intval - args[0].Intval); else if (vari.Value.IsList) vari.Value.Listval.RemoveRange (args[0].Intval, args[1].Intval - args[0].Intval); else - throw new Exception (Qwrong_type, "{0} is not a string nor a list", - vari.Value); - return vari.Value; + throw new Error (Error.WrongType, "Not a string nor a list: {0}", + vari.Value); + return term; } private static Term Fand (Domain domain, Variable vari, Term[] args) @@ -1544,7 +1455,7 @@ namespace System.Xml private static Term Fbreak (Domain domain, Variable vari, Term[] args) { if (! domain.ThrowBreak ()) - return domain.ThrowError (new Term (Error.NoOuterLoop, null)); + return domain.ThrowError (new Term (Error.NoLoopToBreak, null)); return args.Length == 0 ? Zero : args[0]; } @@ -1661,9 +1572,9 @@ namespace System.Xml Term result= Zero; caught = false; - for (int i = idx; i < args.Length; i++) + for (int i = idx; i < terms.Length; i++) { - result = args[i].Eval (domain); + result = terms[i].Eval (domain); if (domain.Thrown (out caught)) break; } @@ -1676,32 +1587,40 @@ namespace System.Xml bool caught = false; if (args.Length < 2) - throw new Exception (Error.WrongCallingFormat, - "too fee arguments: {0}", args.Length); - if (args[0].IsError) + throw new Error (Error.WrongArgument, + "Too few arguments: {0}", args.Length); + ErrorTerm err = args[0].objval as ErrorTerm; + if (err != null) { - int count = domain.CallStackCount; - try { - result = evaluate_terms (domain, args, 1, out caught); - } catch (Exception e) { + result = eval_terms (domain, args, 1, out caught); + } catch (Error e) { if (! args[0].Matches (e.ErrorTerm)) throw e; - ((ErrorTerm) e.ErrorTerm.objval). if (vari != null) - vari.Value = e.ErrorTerm; - domain.CallStackPop (count); + vari.SetValue (e.ErrorTerm); + return One; + } catch (System.Exception e) { + Term term = new Term (new ErrorTerm (e)); + if (! args[0].Matches (term)) + throw e; + if (vari != null) + vari.SetValue (term); return One; } } else if (args[0].IsSymbol) { domain.Catch (new CatchTag (args[0].Symval)); - result = evaluate_terms (domain, args, 1, out caught); + result = eval_terms (domain, args, 1, out caught); domain.Uncatch (); } + else + throw new Error (Error.WrongArgument, + "Not a symbol nor an error: {0}", args[0]); + if (vari != null) - vari.Value = result; + vari.SetValue (result); return Zero; } @@ -1714,8 +1633,8 @@ namespace System.Xml } if (args[0].IsError) return domain.ThrowError (args[0]); - return domain.ThrowError (new Term (Error.InvalidArgumentType, - args[0].ToString ())); + throw new Error (Error.WrongArgument, + "Not a symbol nor an error: {0}", args[0]); } public abstract class TermValue @@ -1785,13 +1704,13 @@ namespace System.Xml if (nargs < func.min_args || (func.max_args >= 0 && nargs > func.max_args)) - throw new Exception (Qwrong_calling_format, - "Wrong number of arguments to {0}: {1}", - func.name, nargs); + throw new Error (Error.WrongArgument, + "Wrong number of arguments to {0}: {1}", + func.name, nargs); if (! func.with_var && vari != null) - throw new Exception (Qwrong_calling_format, - "Wrong vname attribute to {0}: {1}", - func.name, vari.name); + throw new Error (Error.WrongArgument, + "Wrong vname attribute to {0}: {1}", + func.name, vari.name); this.func = func; this.vari = vari; this.args = args; @@ -1882,6 +1801,20 @@ namespace System.Xml this.message = message; } + internal ErrorTerm (Exception e) + { + if (e is ArithmeticException) + ename = Error.ArithmeticException; + 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]; @@ -2092,14 +2025,18 @@ namespace System.Xml public bool IsList { get { return (objval is List); } } public bool IsError { get { return (objval is ErrorTerm); } } - private Term Eval (Domain domain) + internal Term Eval (Domain domain) { if (objval == null || objval is Symbol || objval is string || objval is List) return this; domain.CallStackPush (this); - Term result = ((TermValue) objval).Eval (domain); - domain.CallStackPop (); + Term result; + try { + result = ((TermValue) objval).Eval (domain); + } finally { + domain.CallStackPop (); + } return result; } @@ -2220,9 +2157,8 @@ namespace System.Xml private static int parse_integer (XmlNode node) { - str = node.InnerText; + string str = node.InnerText; int len = str.Length; - bool negative = false; int i, c; if (len == 1 && str[0] == '?') @@ -2230,34 +2166,109 @@ namespace System.Xml if (len > 2 && str[1] == 'x' && ((c = str[0]) == '0' || c == '#')) { - if (! int.TryParse (str.SubString (2), NumberStyles.HexNumber, null, + if (! int.TryParse (str.Substring (2), + Globalization.NumberStyles.HexNumber, null, out i)) - Exception.Throw (Qparse_error, node, "Invalid integer"); + throw new Error (Error.InvalidInteger, node, + "Not a integer string: {0}", str); return i; } if (! int.TryParse (str, out i)) - Exception.Throw (Qparse_error, node, "Invalid integer"); + throw new Error (Error.InvalidInteger, node, + "Not a integer string: {0}", str); return i; } - static bool parse_error (XmlNode node, out Term term) + private static Symbol parse_defvar (Domain domain, XmlNode node) { - try { - term = new Term (node.OuterXml); - } catch { - term = memory_error; - } - return false; - } + XmlAttribute name = node.Attributes[Qvname]; + if (name == null) + throw new Error (Error.NoVariableName, node, + "No variable name to define"); + Symbol vname = name.Value; + String desc; + Variable vari; - static bool parse_error (XmlNode node, out Term[] terms) - { - try { - terms = new Term[] { new Term (node.OuterXml) }; - } catch { - terms = new Term[] { memory_error }; - } - return false; + node = node.FirstChild; + if (node != null && node.Name == Qdescription) + { + desc = node.InnerText; + node = node.NextSibling; + } + else + desc = null; + if (node != null) + { + Symbol type = node.Name; + XmlNodeList range_list = null; + int nranges = 0; + XmlNode n = node.NextSibling; + + if (n != null) + { + range_list = n.ChildNodes; + nranges = range_list.Count; + } + + if (type == Qinteger) + { + int val = parse_integer (node); + int[] range = null; + if (range_list != null) + { + range = new int[nranges * 2]; + for (int i = 0; i < nranges; i++) + { + XmlNode nd = range_list[i]; + if (nd.Name == Qrange) + { + range[i * 2] = parse_integer (nd.FirstChild); + range[i * 2 + 1] = parse_integer (nd.LastChild); + } + else + { + range[i * 2] = range[i * 2 + 1] + = parse_integer (nd.FirstChild); + } + } + } + vari = domain.DefvarInt (vname, val, desc, range); + } + else if (type == Qstring) + { + string[] range = null; + if (range_list != null) + { + range = new string[nranges]; + for (int i = 0; i < nranges; i++) + range[i] = range_list[i].FirstChild.InnerText; + } + vari = domain.DefvarStr (vname, node.InnerText, desc, range); + } + else if (type == Qsymbol) + { + Symbol[] range = null; + if (range_list != null) + { + range = new Symbol[nranges]; + for (int i = 0; i < nranges; i++) + range[i] = range_list[i].FirstChild.InnerText; + } + vari = domain.DefvarSym (vname, (Symbol) node.InnerText, desc, + range); + } + else + throw new Error (Error.TermTypeInvalid, "Unknown type: {0}", type); + } + else + { + if (domain.variables.TryGetValue (vname, out vari)) + vari = vari.Clone (domain); + else + vari = new Variable (domain, vname, Zero); + domain.variables[vname] = vari; + } + return vname; } private static Variable[] parse_args (Domain domain, XmlNode node, @@ -2281,7 +2292,8 @@ namespace System.Xml else if (n.Name == Qrest) nrest++; else - throw new Exception (Qinvalid_argument_type, n); + throw new Error (Error.WrongType, n, + "Not fixed, optional, nor rest: {0}", n.Name); } min_args = nfixed; max_args = nfixed + noptional + nrest; @@ -2310,16 +2322,16 @@ namespace System.Xml Variable[] args; try { - args = parse_head (domain, node, out min_args, out max_args); + 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 (Exception e) { + } catch (Error e) { if (e.ErrorNode == null) e.ErrorNode = node; throw e; - } catch (System.Exception e) { + } catch (Exception e) { throw new Exception (node, e); } return name;