X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=XmlExpr.cs;h=4646decb4adb440ecb47b046fdf02a4ea15bbac8;hb=23cc9b572f2d4a5e1fe693a6b58978647e6191d4;hp=86048c82c980164f7ee28c89920632710a7c0317;hpb=7f78377ff82ebee0c3c1892a1fe8f12611c09b13;p=m17n%2Fm17n-lib-cs.git diff --git a/XmlExpr.cs b/XmlExpr.cs index 86048c8..4646dec 100644 --- a/XmlExpr.cs +++ b/XmlExpr.cs @@ -10,58 +10,58 @@ namespace System.Xml.Expression { public static int debug_level = 0; - public struct Name : IEquatable + public struct Symbol : IEquatable { private static NameTable nt = new NameTable (); - private string name; + internal string name; - public Name (string str) + public Symbol (string str) { name = nt.Add (str); } - public static implicit operator Name (string str) + public static implicit operator Symbol (string str) { - return new Name (str); + return new Symbol (str); } - public static implicit operator string (Name name) + public static implicit operator string (Symbol name) { return name.name; } - public static bool operator== (Name n1, Name n2) + public static bool operator== (Symbol n1, Symbol n2) { return (object) n1.name == (object) n2.name; } - public static bool operator!= (Name n1, Name n2) + public static bool operator!= (Symbol n1, Symbol n2) { return (object) n1.name != (object) n2.name; } - public static bool operator== (Name n1, string n2) + public static bool operator== (Symbol n1, string n2) { return (object) n1.name == (object) n2; } - public static bool operator!= (Name n1, string n2) + public static bool operator!= (Symbol n1, string n2) { return (object) n1.name != (object) n2; } - public static bool operator== (string n1, Name n2) + public static bool operator== (string n1, Symbol n2) { return (object) n1 == (object) n2.name; } - public static bool operator!= (string n1, Name n2) + public static bool operator!= (string n1, Symbol n2) { return (object) n1 != (object) n2.name; } - public bool Equals (Name name) + public bool Equals (Symbol name) { return Object.ReferenceEquals (this.name, name.name); } @@ -81,40 +81,37 @@ namespace System.Xml.Expression public override string ToString () { return name; } } - private static Name Nexpr = "expr"; - - private static Name Nfuncall = "funcall"; - private static Name Nvarref = "varref"; - private static Name Ninteger = "integer"; - private static Name Nstring = "string"; - private static Name Nsymbol = "symbol"; - private static Name Nlist = "list"; - - private static Name Ndefun = "defun"; - private static Name Nfname = "fname"; - private static Name Nargs = "args"; - private static Name Nargs_unevalled = "args-unevalled"; - private static Name Nfixed = "fixed"; - private static Name Noptional = "optional"; - private static Name Nrest = "rest"; - - private static Name Ndefvar = "defvar"; - private static Name Nvname = "vname"; - private static Name Ndescription = "description"; - private static Name Nrange = "range"; - - private static Name Nprogn = "progn"; - private static Name Nloop = "loop"; - private static Name Nfunction = "function"; - - internal abstract class Function + private static Symbol Nexpr = "expr"; + + private static Symbol Nnull = ""; + private static Symbol Nfuncall = "funcall"; + private static Symbol Nvarref = "varref"; + private static Symbol Ninteger = "integer"; + private static Symbol Nstring = "string"; + private static Symbol Nsymbol = "symbol"; + private static Symbol Nlist = "list"; + + private static Symbol Ndefun = "defun"; + private static Symbol Nfname = "fname"; + private static Symbol Nargs = "args"; + private static Symbol Nargs_unevalled = "args-unevalled"; + private static Symbol Nfixed = "fixed"; + private static Symbol Noptional = "optional"; + private static Symbol Nrest = "rest"; + + private static Symbol Ndefvar = "defvar"; + private static Symbol Nvname = "vname"; + private static Symbol Ndescription = "description"; + private static Symbol Nrange = "range"; + + public abstract class Function { - public Name name; + public Symbol name; public int min_arg, max_arg; public Function () { } - public Function (Name name, int min_arg, int max_arg) + public Function (Symbol name, int min_arg, int max_arg) { this.name = name; this.min_arg = min_arg; @@ -133,7 +130,7 @@ namespace System.Xml.Expression public Builtin builtin; public bool setvar; - public Subroutine (Builtin builtin, Name name, bool setvar, + public Subroutine (Builtin builtin, Symbol name, bool setvar, int min_arg, int max_arg) : base (name, min_arg, max_arg) { @@ -142,11 +139,14 @@ namespace System.Xml.Expression public override Term Call (Domain domain, Variable vari, Term[] args) { - Term[] newargs = new Term[args.Length]; - + args = (Term[]) args.Clone (); for (int i = 0; i < args.Length; i++) - newargs[i] = args[i].Eval (domain); - return builtin (domain, vari, newargs); + { + args[i] = args[i].Eval (domain); + if (domain.Thrown) + return args[i]; + } + return builtin (domain, vari, args); } } @@ -154,7 +154,7 @@ namespace System.Xml.Expression { public Builtin builtin; - public SpecialForm (Builtin builtin, Name name, + public SpecialForm (Builtin builtin, Symbol name, int min_arg, int max_arg) : base (name, min_arg, max_arg) { @@ -173,46 +173,85 @@ namespace System.Xml.Expression internal Variable[] args; internal Term[] body; - public Lambda (XmlNode node, Domain domain) - { - int nfixed = 0; - int noptional = 0; - int nrest = 0; - name = node.Attributes[Nfname].Value; + public Lambda (Domain domain, XmlNode node) + { + int nfixed = 0; + int noptional = 0; + int nrest = 0; + name = node.Attributes[Nfname].Value; - node = node.FirstChild; - if (node != null - && (node.Name == Nargs || node.Name == Nargs_unevalled)) - { - XmlNode n; - args_evalled = node.Name == Nargs; - for (n = node.FirstChild; n != null; n = n.NextSibling) - { - if (n.Name == Nfixed) - nfixed++; - else if (n.Name == Noptional) - noptional++; - else if (n.Name == Nrest) - nrest++; - else - throw new Exception ("Invalid argument type: " + n); - } - min_arg = nfixed; - max_arg = nfixed + noptional + nrest; - args = new Variable[max_arg]; - n = node.FirstChild; - for (int i = 0; i < max_arg; n = n.NextSibling) - args[i++] = domain.Defvar ((Name) n.Attributes[0].Value); - if (nrest == 1) - max_arg = - max_arg; - } - else - { - min_arg = max_arg = 0; - } - } + node = node.FirstChild; + if (node != null + && (node.Name == Nargs || node.Name == Nargs_unevalled)) + { + XmlNode n; + args_evalled = node.Name == Nargs; + for (n = node.FirstChild; n != null; n = n.NextSibling) + { + if (n.Name == Nfixed) + nfixed++; + else if (n.Name == Noptional) + noptional++; + else if (n.Name == Nrest) + nrest++; + else + throw new Exception ("Invalid argument type: " + n); + } + min_arg = nfixed; + max_arg = nfixed + noptional + nrest; + args = new Variable[max_arg]; + n = node.FirstChild; + for (int i = 0; i < max_arg; n = n.NextSibling) + args[i++] = domain.Defvar ((Symbol) n.Attributes[0].Value); + if (nrest == 1) + max_arg = - max_arg; + } + else + { + min_arg = max_arg = 0; + } + } + + public Lambda (Domain domain, Symbol name, bool args_evalled, Symbol[] args) + { + int nfixed = 0; + int noptional = 0; + int nrest = 0; - public void SetBody (XmlNode node, Domain domain) + this.name = name; + this.args_evalled = args_evalled; + if (args != null) + { + int i = 0; + for (i = 0; i < args.Length; i++, nfixed++) + if (args[i] == Noptional || args[i] == Nrest) + break; + if (i < args.Length) + { + if (args[i] == Noptional) + { + for (i++; i < args.Length; i++, noptional++) + if (args[i] == Nrest) + break; + if (i < args.Length) + nrest = 1; + } + } + min_arg = nfixed; + max_arg = nfixed + noptional + nrest; + this.args = new Variable[max_arg]; + int j; + for (i = j = 0; j < this.args.Length; i++) + if (args[i] != Noptional || args[i] != Nrest) + this.args[j++] = domain.Defvar (args[i]); + } + else + { + min_arg = max_arg = 0; + } + } + + public void SetBody (Domain domain, XmlNode node) { for (node = node.FirstChild; node != null; node = node.NextSibling) if (node.Name != Ndescription @@ -226,10 +265,15 @@ namespace System.Xml.Expression { body = new Term[nterms]; for (nterms = 0; node != null; node = node.NextSibling, nterms++) - body[nterms] = new Term (node, domain); + body[nterms] = new Term (domain, node); } } + public void SetBody (Term[] body) + { + this.body = body; + } + public override Term Call (Domain domain, Variable vari, Term[] args) { Bindings current = domain.bindings; @@ -247,8 +291,21 @@ namespace System.Xml.Expression for (i = 0; i < min_arg; i++) domain.Bind (this.args[i], args[i]); if (body != null) - foreach (Term term in body) - result = term.Eval (domain); + { + try { + if (args_evalled) + domain.Catch (CatchTag.Return); + foreach (Term term in body) + { + result = term.Eval (domain); + if (domain.Thrown) + return result; + } + } finally { + if (args_evalled) + domain.Uncatch (); + } + } } finally { domain.UnboundTo (current); } @@ -257,84 +314,228 @@ namespace System.Xml.Expression } } - public abstract class Variable + public class Variable : TermValue { - public readonly Name name; + public readonly Symbol name; + public string desc; + internal Term default_val; internal Term val; + object range; - public Variable (Name name, Term term) + public Variable (Symbol name, Term value) { this.name = name; - Value = term; + val = value; + default_val = Zero; + } + + public virtual bool ValueP (Term val) { return true; } + + public override TermValue Clone () + { + Variable v = new Variable (name, val); + v.desc = desc; + v.default_val = default_val; + v.range = range; + return v; } public Term Value { get { return val; } - set - { - if (! ValueP (value)) - throw new Exception ("Invalid value of " + name + ": " + value); - val = value; - } + set { + if (! ValueP (value)) + throw new Exception ("Invalid value: " + value); + val = value; + } } - public abstract bool ValueP (Term term); + public Term DefaultValue + { + get { return default_val; } + set { + if (! ValueP (value)) + throw new Exception ("Invalid value: " + value); + default_val = value; + } + } + + public virtual object Range + { + get { return range; } + set { range = value; } + } + + public override Term Eval (Domain domain) { return val; } public override string ToString () { return name + "(" + val + ")"; } - internal class Int : Variable + public class Int : Variable { - public struct Range - { - public int from, to; - } + public int[] range; + + private static bool SubsetP (int[] r1, int[] r2) + { + if (r2 == null) + return true; + for (int i = 0; i < r1.Length; i += 2) + { + int j; + for (j = 0; j < r2.Length; j += 2) + if (r2[j] <= r1[i] && r2[j + 1] >= r1[i + 1]) + break; + if (j >= r2.Length) + return false; + } + return true; + } - public Range[] ranges; + private static bool SubsetP (int val, int[] r) + { + if (r == null) + return true; + for (int i = 0; i < r.Length; i += 2) + if (r[i] <= val && r[i + 1] >= val) + return true; + return false; + } - public Int (Name name, int i) : base (name, new Term (i)) { } + public Int (Symbol name, string description, int value, int[] range) + : base (name, new Term (value)) + { + if (! SubsetP (value, range)) + throw new Exception ("Invalid value: " + value); + desc = description; + default_val = val; + this.range = range; + } public override bool ValueP (Term term) { - int i; - - if (term.objval != null) + if (! term.IsInt) return false; - if (ranges == null) - return true; - i = term.intval; - foreach (Range r in ranges) - if (i >= r.from && i <= r.to) - return true; - return false; + return SubsetP (term.Intval, range); + } + + public override object Range { + get { return range; } + set { + int[] r = (int[]) value; + if (! SubsetP (r, range) + || ! SubsetP (val.Intval, r) + || ! SubsetP (default_val.Intval, r)) + throw new Exception ("Invalid range"); + range = r; + } } } - internal class Str : Variable + public class Str : Variable { - public string[] ranges; + public string[] range; - public Str (Name name, string str) : base (name, new Term (str)) { } + private static bool SubsetP (string[] r1, string[] r2) + { + if (r2 == null) + return true; + foreach (string s in r1) + if (! SubsetP (s, r2)) + return false; + return true; + } + + private static bool SubsetP (string str, string[] r) + { + if (r == null) + return true; + foreach (string s in r) + if (str == s) + return true; + return false; + } + + public Str (Symbol name, string description, string value, string[] range) + : base (name, new Term (value)) + { + if (! SubsetP (value, range)) + throw new Exception ("Invalid value: " + value); + desc = description; + default_val = val; + this.range = range; + } public override bool ValueP (Term term) { if (! (term.objval is string)) return false; - if (ranges == null) - return true; - string str = (string) term.objval; - foreach (string s in ranges) - if (s == str) - return true; - return false; + return SubsetP (term.Strval, range); + } + + public override object Range { + get { return range; } + set { + string[] r = (string[]) value; + if (! SubsetP (r, range) + || ! SubsetP (val.Strval, r) + || ! SubsetP (default_val.Strval, r)) + throw new Exception ("Invalid range"); + range = r; + } } } - internal class Misc : Variable + public class Sym : Variable { - public Misc (Name name, Term term) : base (name, term) { } + public Symbol[] range; + + private static bool SubsetP (Symbol[] r1, Symbol[] r2) + { + if (r2 == null) + return true; + foreach (Symbol n in r1) + if (! SubsetP (n, r2)) + return false; + return true; + } + + private static bool SubsetP (Symbol name, Symbol[] r) + { + if (r == null) + return true; + foreach (Symbol n in r) + if (name == n) + return true; + return false; + } + + public Sym (Symbol name, string description, Symbol value, Symbol[] range) + : base (name, new Term (value)) + { + if (! SubsetP (value, range)) + throw new Exception ("Invalid value: " + value); + desc = description; + default_val = val; + this.range = range; + } + + public override bool ValueP (Term term) + { + if (! (term.objval is Symbol)) + return false; + return SubsetP (term.Symval, range); + } - public override bool ValueP (Term term) { return true; } + public override object Range { + get { return range; } + set { + Symbol[] r = (Symbol[]) value; + if (! SubsetP (r, range) + || ! SubsetP (val.Symval, r) + || ! SubsetP (default_val.Symval, r)) + throw new Exception ("Invalid range"); + range = r; + } + } } } @@ -378,10 +579,10 @@ namespace System.Xml.Expression #if false internal class ThrowException : Exception { - Name tag; + Symbol tag; public object value; - public ThrowException (Name tag, object value) : base () + public ThrowException (Symbol tag, object value) : base () { this.tag = tag; this.value = value; @@ -389,16 +590,26 @@ namespace System.Xml.Expression } #endif - internal struct CatchTag + internal class CatchTag : IEquatable { - public readonly Name name; - public readonly int count; + private object val; - public CatchTag (Name name, int count) - { - this.name = name; - this.count = count; - } + public CatchTag (Symbol name) { val = name.name; } + private CatchTag (int i) { val = i; } + + public static CatchTag Return = new CatchTag (0); + public static CatchTag Break = new CatchTag (1); + + public static bool operator== (CatchTag t1, CatchTag t2) + { return t1.val == t2.val; } + + public static bool operator!= (CatchTag t1, CatchTag t2) + { return t1.val != t2.val; } + + public bool Equals (CatchTag tag) { return this.val == tag.val; } + public override bool Equals (object val) { return this.val == val; } + + public override int GetHashCode () { return val.GetHashCode (); } } public class Domain @@ -406,26 +617,24 @@ namespace System.Xml.Expression public object context; public int depth = 0; - internal Dictionary functions; - internal Dictionary variables; + internal Dictionary termtypes + = new Dictionary (); + internal Dictionary functions + = new Dictionary (); + internal Dictionary variables + = new Dictionary (); internal Bindings bindings; - internal Stack catch_list = new Stack (); + private Stack catch_stack = new Stack (); private int catch_count = 0; - internal Domain () - { - functions = new Dictionary (); - variables = new Dictionary (); - } + internal Domain () { } - public Domain (object context) : this (basic, context) - { - } + public Domain (object context) : this (basic, context) { } public Domain (Domain parent, object context) { - functions = new Dictionary (parent.functions); - variables = new Dictionary (parent.variables); + functions = new Dictionary (parent.functions); + variables = new Dictionary (parent.variables); this.context = context; } @@ -440,94 +649,133 @@ namespace System.Xml.Expression bindings = bindings.UnboundTo (boundary); } - internal void Catch (Name name) + internal void Catch (CatchTag tag) + { + catch_stack.Push (tag); + catch_count++; + } + + internal void Uncatch () { - catch_list.Push (new CatchTag (name, catchcount++)); + catch_stack.Pop (); + if (catch_count > catch_stack.Count) + catch_count--; } - internal bool Catched { - get { return catch_list.Peek ().count == catchcount; } + public bool Thrown { + get { return catch_count < catch_stack.Count; } } internal void ThrowReturn () { - CatchTag tag = catch_list.Peek (); - while (tag.name != Nreturn) + foreach (CatchTag tag in catch_stack) { - catch_list.Pop (); - tag = catch_list.Peek (); + catch_count--; + if (tag == CatchTag.Return) + break; } - catchcount = tag.count; } internal void ThrowBreak () { - catch_list.Peek ().count = catchcount; + if (catch_stack.Peek () != CatchTag.Break) + throw new Exception ("No outer loop to break"); + catch_count--; } - internal void Uncatch () + internal void ThrowTag (CatchTag tag) { - catch_list.Pop (); + foreach (CatchTag elt in catch_stack) + { + catch_count--; + if (elt == tag) + break; + } + } + + public void DefType (Symbol name, NewObject new_object) + { + termtypes[name] = new TermType (name, new_object); } public void DefSubr (Builtin builtin, string str, bool setvar, int min_arg, int max_arg, params string[] aliases) { - Name name = str; + Symbol name = str; Function func = new Function.Subroutine (builtin, name, setvar, min_arg, max_arg); functions[name] = func; foreach (string a in aliases) - functions[(Name) a] = func; + functions[(Symbol) a] = func; } public void DefSpecial (Builtin builtin, string str, int min_arg, int max_arg, params string[] aliases) { - Name name = str; + Symbol name = str; Function func = new Function.SpecialForm (builtin, name, min_arg, max_arg); functions[name] = func; foreach (string a in aliases) - functions[(Name) a] = func; + functions[(Symbol) a] = func; } public void DefAlias (string alias, string str) { - functions[(Name) alias] = functions[(Name) str]; + functions[(Symbol) alias] = functions[(Symbol) str]; } - internal Function.Lambda RegisterFunction (XmlNode node) + public void Defun (Symbol name, bool args_evalled, + Symbol[] args, Term[] body, bool prototype) { - Function.Lambda lambda = new Function.Lambda (node, this); + Function func; - functions[lambda.name] = lambda; - return lambda; + if (prototype || ! functions.TryGetValue (name, out func)) + { + func = new Function.Lambda (this, name, args_evalled, args); + functions[name] = func; + } + if (! prototype) + ((Function.Lambda) func).SetBody (body); } - internal Function Defun (XmlNode node) + public void Defun (XmlNode node, bool prototype) { - Name name = node.Attributes[Nfname].Value; + Symbol name = node.Attributes[Nfname].Value; Function func; - if (! functions.TryGetValue (name, out func)) - func = RegisterFunction (node); - ((Function.Lambda) func).SetBody (node, this); - return func; + if (prototype || ! functions.TryGetValue (name, out func)) + { + func = new Function.Lambda (this, node); + functions[name] = func; + } + if (! prototype) + ((Function.Lambda) func).SetBody (this, node); } - public void Defvar (XmlNode node) + public void Defun (Function func) { - Name name = node.Attributes[0].Value; + functions[func.name] = func; + } + + public Variable Defvar (XmlNode node) + { + Symbol name = node.Attributes[0].Value; + String desc; Variable vari; node = node.FirstChild; - if (node.Name == Ndescription) - node = node.NextSibling; + if (node != null && node.Name == Ndescription) + { + desc = node.InnerText; + node = node.NextSibling; + } + else + desc = null; if (node != null) { - Name type = node.Name; + Symbol type = node.Name; XmlNodeList range_list = null; int nranges = 0; string val = node.InnerText; @@ -541,56 +789,120 @@ namespace System.Xml.Expression if (type == Ninteger) { - Variable.Int vi = new Variable.Int (name, parse_integer (val)); + int intval = parse_integer (val); + int[] range = null; if (range_list != null) { - vi.ranges = new Variable.Int.Range[nranges]; - + range = new int[nranges * 2]; for (int i = 0; i < nranges; i++) { XmlNode n = range_list[i]; - if (n.Name == Nrange) { - vi.ranges[i].from = - parse_integer (n.FirstChild.InnerText); - vi.ranges[i].to = - parse_integer (n.LastChild.InnerText); + range[i * 2] + = parse_integer (n.FirstChild.InnerText); + range[i * 2 + 1] + = parse_integer (n.LastChild.InnerText); } else { - int num = parse_integer (n.InnerText); - vi.ranges[i].from = vi.ranges[i].to = num; + range[i * 2] + = range[i * 2 + 1] + = parse_integer (n.FirstChild.InnerText); } } } - vari = vi; + + if (variables.TryGetValue (name, out vari)) + { + if (! (vari is Variable.Int)) + throw new Exception ("Inalid value"); + vari = (Variable) vari.Clone (); + Term v = new Term (intval); + vari.Value = v; + vari.DefaultValue = v; + if (range != null) + vari.Range = range; + } + else + vari = new Variable.Int (name, desc, intval, range); } else if (type == Nstring) { - Variable.Str vs = new Variable.Str (name, val); + string[] range = null; if (range_list != null) - vs.ranges = new string[nranges]; - for (int i = 0; i < nranges; i++) - vs.ranges[i] = range_list[i].Value; - vari = vs; + { + range = new string[nranges]; + for (int i = 0; i < nranges; i++) + range[i] = range_list[i].FirstChild.InnerText; + } + + if (variables.TryGetValue (name, out vari)) + { + if (! (vari is Variable.Str)) + throw new Exception ("Invalid value"); + vari = (Variable) vari.Clone (); + Term v = new Term (val); + vari.Value = v; + vari.DefaultValue = v; + if (range != null) + vari.Range = range; + } + else + vari = new Variable.Str (name, desc, val, range); + } + else if (type == Nsymbol) + { + 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; + } + + if (variables.TryGetValue (name, out vari)) + { + if (! (vari is Variable.Sym)) + throw new Exception ("Invalid value"); + vari = (Variable) vari.Clone (); + Term v = new Term (val); + vari.Value = v; + vari.DefaultValue = v; + if (range != null) + vari.Range = range; + } + else + vari = new Variable.Sym (name, desc, val, range); } else throw new Exception ("Unknown type: " + type); } else - vari = new Variable.Misc (name, Zero); + { + if (variables.TryGetValue (name, out vari)) + vari = (Variable) vari.Clone (); + else + vari = new Variable (name, Zero); + } variables[name] = vari; + return vari; } - internal Variable Defvar (Name name) + public Variable Defvar (Variable vari) { - Variable vari = new Variable.Misc (name, Zero); + variables[vari.name] = vari; + return vari; + } + + internal Variable Defvar (Symbol name) + { + Variable vari = new Variable (name, Zero); variables[name] = vari; return vari; } - internal Function GetFunc (Name name) + internal Function GetFunc (Symbol name) { Function func; @@ -599,7 +911,7 @@ namespace System.Xml.Expression return func; } - public bool CopyFunc (Domain domain, Name name) + public bool CopyFunc (Domain domain, Symbol name) { Function func = GetFunc (name); @@ -609,26 +921,30 @@ namespace System.Xml.Expression public void CopyFunc (Domain domain) { - foreach (KeyValuePair kv in functions) + foreach (KeyValuePair kv in functions) domain.functions[kv.Key] = kv.Value; } - internal Variable GetVar (Name name) + public Variable GetVar (Symbol name, bool create) { Variable vari; if (! variables.TryGetValue (name, out vari)) - variables[name] = vari = new Variable.Misc (name, Zero); + { + if (! create) + return null; + variables[name] = vari = new Variable (name, Zero); + } return vari; } public override string ToString () { string str = "<(functions"; - foreach (KeyValuePair kv in functions) + foreach (KeyValuePair kv in functions) str += " " + kv.Key; str += ") (variabls"; - foreach (KeyValuePair kv in variables) + foreach (KeyValuePair kv in variables) str += " " + kv.Key; str += ")"; if (bindings != null) @@ -652,92 +968,109 @@ namespace System.Xml.Expression Console.Write (fmt, arg); } } + + public object SaveValues () + { + Dictionary values = new Dictionary (); + + foreach (KeyValuePair kv in variables) + values[kv.Value] = kv.Value.val.Clone (); + return values; + } + + public void RestoreValues (object values) + { + foreach (KeyValuePair kv + in (Dictionary) values) + kv.Key.val = kv.Value; + } } public delegate Term Builtin (Domain domain, Variable vari, Term[] args); private static Domain basic = new Domain (); - internal static Function Fprogn; - static Xexpression () { - basic.DefSubr (set_value, "set", true, 1, 1, "="); - basic.DefSubr (not, "not", false, 1, 1, "!"); - basic.DefSubr (add, "add", true, 1, -1, "+"); - basic.DefSubr (mul, "mul", true, 1, -1, "*"); - basic.DefSubr (sub, "sub", true, 1, -1, "-"); - basic.DefSubr (div, "div", true, 1, -1, "/"); - basic.DefSubr (mod, "mod", true, 1, 2, "%"); - basic.DefSubr (logior, "logior", true, 1, -1, "|"); - basic.DefSubr (logand, "logand", true, 1, -1, "&"); - basic.DefSubr (lsh, "lsh", true, 1, 2, "<<"); - basic.DefSubr (rsh, "rsh", true, 1, 2, ">>"); - basic.DefSubr (eq, "eq", false, 2, -1, "=="); - basic.DefSubr (noteq, "noteq", false, 2, 2, "!="); - basic.DefSubr (less_than, "lt", false, 2, -1, "<"); - basic.DefSubr (less_eq, "le", false, 2, -1, "<="); - basic.DefSubr (greater_than, "gt", false, 2, -1, ">"); - basic.DefSubr (greater_eq, "ge", false, 2, -1, ">="); - basic.DefSubr (append, "append", true, 0, -1); - basic.DefSubr (concat, "concat", true, 0, -1); - basic.DefSubr (nth, "nth", false, 2, 2); - basic.DefSubr (copy, "copy", false, 1, 1); - basic.DefSubr (ins, "ins", true, 2, 2); - basic.DefSubr (del, "del", true, 2, 2); - basic.DefSubr (eval_clause, "eval", false, 1, 1); - basic.DefSubr (break_clause, "break", false, 0, 1); - basic.DefSubr (return_clause, "return", false, 1, 1); - basic.DefSpecial (and, "and", 1, -1, "&&"); - basic.DefSpecial (or, "or", 1, -1, "||"); - basic.DefSpecial (progn_clause, "progn", 0, -1, "expr"); - basic.DefSpecial (if_clause, "if", 2, 3); - basic.DefSpecial (when_clause, "when", 1, -1); - basic.DefSpecial (loop_clause, "loop", 1, -1); - basic.DefSpecial (while_clause, "while", 1, -1); - basic.DefSpecial (cond_clause, "cond", 1, -1); - basic.DefSpecial (foreach_clause, "foreach", 2, -1); - basic.DefSpecial (quote_clause, "quote", 1, 1); - basic.DefSpecial (type_clause, "type", 1, 1); - - Fprogn = basic.GetFunc (Nprogn); + basic.DefType ("funcall", Funcall.New); + + basic.DefSubr (Fset, "set", true, 1, 1, "="); + basic.DefSubr (Fnot, "not", false, 1, 1, "!"); + basic.DefSubr (Fadd, "add", true, 1, -1, "+"); + basic.DefSubr (Fmul, "mul", true, 1, -1, "*"); + basic.DefSubr (Fsub, "sub", true, 1, -1, "-"); + basic.DefSubr (Fdiv, "div", true, 1, -1, "/"); + basic.DefSubr (Fmod, "mod", true, 1, 2, "%"); + basic.DefSubr (Flogior, "logior", true, 1, -1, "|"); + basic.DefSubr (Flogand, "logand", true, 1, -1, "&"); + basic.DefSubr (Flsh, "lsh", true, 1, 2, "<<"); + basic.DefSubr (Frsh, "rsh", true, 1, 2, ">>"); + basic.DefSubr (Feq, "eq", false, 2, -1, "=="); + basic.DefSubr (Fnoteq, "noteq", false, 2, 2, "!="); + basic.DefSubr (Flt, "lt", false, 2, -1, "<"); + basic.DefSubr (Fle, "le", false, 2, -1, "<="); + basic.DefSubr (Fgt, "gt", false, 2, -1, ">"); + basic.DefSubr (Fge, "ge", false, 2, -1, ">="); + basic.DefSubr (Fappend, "append", true, 0, -1); + basic.DefSubr (Fconcat, "concat", true, 0, -1); + basic.DefSubr (Fnth, "nth", false, 2, 2); + basic.DefSubr (Fcopy, "copy", false, 1, 1); + basic.DefSubr (Fins, "ins", true, 2, 2); + basic.DefSubr (Fdel, "del", true, 2, 2); + basic.DefSubr (Feval, "eval", false, 1, 1); + basic.DefSubr (Fbreak, "break", false, 0, 1); + basic.DefSubr (Freturn, "return", false, 0, 1); + + basic.DefSpecial (Fand, "and", 1, -1, "&&"); + basic.DefSpecial (For, "or", 1, -1, "||"); + basic.DefSpecial (Fprogn, "progn", 0, -1, "expr"); + basic.DefSpecial (Fif, "if", 2, 3); + basic.DefSpecial (Fwhen, "when", 1, -1); + basic.DefSpecial (Floop, "loop", 1, -1); + basic.DefSpecial (Fwhile, "while", 1, -1); + basic.DefSpecial (Fcond, "cond", 1, -1); + basic.DefSpecial (Fforeach, "foreach", 2, -1); + basic.DefSpecial (Fquote, "quote", 1, 1); + basic.DefSpecial (Ftype, "type", 1, 1); + basic.DefSpecial (Fcatch, "catch", 2, 2); + basic.DefSpecial (Fthrow, "throw", 1, 2); } - private static Term set_value (Domain domain, Variable vari, Term[] args) + private static Term Fset (Domain domain, Variable vari, Term[] args) { vari.Value = args[0]; return vari.val; } - private static Term not (Domain domain, Variable vari, Term[] args) + private static Term Fnot (Domain domain, Variable vari, Term[] args) { return args[0].IsTrue ? Zero : One; } - private static Term add (Domain domain, Variable vari, Term[] args) + private static Term Fadd (Domain domain, Variable vari, Term[] args) { int n = vari == null ? 0 : vari.val.Intval; foreach (Term arg in args) - n += (int) arg; + n += arg.Intval; if (vari == null) - return n; + return new Term (n); vari.val.intval = n; return vari.val; } - private static Term mul (Domain domain, Variable vari, Term[] args) + private static Term Fmul (Domain domain, Variable vari, Term[] args) { int n = vari == null ? 1 : vari.val.Intval; foreach (Term arg in args) - n *= (int) arg; + n *= arg.Intval; if (vari == null) - return n; + return new Term (n); vari.val.intval = n; return vari.val; } - private static Term sub (Domain domain, Variable vari, Term[] args) + private static Term Fsub (Domain domain, Variable vari, Term[] args) { int n, i; @@ -752,14 +1085,14 @@ namespace System.Xml.Expression i = 0; } while (i < args.Length) - n -= (int) args[i++]; + n -= args[i++].Intval; if (vari == null) - return n; + return new Term (n); vari.val.intval = n; return vari.val; } - private static Term div (Domain domain, Variable vari, Term[] args) + private static Term Fdiv (Domain domain, Variable vari, Term[] args) { int n, i; @@ -776,31 +1109,31 @@ namespace System.Xml.Expression while (i < args.Length) n /= args[i++].Intval; if (vari == null) - return n; + return new Term (n); vari.val.intval = n; return vari.val; } - private static Term mod (Domain domain, Variable vari, Term[] args) + private static Term Fmod (Domain domain, Variable vari, Term[] args) { if (vari == null) - return (args[0].Intval % args[1].Intval); + return new Term (args[0].Intval % args[1].Intval); vari.val.intval = vari.val.Intval % args[0].Intval; return vari.val; } - private static Term logior (Domain domain, Variable vari, Term[] args) + private static Term Flogior (Domain domain, Variable vari, Term[] args) { int n = vari == null ? 0 : vari.val.Intval; foreach (Term arg in args) - n |= (int) arg; + n |= arg.Intval; if (vari == null) - return n; + return new Term (n); vari.val.intval = n; return vari.val; } - private static Term logand (Domain domain, Variable vari, Term[] args) + private static Term Flogand (Domain domain, Variable vari, Term[] args) { int n, i; @@ -815,30 +1148,30 @@ namespace System.Xml.Expression i = 0; } while (i < args.Length) - n &= (int) args[i++]; + n &= args[i++].Intval; if (vari == null) - return n; + return new Term (n); vari.val.intval = n; return vari.val; } - private static Term lsh (Domain domain, Variable vari, Term[] args) + private static Term Flsh (Domain domain, Variable vari, Term[] args) { if (vari == null) - return args[0].Intval << args[1].Intval; + return new Term (args[0].Intval << args[1].Intval); vari.val.intval = vari.val.Intval << args[0].Intval; return vari.val; } - private static Term rsh (Domain domain, Variable vari, Term[] args) + private static Term Frsh (Domain domain, Variable vari, Term[] args) { if (vari == null) - return args[0].Intval >> args[1].Intval; + return new Term (args[0].Intval >> args[1].Intval); vari.val.intval = vari.val.Intval >> args[0].Intval; return vari.val; } - private static Term eq (Domain domain, Variable vari, Term[] args) + private static Term Feq (Domain domain, Variable vari, Term[] args) { Term o = args[0]; @@ -857,18 +1190,18 @@ namespace System.Xml.Expression return One; } - private static Term noteq (Domain domain, Variable vari, Term[] args) + private static Term Fnoteq (Domain domain, Variable vari, Term[] args) { - return eq (domain, vari, args); + return Feq (domain, vari, args); } - private static Term less_than (Domain domain, Variable vari, Term[] args) + private static Term Flt (Domain domain, Variable vari, Term[] args) { - int n = (int) args[0]; + int n = args[0].Intval; for (int i = 1; i < args.Length; i++) { - int n1 = (int) args[i]; + int n1 = args[i].Intval; if (n >= n1) return Zero; n = n1; @@ -876,12 +1209,12 @@ namespace System.Xml.Expression return One; } - private static Term less_eq (Domain domain, Variable vari, Term[] args) + private static Term Fle (Domain domain, Variable vari, Term[] args) { - int n = (int) args[0]; + int n = args[0].Intval; for (int i = 1; i < args.Length; i++) { - int n1 = (int) args[i]; + int n1 = args[i].Intval; if (n > n1) return Zero; n = n1; @@ -889,12 +1222,12 @@ namespace System.Xml.Expression return One; } - private static Term greater_than (Domain domain, Variable vari, Term[] args) + private static Term Fgt (Domain domain, Variable vari, Term[] args) { - int n = (int) args[0]; + int n = args[0].Intval; for (int i = 1; i < args.Length; i++) { - int n1 = (int) args[i]; + int n1 = args[i].Intval; if (n <= n1) return Zero; n = n1; @@ -902,12 +1235,12 @@ namespace System.Xml.Expression return One; } - private static Term greater_eq (Domain domain, Variable vari, Term[] args) + private static Term Fge (Domain domain, Variable vari, Term[] args) { - int n = (int) args[0]; + int n = args[0].Intval; for (int i = 1; i < args.Length; i++) { - int n1 = (int) args[i]; + int n1 = args[i].Intval; if (n < n1) return Zero; n = n1; @@ -915,7 +1248,7 @@ namespace System.Xml.Expression return One; } - private static Term append (Domain domain, Variable vari, Term[] args) + private static Term Fappend (Domain domain, Variable vari, Term[] args) { List list; @@ -938,11 +1271,10 @@ namespace System.Xml.Expression result.objval = list; return result; } - vari.val.objval = list; return vari.val; } - private static Term concat (Domain domain, Variable vari, Term[] args) + private static Term Fconcat (Domain domain, Variable vari, Term[] args) { string str; @@ -972,7 +1304,7 @@ namespace System.Xml.Expression return vari.val; } - private static Term nth (Domain domain, Variable vari, Term[] args) + private static Term Fnth (Domain domain, Variable vari, Term[] args) { Term result; @@ -990,7 +1322,7 @@ namespace System.Xml.Expression return result; } - private static Term copy (Domain domain, Variable vari, Term[] args) + private static Term Fcopy (Domain domain, Variable vari, Term[] args) { Term result; @@ -999,7 +1331,7 @@ namespace System.Xml.Expression return result; } - private static Term ins (Domain domain, Variable vari, Term[] args) + private static Term Fins (Domain domain, Variable vari, Term[] args) { if (vari.val.IsStr) vari.val.objval @@ -1011,7 +1343,7 @@ namespace System.Xml.Expression return vari.val; } - private static Term del (Domain domain, Variable vari, Term[] args) + private static Term Fdel (Domain domain, Variable vari, Term[] args) { if (vari.val.IsStr) vari.val.objval @@ -1026,7 +1358,7 @@ namespace System.Xml.Expression return vari.val; } - private static Term and (Domain domain, Variable vari, Term[] args) + private static Term Fand (Domain domain, Variable vari, Term[] args) { foreach (Term arg in args) if (! arg.Eval (domain).IsTrue) @@ -1034,7 +1366,7 @@ namespace System.Xml.Expression return One; } - private static Term or (Domain domain, Variable vari, Term[] args) + private static Term For (Domain domain, Variable vari, Term[] args) { foreach (Term arg in args) if (arg.Eval (domain).IsTrue) @@ -1042,12 +1374,12 @@ namespace System.Xml.Expression return Zero; } - private static Term eval_clause (Domain domain, Variable vari, Term[] args) + private static Term Feval (Domain domain, Variable vari, Term[] args) { return (args[0].Eval (domain)); } - private static Term progn_clause (Domain domain, Variable vari, Term[] args) + private static Term Fprogn (Domain domain, Variable vari, Term[] args) { Term result = One; @@ -1056,7 +1388,7 @@ namespace System.Xml.Expression return result; } - private static Term if_clause (Domain domain, Variable vari, Term[] args) + private static Term Fif (Domain domain, Variable vari, Term[] args) { if (args[0].Eval (domain).IsTrue) return args[1].Eval (domain); @@ -1065,7 +1397,7 @@ namespace System.Xml.Expression return args[2].Eval (domain); } - private static Term when_clause (Domain domain, Variable vari, Term[] args) + private static Term Fwhen (Domain domain, Variable vari, Term[] args) { if (! args[0].Eval (domain).IsTrue) return Zero; @@ -1075,45 +1407,29 @@ namespace System.Xml.Expression return result; } - private static Term break_clause (Domain domain, Variable vari, Term[] args) + private static Term Freturn (Domain domain, Variable vari, Term[] args) { - Stack clist = domain.catch_list; - if (clist.Count == 0) - throw new Exception ("No outer loop to break"); - CatchTag tag = clist.Peek (); - if (tag.name != Nloop) - throw new Exception ("No outer loop to break"); - domain.depth = tag.depth; + domain.ThrowReturn (); return args.Length == 0 ? Zero : args[0]; } - private static Term return_clause (Domain domain, Variable vari, Term[] args) + private static Term Fbreak (Domain domain, Variable vari, Term[] args) { - Stack clist = domain.catch_list; - - while (clist.Count > 0) - { - CatchTag tag = clist.Pop (); - if (tag.name == Nfunction) - { - domain.depth = tag.depth; - return = args.Length == 0 ? Zero : args[0]; - } - } + domain.ThrowBreak (); return args.Length == 0 ? Zero : args[0]; } - private static Term loop_clause (Domain domain, Variable vari, Term[] args) + private static Term Floop (Domain domain, Variable vari, Term[] args) { - domain.Catch (Nloop); Term result = Zero; try { - while (! domain.Catched) + domain.Catch (CatchTag.Break); + while (! domain.Thrown) foreach (Term arg in args) { result = arg.Eval (domain); - if (domain.Catched) - break; + if (domain.Thrown) + return result; } } finally { domain.Uncatch (); @@ -1121,15 +1437,25 @@ namespace System.Xml.Expression return result; } - private static Term while_clause (Domain domain, Variable vari, Term[] args) + private static Term Fwhile (Domain domain, Variable vari, Term[] args) { - while (args[0].Eval (domain).IsTrue) - for (int i = 1; i < args.Length; i++) - args[i].Eval (domain); - return Zero; + Term result = Zero; + try { + domain.Catch (CatchTag.Break); + while (! domain.Thrown && args[0].Eval (domain).IsTrue) + for (int i = 1; i < args.Length; i++) + { + result = args[i].Eval (domain); + if (domain.Thrown) + return result; + } + } finally { + domain.Uncatch (); + } + return result; } - private static Term cond_clause (Domain domain, Variable vari, Term[] args) + private static Term Fcond (Domain domain, Variable vari, Term[] args) { foreach (Term arg in args) { @@ -1146,57 +1472,190 @@ namespace System.Xml.Expression return Zero; } - private static Term foreach_clause (Domain domain, Variable vari, + private static Term Fforeach (Domain domain, Variable vari, Term[] args) { - List list = args[0].Listval; + Term result = args[0].Eval (domain); + if (domain.Thrown) + return result; + List list = result.Listval; Bindings current = domain.bindings; - foreach (Term term in list) - { - domain.Bind (vari, term); - try { - for (int i = 1; i < args.Length; i++) - args[i].Eval (domain); - } finally { - domain.UnboundTo (current); + try { + domain.Catch (CatchTag.Break); + foreach (Term term in list) + { + domain.Bind (vari, term); + try { + for (int i = 1; i < args.Length; i++) + { + result = args[i].Eval (domain); + if (domain.Thrown) + return result; + } + } finally { + domain.UnboundTo (current); + } } - } - return Zero; + } finally { + domain.Uncatch (); + } + return result; } - private static Term quote_clause (Domain domain, Variable vari, Term[] args) + private static Term Fquote (Domain domain, Variable vari, Term[] args) { return new Term (args[0]); } - private static Term type_clause (Domain domain, Variable vari, Term[] args) + private static Term Ftype (Domain domain, Variable vari, Term[] args) { if (args[0].IsInt) return TermInt; if (args[0].IsStr) return TermStr; - if (args[0].IsName) - return TermName; + if (args[0].IsSymbol) + return TermSymbol; if (args[0].IsList) return TermList; return TermTerm; } + public static Term Fcatch (Domain domain, Variable vari, Term[] args) + { + Term result = Zero; + try { + domain.Catch (new CatchTag (args[0].Symval)); + result = args[1].Eval (domain); + } finally { + domain.Uncatch (); + } + return result; + } + + public static Term Fthrow (Domain domain, Variable vari, Term[] args) + { + domain.ThrowTag (new CatchTag (args[0].Symval)); + return (args.Length == 1 ? Zero : args[1]); + } + + public delegate TermValue NewObject (Domain domain, XmlNode node); + + public class TermType + { + public readonly Symbol type; + internal readonly NewObject New; + + public TermType (Symbol type, NewObject new_object) + { + this.type = type; + New = new_object; + } + } + + public abstract class TermValue + { + public virtual Term Eval (Domain domain) { return new Term (this); } + public abstract TermValue Clone (); + } + + private class Funcall : TermValue + { + internal Function func; + internal Variable vari; + internal Term[] args; + + private Funcall (Function func, Variable vari, Term[] args) + { + this.func = func; + this.vari = vari; + this.args = args; + } + + public Funcall (Domain domain, Symbol fname, Term[] args) + { + func = domain.GetFunc (fname); + this.args = args; + } + + public Funcall (Domain domain, Symbol fname, Symbol vname, Term[] args) + { + func = domain.GetFunc (fname); + int nargs = args.Length; + if (nargs < func.min_arg + || (func.max_arg >= 0 && nargs > func.max_arg)) + throw new Exception ("Invalid number of arguments to: " + + fname + " " + nargs); + this.args = args; + if (vname != Nnull) + vari = domain.GetVar (vname, true); + } + + internal static TermValue New (Domain domain, XmlNode node) + { + Symbol fname = node.Name; + Symbol vname = Nnull; + XmlAttribute attr; + + if (fname == Nfuncall) + fname = node.Attributes[Nfname].Value; + attr = node.Attributes[Nvname]; + if (attr != null) + vname = 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]); + return new Funcall (domain, fname, vname, args); + } + + public override Term Eval (Domain domain) + { + domain.DebugWrite (true, "(({0}", func.name); + for (int i = 0; i < args.Length; i++) + domain.DebugWrite (false, " {0}", args[i].ToString ()); + domain.DebugWrite (false, ")"); + domain.depth++; + Term result = func.Call (domain, vari, args); + domain.depth--; + domain.DebugWrite (true, " ==> {0})", result.ToString ()); + return result; + } + + public override TermValue Clone () + { + return new Funcall (func, vari, args); + } + + public override string ToString () + { + string str = ""; + str += "\">"; + foreach (Term e in args) + str += e; + return (str + ""); + } + } + public struct Term { public int intval; public object objval; public Term (int i) { intval = i; objval = null; } - public Term (Name name) { intval = 0; objval = name; } + public Term (Symbol name) { intval = 0; objval = name; } public Term (string str) { intval = 0; objval = str; } public Term (List list) { intval = 0; objval = list; } - public Term (Term term) { intval = 0; objval = term; } + public Term (Term term) { intval = term.intval; objval = term.objval; } + public Term (TermValue obj) { intval = 0; objval = obj; } - public Term (XmlNode node, Domain domain) + public Term (Domain domain, XmlNode node) { - Name name = node.Name; + Symbol name = node.Name; if (name == Ninteger) { @@ -1207,80 +1666,48 @@ namespace System.Xml.Expression { intval = 0; if (name == Nsymbol) - objval = (Name) node.InnerText; + objval = (Symbol) node.InnerText; else if (name == Nstring) objval = node.InnerText.Clone (); else if (name == Nvarref) - objval = domain.GetVar ((Name) node.Attributes[0].Value); + objval = domain.GetVar ((Symbol) node.Attributes[0].Value, true); else if (name == Nlist) { List list = new List (); for (node = node.FirstChild; node != null; node = node.NextSibling) - list.Add (new Term (node, domain)); + list.Add (new Term (domain, node)); objval = list; } else { - Function func; - Variable vari = null; - Term[] args; - - if (name == Nfuncall) - name = node.Attributes[0].Value; - else if (node.Attributes[Nvname] != null) - vari = domain.GetVar (node.Attributes[Nvname].Value); - func = domain.GetFunc (name); - XmlNodeList nlist = node.ChildNodes; - int nargs = nlist.Count; - - if (nargs < func.min_arg - || (func.max_arg >= 0 && nargs > func.max_arg)) - throw new Exception ("Invalid number of arguments to: " - + name + " " + nargs); - args = new Term[nargs]; - for (int i = 0; i < nlist.Count; i++) - args[i] = new Term (nlist[i], domain); - objval = new Funcall (func, vari, args); + TermType term_type; + + if (domain.termtypes.TryGetValue (name, out term_type)) + objval = term_type.New (domain, node); + else + objval = Funcall.New (domain, node); } } } - private class Funcall - { - internal Function func; - internal Variable vari; - internal Term[] args; - - public Funcall (Function func, Variable vari, Term[] args) + public Term (Domain domain, Symbol fname, Term[] args) { - this.func = func; - this.vari = vari; - this.args = args; + intval = 0; + objval = new Funcall (domain, fname, args); } - public Term Eval (Domain domain) + public Term (Domain domain, Symbol fname, Symbol vname, Term[] args) { - domain.DebugWrite (true, "(({0}", func.name); - for (int i = 0; i < args.Length; i++) - domain.DebugWrite (false, " {0}", args[i].ToString ()); - domain.DebugWrite (false, ")"); - domain.depth++; - Term result = func.Call (domain, vari, args); - domain.depth--; - domain.DebugWrite (true, " ==> {0})", result.ToString ()); - return result; + intval = 0; + objval = new Funcall (domain, fname, vname, args); } - public override string ToString () - { - string str = ""; - str += "\">"; - foreach (Term e in args) - str += e; - return (str + ""); + public object Objval { + get { + if (objval == null) + throw new Exception ("term is an integer: " + this); + return objval; } } @@ -1300,6 +1727,14 @@ namespace System.Xml.Expression } } + public string Symval { + get { + if (! IsSymbol) + throw new Exception ("term is not symbol: " + this); + return (Symbol) objval; + } + } + public List Listval { get { if (! IsList) @@ -1319,39 +1754,35 @@ namespace System.Xml.Expression } public bool IsInt { get { return (objval == null); } } public bool IsStr { get { return (objval is string); } } - public bool IsName { get { return (objval is Name); } } + public bool IsSymbol { get { return (objval is Symbol); } } public bool IsList { get { return (objval is List); } } + public bool IsType (Type type) + { + return (objval == null ? type == typeof (int) + : type == objval.GetType ()); + } + public Term Eval (Domain domain) { - if (objval == null || objval is Name || objval is string) + if (objval == null || objval is Symbol || objval is string) return this; if (objval is List) return new Term ((List) objval); - if (objval is Funcall) - return ((Funcall) objval).Eval (domain); - if (objval is Variable) - return ((Variable) objval).val; - if (objval is Term) - return (Term) objval; - throw new Exception ("invalid Term object: " + objval); - } - - public static explicit operator int (Term term) - { - if (term.objval != null) - throw new Exception ("Not an integer term: " + term); - return term.intval; - } - - public static explicit operator Name (Term term) - { - return (Name) term.objval; + return ((TermValue) objval).Eval (domain); } - public static implicit operator Term (int i) + public Term Clone () { - return new Term (i); + if (objval == null || objval is Symbol || objval is string) + return this; + if (objval is List) + { + List list = new List (); + list.InsertRange (0, ((List) objval)); + return new Term (list); + } + return new Term (((TermValue) objval).Clone ()); } public override string ToString () @@ -1360,7 +1791,7 @@ namespace System.Xml.Expression if (objval == null) str = "" + intval + ""; - else if (objval is Name) + else if (objval is Symbol) str = "" + objval + ""; else if (objval is string) str = "" + objval + ""; @@ -1383,13 +1814,13 @@ namespace System.Xml.Expression } } - static Term Zero = new Term (0); - static Term One = new Term (1); - static Term TermInt = new Term (Ninteger); - static Term TermStr = new Term (Nstring); - static Term TermName = new Term (Nsymbol); - static Term TermList = new Term (Nlist); - static Term TermTerm = new Term ((Name) "term"); + static private Term Zero = new Term (0); + static private Term One = new Term (1); + static private Term TermInt = new Term (Ninteger); + static private Term TermStr = new Term (Nstring); + static private Term TermSymbol = new Term (Nsymbol); + static private Term TermList = new Term (Nlist); + static private Term TermTerm = new Term ((Symbol) "term"); internal static int parse_integer (string str) { @@ -1402,7 +1833,9 @@ namespace System.Xml.Expression int c = str[0]; int i; - if (c == '0' && str[1] == 'x') + if (c == '?') + return str[1]; + if ((c == '0' || c == '#') && str[1] == 'x') { i = 0; for (int idx = 2; idx < len; idx++) @@ -1440,29 +1873,14 @@ namespace System.Xml.Expression private Term[] terms; - public Xexpression (string url, Domain domain) + private void parse_terms (Domain domain, XmlNode node) { - XmlDocument doc = new XmlDocument (Name.Table); - XmlNode node; - - using (XmlTextReader reader = new XmlTextReader (url, Name.Table)) - { - do { - reader.Read (); - } while (reader.NodeType != XmlNodeType.None - && (reader.NodeType != XmlNodeType.Element - || reader.Name != Nexpr)); - if (reader.NodeType == XmlNodeType.None) - throw new Exception ("Node not found"); - node = doc.ReadNode (reader); - } - int nterms = 0; - for (XmlNode n = node.FirstChild; n != null; n = n.NextSibling) + for (XmlNode n = node; n != null; n = n.NextSibling) if (n.NodeType == XmlNodeType.Element) { if (n.Name == Ndefun) - domain.RegisterFunction (n); + domain.Defun (n, true); else if (n.Name == Ndefvar) domain.Defvar (n); else @@ -1471,23 +1889,56 @@ namespace System.Xml.Expression terms = new Term[nterms]; int i = 0; - for (XmlNode n = node.FirstChild; n != null; n = n.NextSibling) + for (XmlNode n = node; n != null; n = n.NextSibling) if (n.NodeType == XmlNodeType.Element) { if (n.Name == Ndefun) - domain.Defun (n); + domain.Defun (n, false); else if (n.Name != Ndefvar) - terms[i++]= new Term (n, domain); + terms[i++]= new Term (domain, n); } } + public Xexpression (Domain domain, XmlNode node) + { + parse_terms (domain, node); + } + + public Xexpression (Domain domain, string url) + { + XmlDocument doc = new XmlDocument (Symbol.Table); + XmlNode node; + + using (XmlTextReader reader = new XmlTextReader (url, Symbol.Table)) + { + do { + reader.Read (); + } while (reader.NodeType != XmlNodeType.None + && (reader.NodeType != XmlNodeType.Element + || reader.Name != Nexpr)); + if (reader.NodeType == XmlNodeType.None) + throw new Exception ("Node not found"); + node = doc.ReadNode (reader); + } + parse_terms (domain, node.FirstChild); + } + public Term Eval (Domain domain) { Term result = Zero; domain.depth = 0; - foreach (Term term in terms) - result = term.Eval (domain); + try { + domain.Catch (CatchTag.Return); + foreach (Term term in terms) + { + result = term.Eval (domain); + if (domain.Thrown) + return result; + } + } finally { + domain.Uncatch (); + } return result; }