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<Symbol>
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;
}
}
- 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;
{
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; } }
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;
}
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<Domain, Variable, Term[], Term> builtin,
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);
{
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)
{
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)
{
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)
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;
}
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];
}
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)
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)
}
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)
}
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)
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)
}
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)
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)
result = ((List<Term>) 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;
}
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)
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];
}
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;
}
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;
}
}
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
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;
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];
public bool IsList { get { return (objval is List<Term>); } }
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<Term>)
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;
}
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] == '?')
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,
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;
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;
projects / m17n / m17n-lib-cs.git / commitdiff