X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=XmlExpr.cs;h=ae56091073a2401c19645aa12c3cf682026de769;hb=948496e0c55cfffced24b1053d17b19a9369f747;hp=86048c82c980164f7ee28c89920632710a7c0317;hpb=7f78377ff82ebee0c3c1892a1fe8f12611c09b13;p=m17n%2Fm17n-lib-cs.git diff --git a/XmlExpr.cs b/XmlExpr.cs index 86048c8..ae56091 100644 --- a/XmlExpr.cs +++ b/XmlExpr.cs @@ -14,7 +14,7 @@ namespace System.Xml.Expression { private static NameTable nt = new NameTable (); - private string name; + internal string name; public Name (string str) { @@ -103,11 +103,7 @@ namespace System.Xml.Expression 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 + public abstract class Function { public Name name; public int min_arg, max_arg; @@ -142,11 +138,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); } } @@ -247,8 +246,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 +269,220 @@ namespace System.Xml.Expression } } - public abstract class Variable + public class Variable : TermValue { public readonly Name name; + public string desc; + internal Term default_val; internal Term val; + object range; - public Variable (Name name, Term term) + public Variable (Name name, Term value) { this.name = name; - Value = term; + val = value; + default_val = Zero; + } + + public virtual bool ValueP (Term val) { return true; } + + public Variable 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 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 abstract bool ValueP (Term term); + 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; - public Range[] ranges; + 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 Int (Name name, int i) : base (name, new Term (i)) { } + 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, 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) + { + foreach (string s in r1) + if (! SubsetP (s, r2)) + return false; + return true; + } + + private static bool SubsetP (string str, string[] r) + { + foreach (string s in r) + if (str == s) + return true; + return false; + } + + public Str (Name 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 Name[] range; + + private static bool SubsetP (Name[] r1, Name[] r2) + { + foreach (Name n in r1) + if (! SubsetP (n, r2)) + return false; + return true; + } + + private static bool SubsetP (Name name, Name[] r) + { + foreach (Name n in r) + if (name == n) + return true; + return false; + } - public override bool ValueP (Term term) { return true; } + public Sym (Name name, string description, Name value, Name[] 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 Name)) + return false; + return SubsetP (term.Nameval, range); + } + + public override object Range { + get { return range; } + set { + Name[] r = (Name[]) value; + if (! SubsetP (r, range) + || ! SubsetP (val.Nameval, r) + || ! SubsetP (default_val.Nameval, r)) + throw new Exception ("Invalid range"); + range = r; + } + } } } @@ -389,16 +537,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 (Name 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 @@ -407,9 +565,11 @@ namespace System.Xml.Expression public int depth = 0; internal Dictionary functions; + internal Dictionary> + modules = new Dictionary> (); internal Dictionary variables; internal Bindings bindings; - internal Stack catch_list = new Stack (); + private Stack catch_stack = new Stack (); private int catch_count = 0; internal Domain () @@ -440,34 +600,48 @@ namespace System.Xml.Expression bindings = bindings.UnboundTo (boundary); } - internal void Catch (Name name) + internal void Catch (CatchTag tag) { - catch_list.Push (new CatchTag (name, catchcount++)); + catch_stack.Push (tag); + catch_count++; } - internal bool Catched { - get { return catch_list.Peek ().count == catchcount; } + internal void Uncatch () + { + catch_stack.Pop (); + if (catch_count > catch_stack.Count) + catch_count--; + } + + internal 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 DefSubr (Builtin builtin, string str, bool setvar, @@ -506,7 +680,12 @@ namespace System.Xml.Expression return lambda; } - internal Function Defun (XmlNode node) + public void Defun (Name name, Name[] args, bool args_evalled) + { + Function func = new Function.Lambda (this, name, args, args_evalled) + } + + public void Defun (XmlNode node) { Name name = node.Attributes[Nfname].Value; Function func; @@ -514,17 +693,22 @@ namespace System.Xml.Expression if (! functions.TryGetValue (name, out func)) func = RegisterFunction (node); ((Function.Lambda) func).SetBody (node, this); - return func; } - public void Defvar (XmlNode node) + public Variable Defvar (XmlNode node) { Name name = node.Attributes[0].Value; + String desc; Variable vari; node = node.FirstChild; if (node.Name == Ndescription) - node = node.NextSibling; + { + desc = node.InnerText; + node = node.NextSibling; + } + else + desc = null; if (node != null) { Name type = node.Name; @@ -541,51 +725,115 @@ 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.InnerText); } } } - vari = vi; + + if (variables.TryGetValue (name, out vari)) + { + if (! (vari is Variable.Int)) + throw new Exception ("Inalid value"); + vari = 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].InnerText; + } + + if (variables.TryGetValue (name, out vari)) + { + if (! (vari is Variable.Str)) + throw new Exception ("Invalid value"); + vari = 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) + { + Name[] range = null; + if (range_list != null) + { + range = new Name[nranges]; + for (int i = 0; i < nranges; i++) + range[i] = range_list[i].InnerText; + } + + if (variables.TryGetValue (name, out vari)) + { + if (! (vari is Variable.Sym)) + throw new Exception ("Invalid value"); + vari = 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 = vari.Clone (); + else + vari = new Variable (name, Zero); + } variables[name] = vari; + return vari; + } + + public Variable Defvar (Variable vari) + { + variables[vari.name] = vari; + return vari; } internal Variable Defvar (Name name) { - Variable vari = new Variable.Misc (name, Zero); + Variable vari = new Variable (name, Zero); variables[name] = vari; return vari; } @@ -613,12 +861,16 @@ namespace System.Xml.Expression domain.functions[kv.Key] = kv.Value; } - internal Variable GetVar (Name name) + public Variable GetVar (Name 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; } @@ -658,63 +910,61 @@ namespace System.Xml.Expression 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.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; @@ -726,7 +976,7 @@ namespace System.Xml.Expression 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) @@ -737,7 +987,7 @@ namespace System.Xml.Expression 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; @@ -759,7 +1009,7 @@ namespace System.Xml.Expression 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; @@ -781,7 +1031,7 @@ namespace System.Xml.Expression 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); @@ -789,7 +1039,7 @@ namespace System.Xml.Expression 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) @@ -800,7 +1050,7 @@ namespace System.Xml.Expression 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; @@ -822,7 +1072,7 @@ namespace System.Xml.Expression 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; @@ -830,7 +1080,7 @@ namespace System.Xml.Expression 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; @@ -838,7 +1088,7 @@ namespace System.Xml.Expression 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,12 +1107,12 @@ 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]; @@ -876,7 +1126,7 @@ 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]; for (int i = 1; i < args.Length; i++) @@ -889,7 +1139,7 @@ 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]; for (int i = 1; i < args.Length; i++) @@ -902,7 +1152,7 @@ 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]; for (int i = 1; i < args.Length; i++) @@ -915,7 +1165,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 +1188,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 +1221,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 +1239,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 +1248,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 +1260,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 +1275,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 +1283,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 +1291,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 +1305,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 +1314,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 +1324,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 +1354,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,31 +1389,43 @@ 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; @@ -1183,6 +1438,95 @@ namespace System.Xml.Expression return TermTerm; } + public static Term Fcatch (Domain domain, Variable vari, Term[] args) + { + Term result = Zero; + try { + domain.Catch (new CatchTag (args[0].Nameval)); + 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].Nameval)); + return (args.Length == 1 ? Zero : args[1]); + } + + public class TermValue + { + public virtual Term Eval (Domain domain) { return new Term (this); } + } + + private class Funcall : TermValue + { + internal Function func; + internal Variable vari; + internal Term[] args; + + public Funcall (XmlNode node, Domain domain) + { + vari = null; + Name name = node.Name; + + if (name == Nfuncall) + name = node.Attributes[0].Value; + else if (node.Attributes[Nvname] != null) + vari = domain.GetVar (node.Attributes[Nvname].Value, true); + 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); + } + + public Funcall (Domain domain, Name fname, Term[] args) + { + func = domain.GetFunc (fname); + this.args = args; + } + + public Funcall (Domain domain, Name fname, Name vname, Term[] args) + { + func = domain.GetFunc (fname); + vari = domain.GetVar (vname, true); + this.args = 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 string ToString () + { + string str = ""; + str += "\">"; + foreach (Term e in args) + str += e; + return (str + ""); + } + } + public struct Term { public int intval; @@ -1192,7 +1536,8 @@ namespace System.Xml.Expression public Term (Name 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) { @@ -1211,7 +1556,7 @@ namespace System.Xml.Expression else if (name == Nstring) objval = node.InnerText.Clone (); else if (name == Nvarref) - objval = domain.GetVar ((Name) node.Attributes[0].Value); + objval = domain.GetVar ((Name) node.Attributes[0].Value, true); else if (name == Nlist) { List list = new List (); @@ -1221,66 +1566,15 @@ namespace System.Xml.Expression 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); - } + objval = new Funcall (node, domain); } } - private class Funcall - { - internal Function func; - internal Variable vari; - internal Term[] args; - - public Funcall (Function func, Variable vari, Term[] args) - { - this.func = func; - this.vari = vari; - this.args = args; - } - - public 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 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 +1594,14 @@ namespace System.Xml.Expression } } + public string Nameval { + get { + if (! IsName) + throw new Exception ("term is not symbol: " + this); + return (Name) objval; + } + } + public List Listval { get { if (! IsList) @@ -1322,18 +1624,20 @@ namespace System.Xml.Expression public bool IsName { get { return (objval is Name); } } 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) 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; + if (objval is TermValue) + return ((TermValue) objval).Eval (domain); throw new Exception ("invalid Term object: " + objval); } @@ -1383,13 +1687,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 TermName = new Term (Nsymbol); + static private Term TermList = new Term (Nlist); + static private Term TermTerm = new Term ((Name) "term"); internal static int parse_integer (string str) { @@ -1402,7 +1706,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,25 +1746,10 @@ 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) @@ -1471,7 +1762,7 @@ 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) @@ -1481,13 +1772,46 @@ namespace System.Xml.Expression } } + public Xexpression (Domain domain, XmlNode node) + { + parse_terms (domain, node); + } + + public Xexpression (Domain domain, string url) + { + 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); + } + 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; }