X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=XmlExpr.cs;h=ae56091073a2401c19645aa12c3cf682026de769;hb=948496e0c55cfffced24b1053d17b19a9369f747;hp=2ab34f26001f85dd0ce9f103571a9b5c00aa5d2e;hpb=c6e7c78626156216ba804f51fe818edbc63d4955;p=m17n%2Fm17n-lib-cs.git diff --git a/XmlExpr.cs b/XmlExpr.cs index 2ab34f2..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) { @@ -84,7 +84,7 @@ namespace System.Xml.Expression private static Name Nexpr = "expr"; private static Name Nfuncall = "funcall"; - private static Name Nvariable = "variable"; + private static Name Nvarref = "varref"; private static Name Ninteger = "integer"; private static Name Nstring = "string"; private static Name Nsymbol = "symbol"; @@ -94,17 +94,16 @@ namespace System.Xml.Expression 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 Nbody = "body"; 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"; - - internal abstract class Function + public abstract class Function { public Name name; public int min_arg, max_arg; @@ -118,7 +117,7 @@ namespace System.Xml.Expression this.max_arg = max_arg; } - public abstract Term Call (Domain domain, Term[] args); + public abstract Term Call (Domain domain, Variable vari, Term[] args); public override string ToString () { @@ -128,21 +127,25 @@ namespace System.Xml.Expression internal class Subroutine : Function { public Builtin builtin; + public bool setvar; - public Subroutine (Builtin builtin, Name name, + public Subroutine (Builtin builtin, Name name, bool setvar, int min_arg, int max_arg) : base (name, min_arg, max_arg) { this.builtin = builtin; } - public override Term Call (Domain domain, Term[] args) + 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, newargs); + { + args[i] = args[i].Eval (domain); + if (domain.Thrown) + return args[i]; + } + return builtin (domain, vari, args); } } @@ -157,21 +160,23 @@ namespace System.Xml.Expression this.builtin = builtin; } - public override Term Call (Domain domain, Term[] args) + public override Term Call (Domain domain, Variable vari, Term[] args) { - return builtin (domain, args); + return builtin (domain, vari, args); } } internal class Lambda : Function { internal bool args_evalled; - internal Term[] args; + internal Variable[] args; internal Term[] body; - public Lambda (XmlNode node) + public Lambda (XmlNode node, Domain domain) { - int nargs = 0, noptions = 0, nrest = 0; + int nfixed = 0; + int noptional = 0; + int nrest = 0; name = node.Attributes[Nfname].Value; node = node.FirstChild; @@ -182,26 +187,21 @@ namespace System.Xml.Expression args_evalled = node.Name == Nargs; for (n = node.FirstChild; n != null; n = n.NextSibling) { - if (n.Name != Nsymbol) - break; - nargs++; + 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); } - if (n != null && n.Name == Noptional) - for (n = n.NextSibling; n != null; n = n.NextSibling) - { - if (n.Name == Nrest) - break; - noptions++; - } - if (n != null) - nrest++; - min_arg = nargs; - max_arg = nargs + noptions + nrest; - args = new Term[max_arg]; + 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) - if (n.Name == Nsymbol) - args[i++] = new Term (n, null); + args[i++] = domain.Defvar ((Name) n.Attributes[0].Value); if (nrest == 1) max_arg = - max_arg; } @@ -213,20 +213,23 @@ namespace System.Xml.Expression public void SetBody (XmlNode node, Domain domain) { - - for (node = node.FirstChild; node != null && node.Name != Nbody; - node = node.NextSibling); - if (node != null) + for (node = node.FirstChild; node != null; node = node.NextSibling) + if (node.Name != Ndescription + && node.Name != Nargs + && node.Name != Nargs_unevalled) + break; + int nterms = 0; + for (XmlNode n = node; n != null; n = n.NextSibling) + nterms++; + if (nterms > 0) { - XmlNodeList nlist = node.ChildNodes; - - body = new Term[nlist.Count]; - for (int i = 0; i < nlist.Count; i++) - body[i] = new Term (nlist[i], domain); + body = new Term[nterms]; + for (nterms = 0; node != null; node = node.NextSibling, nterms++) + body[nterms] = new Term (node, domain); } } - public override Term Call (Domain domain, Term[] args) + public override Term Call (Domain domain, Variable vari, Term[] args) { Bindings current = domain.bindings; Term result = Zero; @@ -241,13 +244,23 @@ namespace System.Xml.Expression args = newargs; } for (i = 0; i < min_arg; i++) + domain.Bind (this.args[i], args[i]); + if (body != null) { - Variable vari = domain.GetVar ((Name) this.args[i]); - domain.Bind (vari, args[i]); + 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 (); + } } - if (body != null) - foreach (Term term in body) - result = term.Eval (domain); } finally { domain.UnboundTo (current); } @@ -256,84 +269,220 @@ namespace System.Xml.Expression } } - internal 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 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; - 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; + } + + 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 (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 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 bool ValueP (Term term) { return true; } + 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; + } + } } } @@ -388,14 +537,40 @@ namespace System.Xml.Expression } #endif + internal class CatchTag : IEquatable + { + private object val; + + 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 { public object context; public int depth = 0; internal Dictionary functions; + internal Dictionary> + modules = new Dictionary> (); internal Dictionary variables; internal Bindings bindings; + private Stack catch_stack = new Stack (); + private int catch_count = 0; internal Domain () { @@ -425,11 +600,55 @@ namespace System.Xml.Expression bindings = bindings.UnboundTo (boundary); } - public void DefSubr (Builtin builtin, string str, + internal void Catch (CatchTag tag) + { + catch_stack.Push (tag); + catch_count++; + } + + 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 () + { + foreach (CatchTag tag in catch_stack) + { + catch_count--; + if (tag == CatchTag.Return) + break; + } + } + + internal void ThrowBreak () + { + if (catch_stack.Peek () != CatchTag.Break) + throw new Exception ("No outer loop to break"); + catch_count--; + } + + internal void ThrowTag (CatchTag tag) + { + foreach (CatchTag elt in catch_stack) + { + catch_count--; + if (elt == tag) + break; + } + } + + public void DefSubr (Builtin builtin, string str, bool setvar, int min_arg, int max_arg, params string[] aliases) { Name name = str; - Function func = new Function.Subroutine (builtin, name, + Function func = new Function.Subroutine (builtin, name, setvar, min_arg, max_arg); functions[name] = func; foreach (string a in aliases) @@ -455,13 +674,18 @@ namespace System.Xml.Expression internal Function.Lambda RegisterFunction (XmlNode node) { - Function.Lambda lambda = new Function.Lambda (node); + Function.Lambda lambda = new Function.Lambda (node, this); functions[lambda.name] = lambda; 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; @@ -469,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; @@ -496,46 +725,117 @@ 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 (name, Zero); variables[name] = vari; + return vari; } internal Function GetFunc (Name name) @@ -561,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; } @@ -602,252 +906,189 @@ namespace System.Xml.Expression } } - public delegate Term Builtin (Domain domain, Term[] args); + 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", 2, 2, "="); - basic.DefSpecial (and, "and", 1, -1, "&&"); - basic.DefSpecial (or, "or", 1, -1, "||"); - basic.DefSubr (not, "not", 1, 1, "!"); - basic.DefSubr (add, "add", 2, -1, "+"); - basic.DefSubr (mul, "mul", 2, -1, "*"); - basic.DefSubr (sub, "sub", 1, -1, "-"); - basic.DefSubr (div, "div", 2, -1, "/"); - basic.DefSubr (mod, "mod", 2, 2, "%"); - basic.DefSubr (logior, "logior", 2, -1, "|"); - basic.DefSubr (logand, "logand", 2, -1, "&"); - basic.DefSubr (add_set, "add-set", 2, -1, "+="); - basic.DefSubr (mul_set, "mul-set", 2, -1, "*="); - basic.DefSubr (sub_set, "sub-set", 2, -1, "-="); - basic.DefSubr (div_set, "div-set", 2, -1, "/="); - basic.DefSubr (mod_set, "mod-set", 2, 2, "%="); - basic.DefSubr (logior_set, "logior-set", 2, -1, "|="); - basic.DefSubr (logand_set, "logand-set", 2, -1, "&="); - basic.DefSubr (lsh, "lsh", 2, 2, "<<"); - basic.DefSubr (rsh, "rsh", 2, 2, ">>"); - basic.DefSubr (lsh_set, "lsh-set", 2, 2, "<<="); - basic.DefSubr (rsh_set, "rsh-set", 2, 2, ">>="); - basic.DefSubr (eq, "eq", 2, -1, "=="); - basic.DefSubr (noteq, "noteq", 2, 2, "!="); - basic.DefSubr (less_than, "lt", 2, -1, "<"); - basic.DefSubr (less_eq, "le", 2, -1, "<="); - basic.DefSubr (greater_than, "gt", 2, -1, ">"); - basic.DefSubr (greater_eq, "ge", 2, -1, ">="); - basic.DefSubr (append, "append", 0, -1); - basic.DefSubr (concat, "concat", 0, -1); - basic.DefSubr (nth, "nth", 2, 2); - basic.DefSubr (copy, "copy", 1, 1); - basic.DefSubr (ins, "ins", 3, 3); - basic.DefSubr (del, "del", 3, 3); - basic.DefSubr (eval_clause, "eval", 1, 1); - basic.DefSpecial (quote_clause, "quote", 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 (while_clause, "while", 1, -1); - basic.DefSpecial (cond_clause, "cond", 1, -1); - basic.DefSpecial (foreach_clause, "foreach", 3, -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, Term[] args) + private static Term Fset (Domain domain, Variable vari, Term[] args) { - Variable vari = domain.GetVar ((Name) args[0]); - - vari.Value = args[1]; + vari.Value = args[0]; return vari.val; } - private static Term and (Domain domain, Term[] args) - { - foreach (Term arg in args) - if (! arg.Eval (domain).IsTrue) - return Zero; - return One; - } - - private static Term or (Domain domain, Term[] args) - { - foreach (Term arg in args) - if (arg.Eval (domain).IsTrue) - return One; - return Zero; - } - - private static Term not (Domain domain, Term[] args) + private static Term Fnot (Domain domain, Variable vari, Term[] args) { return args[0].IsTrue ? Zero : One; } - private static Term add (Domain domain, Term[] args) + private static Term Fadd (Domain domain, Variable vari, Term[] args) { - int n = 0; + int n = vari == null ? 0 : vari.val.Intval; + foreach (Term arg in args) n += (int) arg; - return n; + if (vari == null) + return n; + vari.val.intval = n; + return vari.val; } - private static Term mul (Domain domain, Term[] args) + private static Term Fmul (Domain domain, Variable vari, Term[] args) { - int n = 1; + int n = vari == null ? 1 : vari.val.Intval; foreach (Term arg in args) n *= (int) arg; - return n; - } - - private static Term sub (Domain domain, Term[] args) - { - int n = (int) args[0]; - if (args.Length == 1) - return - n; - for (int i = 1; i < args.Length; i++) - n -= (int) args[i]; - return n; - } - - private static Term div (Domain domain, Term[] args) - { - int n = (int) args[0]; - for (int i = 1; i < args.Length; i++) - n /= (int) args[i]; - return n; - } - - private static Term mod (Domain domain, Term[] args) - { - return ((int) args[0] % (int) args[1]); - } - - private static Term logior (Domain domain, Term[] args) - { - int n = 0; - foreach (Term arg in args) - n |= (int) arg; - return n; - } - - private static Term logand (Domain domain, Term[] args) - { - int n = (int) args[0]; - for (int i = 1; i < args.Length; i++) - n &= (int) args[i]; - return n; - } - - private static Term add_set (Domain domain, Term[] args) - { - Variable vari = domain.GetVar ((Name) args[0]); - int n = (int) vari.val; - - for (int i = 1; i < args.Length; i++) - n += (int) args[i]; - vari.val = n; + if (vari == null) + return n; + vari.val.intval = n; return vari.val; } - private static Term mul_set (Domain domain, Term[] args) + private static Term Fsub (Domain domain, Variable vari, Term[] args) { - Variable vari = domain.GetVar ((Name) args[0]); - int n = (int) vari.val; - - for (int i = 1; i < args.Length; i++) - n *= (int) args[i]; - vari.val = n; - return vari.val; - } + int n, i; - private static Term sub_set (Domain domain, Term[] args) - { - Variable vari = domain.GetVar ((Name) args[0]); - int n = (int) vari.val; - - for (int i = 1; i < args.Length; i++) - n -= (int) args[i]; - vari.val = n; + if (vari == null) + { + n = args[0].Intval; + i = 1; + } + else + { + n = vari.val.Intval; + i = 0; + } + while (i < args.Length) + n -= (int) args[i++]; + if (vari == null) + return n; + vari.val.intval = n; return vari.val; } - private static Term div_set (Domain domain, Term[] args) + private static Term Fdiv (Domain domain, Variable vari, Term[] args) { - Variable vari = domain.GetVar ((Name) args[0]); - int n = (int) vari.val; + int n, i; - for (int i = 1; i < args.Length; i++) - n /= (int) args[i]; - vari.val = n; + if (vari == null) + { + n = args[0].Intval; + i = 1; + } + else + { + n = vari.val.Intval; + i = 0; + } + while (i < args.Length) + n /= args[i++].Intval; + if (vari == null) + return n; + vari.val.intval = n; return vari.val; } - private static Term mod_set (Domain domain, Term[] args) + private static Term Fmod (Domain domain, Variable vari, Term[] args) { - Variable vari = domain.GetVar ((Name) args[0]); - int n = (int) vari.val; - - for (int i = 1; i < args.Length; i++) - n %= (int) args[i]; - vari.val = n; + if (vari == null) + return (args[0].Intval % args[1].Intval); + vari.val.intval = vari.val.Intval % args[0].Intval; return vari.val; } - private static Term logior_set (Domain domain, Term[] args) + private static Term Flogior (Domain domain, Variable vari, Term[] args) { - Variable vari = domain.GetVar ((Name) args[0]); - int n = (int) vari.val; - - for (int i = 1; i < args.Length; i++) - n |= (int) args[i]; - vari.val = n; + int n = vari == null ? 0 : vari.val.Intval; + foreach (Term arg in args) + n |= (int) arg; + if (vari == null) + return n; + vari.val.intval = n; return vari.val; } - private static Term logand_set (Domain domain, Term[] args) + private static Term Flogand (Domain domain, Variable vari, Term[] args) { - Variable vari = domain.GetVar ((Name) args[0]); - int n = (int) vari.val; + int n, i; - for (int i = 1; i < args.Length; i++) - n &= (int) args[i]; - vari.val = n; + if (vari == null) + { + n = args[0].Intval; + i = 1; + } + else + { + n = vari.val.Intval; + i = 0; + } + while (i < args.Length) + n &= (int) args[i++]; + if (vari == null) + return n; + vari.val.intval = n; return vari.val; } - private static Term lsh (Domain domain, Term[] args) - { - return (int) args[0] << (int) args[1]; - } - - private static Term lsh_set (Domain domain, Term[] args) + private static Term Flsh (Domain domain, Variable vari, Term[] args) { - Variable vari = domain.GetVar ((Name) args[0]); - int n = (int) vari.val; - - n <<= (int) args[1]; - vari.val = n; + if (vari == null) + return args[0].Intval << args[1].Intval; + vari.val.intval = vari.val.Intval << args[0].Intval; return vari.val; } - private static Term rsh (Domain domain, Term[] args) + private static Term Frsh (Domain domain, Variable vari, Term[] args) { - return (int) args[0] >> (int) args[1]; - } - - private static Term rsh_set (Domain domain, Term[] args) - { - Variable vari = domain.GetVar ((Name) args[0]); - int n = (int) vari.val; - - n >>= (int) args[1]; - vari.val = n; + if (vari == null) + return args[0].Intval >> args[1].Intval; + vari.val.intval = vari.val.Intval >> args[0].Intval; return vari.val; } - private static Term eq (Domain domain, Term[] args) + private static Term Feq (Domain domain, Variable vari, Term[] args) { Term o = args[0]; @@ -866,12 +1107,12 @@ namespace System.Xml.Expression return One; } - private static Term noteq (Domain domain, Term[] args) + private static Term Fnoteq (Domain domain, Variable vari, Term[] args) { - return eq (domain, args); + return Feq (domain, vari, args); } - private static Term less_than (Domain domain, Term[] args) + private static Term Flt (Domain domain, Variable vari, Term[] args) { int n = (int) args[0]; @@ -885,7 +1126,7 @@ namespace System.Xml.Expression return One; } - private static Term less_eq (Domain domain, 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++) @@ -898,7 +1139,7 @@ namespace System.Xml.Expression return One; } - private static Term greater_than (Domain domain, 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++) @@ -911,7 +1152,7 @@ namespace System.Xml.Expression return One; } - private static Term greater_eq (Domain domain, 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++) @@ -924,10 +1165,14 @@ namespace System.Xml.Expression return One; } - private static Term append (Domain domain, Term[] args) + private static Term Fappend (Domain domain, Variable vari, Term[] args) { - List list = new List (); - Term result; + List list; + + if (vari == null) + list = new List (); + else + list = vari.val.Listval; foreach (Term arg in args) { @@ -936,15 +1181,24 @@ namespace System.Xml.Expression else list.Add (arg); } - result.intval = 0; - result.objval = list; - return result; + if (vari == null) + { + Term result; + result.intval = 0; + result.objval = list; + return result; + } + return vari.val; } - private static Term concat (Domain domain, Term[] args) + private static Term Fconcat (Domain domain, Variable vari, Term[] args) { - string str = ""; - Term result; + string str; + + if (vari == null) + str = ""; + else + str = vari.val.Strval; foreach (Term arg in args) { @@ -956,12 +1210,18 @@ namespace System.Xml.Expression else str += (char) arg.Intval; } - result.intval = 0; - result.objval = str; - return result; + if (vari == null) + { + Term result; + result.intval = 0; + result.objval = str; + return result; + } + vari.val.objval = str; + return vari.val; } - private static Term nth (Domain domain, Term[] args) + private static Term Fnth (Domain domain, Variable vari, Term[] args) { Term result; @@ -979,7 +1239,7 @@ namespace System.Xml.Expression return result; } - private static Term copy (Domain domain, Term[] args) + private static Term Fcopy (Domain domain, Variable vari, Term[] args) { Term result; @@ -988,52 +1248,55 @@ namespace System.Xml.Expression return result; } - private static Term ins (Domain domain, Term[] args) + private static Term Fins (Domain domain, Variable vari, Term[] args) { - if (args[0].IsStr) - { - string str = args[0].Strval.Insert (args[1].Intval, args[2].Strval); - args[0].objval = str; - } - else if (args[0].IsList) - { - args[0].Listval.InsertRange (args[1].Intval, args[2].Listval); - } + if (vari.val.IsStr) + vari.val.objval + = vari.val.Strval.Insert (args[0].Intval, args[1].Strval); + else if (vari.val.IsList) + vari.val.Listval.InsertRange (args[0].Intval, args[1].Listval); else - throw new Exception ("term is not collection: " + args[0]); - return args[0]; + throw new Exception ("term is not collection: " + vari.val); + return vari.val; } - - private static Term del (Domain domain, Term[] args) + private static Term Fdel (Domain domain, Variable vari, Term[] args) { - if (args[0].IsStr) - { - string str = args[0].Strval.Remove (args[1].Intval, - args[2].Intval - args[1].Intval); - args[0].objval = str; - } - else if (args[0].IsList) - { - args[0].Listval.RemoveRange (args[1].Intval, - args[2].Intval - args[1].Intval); - } + if (vari.val.IsStr) + vari.val.objval + = vari.val.Strval.Remove (args[0].Intval, + args[1].Intval - args[0].Intval); + + else if (vari.val.IsList) + vari.val.Listval.RemoveRange (args[0].Intval, + args[1].Intval - args[0].Intval); else - throw new Exception ("term is not collection: " + args[0]); - return args[0]; + throw new Exception ("term is not collection: " + vari.val); + return vari.val; } - private static Term quote_clause (Domain domain, Term[] args) + private static Term Fand (Domain domain, Variable vari, Term[] args) { - return new Term (args[0]); + foreach (Term arg in args) + if (! arg.Eval (domain).IsTrue) + return Zero; + return One; } - private static Term eval_clause (Domain domain, Term[] args) + private static Term For (Domain domain, Variable vari, Term[] args) + { + foreach (Term arg in args) + if (arg.Eval (domain).IsTrue) + return One; + return Zero; + } + + private static Term Feval (Domain domain, Variable vari, Term[] args) { return (args[0].Eval (domain)); } - private static Term progn_clause (Domain domain, Term[] args) + private static Term Fprogn (Domain domain, Variable vari, Term[] args) { Term result = One; @@ -1042,7 +1305,7 @@ namespace System.Xml.Expression return result; } - private static Term if_clause (Domain domain, Term[] args) + private static Term Fif (Domain domain, Variable vari, Term[] args) { if (args[0].Eval (domain).IsTrue) return args[1].Eval (domain); @@ -1051,7 +1314,7 @@ namespace System.Xml.Expression return args[2].Eval (domain); } - private static Term when_clause (Domain domain, Term[] args) + private static Term Fwhen (Domain domain, Variable vari, Term[] args) { if (! args[0].Eval (domain).IsTrue) return Zero; @@ -1061,15 +1324,55 @@ namespace System.Xml.Expression return result; } - private static Term while_clause (Domain domain, Term[] args) + private static Term Freturn (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; + domain.ThrowReturn (); + return args.Length == 0 ? Zero : args[0]; + } + + private static Term Fbreak (Domain domain, Variable vari, Term[] args) + { + domain.ThrowBreak (); + return args.Length == 0 ? Zero : args[0]; + } + + private static Term Floop (Domain domain, Variable vari, Term[] args) + { + Term result = Zero; + try { + domain.Catch (CatchTag.Break); + while (! domain.Thrown) + foreach (Term arg in args) + { + result = arg.Eval (domain); + if (domain.Thrown) + return result; + } + } finally { + domain.Uncatch (); + } + return result; + } + + private static Term Fwhile (Domain domain, Variable vari, Term[] args) + { + 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, Term[] args) + private static Term Fcond (Domain domain, Variable vari, Term[] args) { foreach (Term arg in args) { @@ -1086,25 +1389,143 @@ namespace System.Xml.Expression return Zero; } - private static Term foreach_clause (Domain domain, Term[] args) + private static Term Fforeach (Domain domain, Variable vari, + Term[] args) { - Variable vari = domain.GetVar ((Name) args[0]); - List list = args[1].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 = 2; 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 Fquote (Domain domain, Variable vari, Term[] args) + { + return new Term (args[0]); + } + + 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].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].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 { @@ -1115,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) { @@ -1133,8 +1555,8 @@ namespace System.Xml.Expression objval = (Name) node.InnerText; else if (name == Nstring) objval = node.InnerText.Clone (); - else if (name == Nvariable) - objval = domain.GetVar ((Name) node.Attributes[0].Value); + else if (name == Nvarref) + objval = domain.GetVar ((Name) node.Attributes[0].Value, true); else if (name == Nlist) { List list = new List (); @@ -1144,59 +1566,15 @@ namespace System.Xml.Expression objval = list; } else - { - if (name == Nfuncall) - name = node.Attributes[0].Value; - - Function 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); - Term[] args = new Term[nargs]; - for (int i = 0; i < nlist.Count; i++) - args[i] = new Term (nlist[i], domain); - objval = new Funcall (func, args); - } + objval = new Funcall (node, domain); } } - private class Funcall - { - internal Function func; - internal Term[] args; - - public Funcall (Function func, Term[] args) - { - this.func = func; - 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, 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; } } @@ -1216,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) @@ -1235,20 +1621,23 @@ 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 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); } @@ -1298,8 +1687,13 @@ namespace System.Xml.Expression } } - static Term Zero = new Term (0); - static Term One = new Term (1); + 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) { @@ -1312,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++) @@ -1350,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) @@ -1381,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) @@ -1391,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; }