From: handa Date: Fri, 18 Sep 2009 08:17:07 +0000 (+0000) Subject: *** empty log message *** X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=3b60cbb4badfce6230a70ca54bfcb9d6ae4f5708;p=m17n%2Fm17n-lib-cs.git *** empty log message *** --- diff --git a/XmlExpr.cs b/XmlExpr.cs index 2ab34f2..3efb27d 100644 --- a/XmlExpr.cs +++ b/XmlExpr.cs @@ -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,15 +94,18 @@ 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"; + private static Name Nloop = "loop"; + private static Name Nfunction = "function"; internal abstract class Function { @@ -118,7 +121,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 +131,22 @@ 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]; for (int i = 0; i < args.Length; i++) newargs[i] = args[i].Eval (domain); - return builtin (domain, newargs); + return builtin (domain, vari, newargs); } } @@ -157,21 +161,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 +188,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 +214,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,10 +245,7 @@ namespace System.Xml.Expression args = newargs; } for (i = 0; i < min_arg; i++) - { - Variable vari = domain.GetVar ((Name) this.args[i]); - domain.Bind (vari, args[i]); - } + domain.Bind (this.args[i], args[i]); if (body != null) foreach (Term term in body) result = term.Eval (domain); @@ -256,7 +257,7 @@ namespace System.Xml.Expression } } - internal abstract class Variable + public abstract class Variable { public readonly Name name; internal Term val; @@ -388,6 +389,18 @@ namespace System.Xml.Expression } #endif + internal struct CatchTag + { + public readonly Name name; + public readonly int count; + + public CatchTag (Name name, int count) + { + this.name = name; + this.count = count; + } + } + public class Domain { public object context; @@ -396,6 +409,8 @@ namespace System.Xml.Expression internal Dictionary functions; internal Dictionary variables; internal Bindings bindings; + internal Stack catch_list = new Stack (); + private int catch_count = 0; internal Domain () { @@ -425,11 +440,35 @@ namespace System.Xml.Expression bindings = bindings.UnboundTo (boundary); } - public void DefSubr (Builtin builtin, string str, + internal void Catch (Name name) + { + catch_list.Push (new CatchTag (name, catchcount++)); + } + + internal bool Catched { + get { return catch_list.Peek ().count == catchcount; } + } + + internal void ThrowReturn () + { + catch_list.Peek ().count = catchcount; + } + + internal void ThrowBreak () + { + catch_list.Peek ().count = catchcount; + } + + internal void Uncatch () + { + catch_list.Pop (); + } + + 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,7 +494,7 @@ 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; @@ -538,6 +577,13 @@ namespace System.Xml.Expression variables[name] = vari; } + internal Variable Defvar (Name name) + { + Variable vari = new Variable.Misc (name, Zero); + variables[name] = vari; + return vari; + } + internal Function GetFunc (Name name) { Function func; @@ -602,7 +648,7 @@ 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 (); @@ -610,244 +656,183 @@ namespace System.Xml.Expression static Xexpression () { - basic.DefSubr (set_value, "set", 2, 2, "="); + 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.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 (loop_clause, "loop", 1, -1); basic.DefSpecial (while_clause, "while", 1, -1); basic.DefSpecial (cond_clause, "cond", 1, -1); - basic.DefSpecial (foreach_clause, "foreach", 3, -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); } - private static Term set_value (Domain domain, Term[] args) + private static Term set_value (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 not (Domain domain, Variable vari, Term[] args) { return args[0].IsTrue ? Zero : One; } - private static Term add (Domain domain, Term[] args) + private static Term add (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 mul (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; - return vari.val; - } - - private static Term mul_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 sub_set (Domain domain, Term[] args) + private static Term sub (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 div_set (Domain domain, Term[] args) + private static Term div (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 mod (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 logior (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 logand (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 lsh (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) - { - return (int) args[0] >> (int) args[1]; - } - - private static Term rsh_set (Domain domain, Term[] args) + private static Term rsh (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 eq (Domain domain, Term[] args) + private static Term eq (Domain domain, Variable vari, Term[] args) { Term o = args[0]; @@ -866,12 +851,12 @@ namespace System.Xml.Expression return One; } - private static Term noteq (Domain domain, Term[] args) + private static Term noteq (Domain domain, Variable vari, Term[] args) { - return eq (domain, args); + return eq (domain, vari, args); } - private static Term less_than (Domain domain, Term[] args) + private static Term less_than (Domain domain, Variable vari, Term[] args) { int n = (int) args[0]; @@ -885,7 +870,7 @@ namespace System.Xml.Expression return One; } - private static Term less_eq (Domain domain, Term[] args) + private static Term less_eq (Domain domain, Variable vari, Term[] args) { int n = (int) args[0]; for (int i = 1; i < args.Length; i++) @@ -898,7 +883,7 @@ namespace System.Xml.Expression return One; } - private static Term greater_than (Domain domain, Term[] args) + private static Term greater_than (Domain domain, Variable vari, Term[] args) { int n = (int) args[0]; for (int i = 1; i < args.Length; i++) @@ -911,7 +896,7 @@ namespace System.Xml.Expression return One; } - private static Term greater_eq (Domain domain, Term[] args) + private static Term greater_eq (Domain domain, Variable vari, Term[] args) { int n = (int) args[0]; for (int i = 1; i < args.Length; i++) @@ -924,10 +909,14 @@ namespace System.Xml.Expression return One; } - private static Term append (Domain domain, Term[] args) + private static Term append (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 +925,25 @@ 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; + } + vari.val.objval = list; + return vari.val; } - private static Term concat (Domain domain, Term[] args) + private static Term concat (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 +955,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 nth (Domain domain, Variable vari, Term[] args) { Term result; @@ -979,7 +984,7 @@ namespace System.Xml.Expression return result; } - private static Term copy (Domain domain, Term[] args) + private static Term copy (Domain domain, Variable vari, Term[] args) { Term result; @@ -988,52 +993,55 @@ namespace System.Xml.Expression return result; } - private static Term ins (Domain domain, Term[] args) + private static Term ins (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 del (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 and (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 or (Domain domain, Variable vari, Term[] args) + { + foreach (Term arg in args) + if (arg.Eval (domain).IsTrue) + return One; + return Zero; } - private static Term eval_clause (Domain domain, Term[] args) + private static Term eval_clause (Domain domain, Variable vari, Term[] args) { return (args[0].Eval (domain)); } - private static Term progn_clause (Domain domain, Term[] args) + private static Term progn_clause (Domain domain, Variable vari, Term[] args) { Term result = One; @@ -1042,7 +1050,7 @@ namespace System.Xml.Expression return result; } - private static Term if_clause (Domain domain, Term[] args) + private static Term if_clause (Domain domain, Variable vari, Term[] args) { if (args[0].Eval (domain).IsTrue) return args[1].Eval (domain); @@ -1051,7 +1059,7 @@ namespace System.Xml.Expression return args[2].Eval (domain); } - private static Term when_clause (Domain domain, Term[] args) + private static Term when_clause (Domain domain, Variable vari, Term[] args) { if (! args[0].Eval (domain).IsTrue) return Zero; @@ -1061,7 +1069,53 @@ namespace System.Xml.Expression return result; } - private static Term while_clause (Domain domain, Term[] args) + private static Term break_clause (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; + return args.Length == 0 ? Zero : args[0]; + } + + private static Term return_clause (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]; + } + } + return args.Length == 0 ? Zero : args[0]; + } + + private static Term loop_clause (Domain domain, Variable vari, Term[] args) + { + domain.Catch (Nloop); + Term result = Zero; + try { + while (! domain.Catched) + foreach (Term arg in args) + { + result = arg.Eval (domain); + if (domain.Catched) + break; + } + } finally { + domain.Uncatch (); + } + return result; + } + + private static Term while_clause (Domain domain, Variable vari, Term[] args) { while (args[0].Eval (domain).IsTrue) for (int i = 1; i < args.Length; i++) @@ -1069,7 +1123,7 @@ namespace System.Xml.Expression return Zero; } - private static Term cond_clause (Domain domain, Term[] args) + private static Term cond_clause (Domain domain, Variable vari, Term[] args) { foreach (Term arg in args) { @@ -1086,17 +1140,17 @@ namespace System.Xml.Expression return Zero; } - private static Term foreach_clause (Domain domain, Term[] args) + private static Term foreach_clause (Domain domain, Variable vari, + Term[] args) { - Variable vari = domain.GetVar ((Name) args[0]); - List list = args[1].Listval; + List list = args[0].Listval; Bindings current = domain.bindings; foreach (Term term in list) { domain.Bind (vari, term); try { - for (int i = 2; i < args.Length; i++) + for (int i = 1; i < args.Length; i++) args[i].Eval (domain); } finally { domain.UnboundTo (current); @@ -1105,6 +1159,23 @@ namespace System.Xml.Expression return Zero; } + private static Term quote_clause (Domain domain, Variable vari, Term[] args) + { + return new Term (args[0]); + } + + private static Term type_clause (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 struct Term { @@ -1133,7 +1204,7 @@ namespace System.Xml.Expression objval = (Name) node.InnerText; else if (name == Nstring) objval = node.InnerText.Clone (); - else if (name == Nvariable) + else if (name == Nvarref) objval = domain.GetVar ((Name) node.Attributes[0].Value); else if (name == Nlist) { @@ -1145,10 +1216,15 @@ namespace System.Xml.Expression } else { + Function func; + Variable vari = null; + Term[] args; + if (name == Nfuncall) name = node.Attributes[0].Value; - - Function func = domain.GetFunc (name); + 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; @@ -1156,10 +1232,10 @@ namespace System.Xml.Expression || (func.max_arg >= 0 && nargs > func.max_arg)) throw new Exception ("Invalid number of arguments to: " + name + " " + nargs); - Term[] args = new Term[nargs]; + 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 (func, vari, args); } } } @@ -1167,11 +1243,13 @@ namespace System.Xml.Expression private class Funcall { internal Function func; + internal Variable vari; internal Term[] args; - public Funcall (Function func, Term[] args) + public Funcall (Function func, Variable vari, Term[] args) { this.func = func; + this.vari = vari; this.args = args; } @@ -1182,7 +1260,7 @@ namespace System.Xml.Expression domain.DebugWrite (false, " {0}", args[i].ToString ()); domain.DebugWrite (false, ")"); domain.depth++; - Term result = func.Call (domain, args); + Term result = func.Call (domain, vari, args); domain.depth--; domain.DebugWrite (true, " ==> {0})", result.ToString ()); return result; @@ -1235,6 +1313,7 @@ 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 Term Eval (Domain domain) @@ -1300,6 +1379,11 @@ 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"); internal static int parse_integer (string str) { diff --git a/xex.txt b/xex.txt index 4a36efe..fce2ebd 100644 --- a/xex.txt +++ b/xex.txt @@ -1,38 +1,38 @@ EXPR = - '' [ DEFUN | DEFMACRO | DEFVAR | TERM ] * '' + '' [ DEFUN | DEFVAR | TERM ] * '' -TERM = [ VAR | INT | STRING | SYMBOL | LIST | FUNCALL ] +TERM = [ INT | STRING | SYMBOL | LIST | VAR | FUNCALL ] DEFUN = - '' + '' ARGS ? - BODY ? + TERM * '' ARGS = - '' VAR * OPTIONAL ? REST ? '' - | '' VAR * OPTIONAL ? REST ? '' + '' FIXED ? OPTIONAL ? REST ? '' + | '' FIXED ? OPTIONAL ? REST ? '' + +FIXED = + ' VAR + '' OPTIONAL = - '' VAR * + '' VAR + '' REST = - '' VAR - -BODY = - '' TERM * '' + '' VAR '' DEFVAR = DEFVAR-INT DEFVAR-STR DEFVAR-INT = - '' + '' DESCRIPTION ? INT ? - [ INT | '' INT INT '' ] * + [ INT | '' INT INT '' ] * '' DEFVAR-STR = - '' + '' DESCRIPTION ? STR ? STR * @@ -44,8 +44,6 @@ DESCRIPTION = GETTEXT = '' TEXT '' -VAR = - '' INT = '' INTEGER '' STR = @@ -55,65 +53,84 @@ SYMBOL = LIST = '' TERM * '' | +VAR = + '' + FUNCALL = - '' TERM * '' - | '<' PREDEFINED-FUNC-SYMBOL '>' TERM * '' - -PREDEFINED-FUNC-SYMBOL = - SET - | AND | OR | NOT - | LT | LE | EQ | GE | GT - | NOTEQ - | ADD | SUB | MUL | DIV | MOD - | LOGAND | LOGIOR | LOGXOR | LSH - | APPEND | CONCAT | NTH | COPY | INS | DEL - | PROGN | IF | WHEN | COND - | WHILE | FOR | FOREACH - | EVAL | TYPE - -PREDEFINED-FUNC-NAME = - PREDEFINED-FUNC-SYMBOL - | '=' - | '&&' | '||' | '!' - | '<' | '<=' | '==' | '>=' | '>' - | '!=' - | '+' | '-' | '*' | '/' | '%' - | '+=' | '-=' | '*=' | '/=' | '%=' - | '&=' | '|=' | '~=' | '<<=' | '>>=' - -TRUE = - '0' -FALSE = - '1' - -;; TERM is evaluated to a TERM. -;; INT is evaluated to itself. -;; STRING is evaluated to itself. -;; SYMBOL is evaluated to itself. -;; LIST is evaluated to itself. -;; VAR is evaluated to TERM that is set to that variable. -;; FUNCALL is evaluated to TERM returned by that function. - -SET = - '' TERM '' -;; Set the variable of name VARNAME to TERM. - -AND = ;; arguments unevalled - ' TERM ... -OR (unevalled-arg ...) = - ' TERM ... -NOT (arg) = - ' TERM - -LT (arg ...) = - '' TERM ... '' + '' TERM * '' + | '<' PREDEFINED '>' TERM * '' + | '<' PREDEFINED 'vname="' VNAME '">' TERM * '' +PREDEFINED = + 'set' | 'and' | 'or' | 'not' - | 'lt' | 'le' | 'eq' | 'ge' | 'gt' - | 'noteq' + | 'lt' | 'le' | 'eq' | 'ge' | 'gt' | 'noteq' | 'add' | 'sub' | 'mul' | 'div' | 'mod' | 'logand' | 'logior' | 'logxor' | 'lsh' | 'append' | 'concat' | 'nth' | 'copy' | 'ins' | 'del' | 'progn' | 'if' | 'when' | 'cond' - | 'while' | 'for' | 'foreach' - | 'eval' | 'type' + | 'loop' | 'break' | 'while' | 'foreach' + | 'quote' | 'eval' | 'type' + +;; TERM has a value, and is evaluated to a TERM as below. +;; INT has an integer value, and is evaluated to itself . +;; STRING has a string value, and is evaluated to itself. +;; SYMBOL has a symbol value, and is evaluated to itself. +;; LIST has a list value and, is evaluated to itself. +;; VAR has a value of TERM that is assigned to the variable, +;; and is evalued to that TERM. +;; FUNCALL has a value of TERM that is returned by that function, +;; and is evalued to that TERM. + +INTTERM = INT | VAR (value is INT) | FUNCALL (return INT) +STRTERM = STR | VAR (value is STR) | FUNCALL (return STR) +LISTTERM = LIST | VAR (value is LIST) | FUNCALL (return LIST) +ANYTERM = TERM + +;; Here after, when an argument is TERM, it is given to a function +;; without being evaluted. Otherwise, an evaluated term is given. + +'' ANYTERM '' +'' INTTERM + '' +'' INTTERM + '' +'' INTTERM + '' +'' INTTERM + '' +'' INTTERM + '' +'' INTTERM + '' +'
' INTTERM + '
' +'
' INTTERM + '
' +'' INTTERM INTTERM '' +'' INTTERM '' +' INTTERM + '' +'' INTTERM + '' +' INTTERM + '' +' vname="' VNAME '">' INTTERM + '' +' INTTERM + '' +' vname="' VNAME '">' INTTERM + '' +'' INTTERM INTTERM '' +'' INTTERM '' +'' INTTERM INTTERM '' +'' INTTERM INTTERM '' +'' INTTERM INTTERM '' +'' INTTERM INTTERM '' +'' INTTERM INTTERM '' +'' INTTERM INTTERM '' +'' ANYTERM + '' +'' [ INTTERM | STRTERM | LISTTERM ] + '' +'' INTTERM [ STRTERM | LISTTERM ] '' +'' LISTTERM '' +'' INTTERM [ STRTERM | LISTTERM ] '' +'' INTTERM INTTERM '' +'' TERM + '' +'' TERM + '' +'' TERM '' +'' TERM * '' +'' TERM TERM TERM ? '' +'' TERM TERM * '' +'' LIST + '' +'' TERM + '' +'' TERM + '' +'' TERM + '' +'' TERM '' +'' TERM '' +'' ANYTERM '' diff --git a/xex.xml b/xex.xml index 49f71cb..6f24c55 100644 --- a/xex.xml +++ b/xex.xml @@ -1,34 +1,31 @@ - + - - - 2 - - - - - 1 - - - - + + 2 + + + + + 1 + + + - - - + + + + - - - + 10 ABC - + 1123 24 @@ -39,13 +36,13 @@ 1011 - + - - + + - 1 + 1