X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=XmlExpr.cs;h=2e143a21293a4b8bf0430f10333150c66a791a8c;hb=0f44ed40ba80ef72d6a8a835f4b980d6e3db4e50;hp=ae56091073a2401c19645aa12c3cf682026de769;hpb=948496e0c55cfffced24b1053d17b19a9369f747;p=m17n%2Fm17n-lib-cs.git diff --git a/XmlExpr.cs b/XmlExpr.cs index ae56091..2e143a2 100644 --- a/XmlExpr.cs +++ b/XmlExpr.cs @@ -10,58 +10,58 @@ namespace System.Xml.Expression { public static int debug_level = 0; - public struct Name : IEquatable + public struct Symbol : IEquatable { private static NameTable nt = new NameTable (); internal string name; - public Name (string str) + public Symbol (string str) { name = nt.Add (str); } - public static implicit operator Name (string str) + public static implicit operator Symbol (string str) { - return new Name (str); + return new Symbol (str); } - public static implicit operator string (Name name) + public static implicit operator string (Symbol name) { return name.name; } - public static bool operator== (Name n1, Name n2) + public static bool operator== (Symbol n1, Symbol n2) { return (object) n1.name == (object) n2.name; } - public static bool operator!= (Name n1, Name n2) + public static bool operator!= (Symbol n1, Symbol n2) { return (object) n1.name != (object) n2.name; } - public static bool operator== (Name n1, string n2) + public static bool operator== (Symbol n1, string n2) { return (object) n1.name == (object) n2; } - public static bool operator!= (Name n1, string n2) + public static bool operator!= (Symbol n1, string n2) { return (object) n1.name != (object) n2; } - public static bool operator== (string n1, Name n2) + public static bool operator== (string n1, Symbol n2) { return (object) n1 == (object) n2.name; } - public static bool operator!= (string n1, Name n2) + public static bool operator!= (string n1, Symbol n2) { return (object) n1 != (object) n2.name; } - public bool Equals (Name name) + public bool Equals (Symbol name) { return Object.ReferenceEquals (this.name, name.name); } @@ -81,36 +81,37 @@ namespace System.Xml.Expression public override string ToString () { return name; } } - private static Name Nexpr = "expr"; - - private static Name Nfuncall = "funcall"; - private static Name Nvarref = "varref"; - private static Name Ninteger = "integer"; - private static Name Nstring = "string"; - private static Name Nsymbol = "symbol"; - private static Name Nlist = "list"; - - private static Name Ndefun = "defun"; - private static Name Nfname = "fname"; - private static Name Nargs = "args"; - private static Name Nargs_unevalled = "args-unevalled"; - private static Name Nfixed = "fixed"; - private static Name Noptional = "optional"; - private static Name Nrest = "rest"; - - private static Name Ndefvar = "defvar"; - private static Name Nvname = "vname"; - private static Name Ndescription = "description"; - private static Name Nrange = "range"; + private static Symbol Qexpr = "expr"; + + private static Symbol Qnull = ""; + private static Symbol Qfuncall = "funcall"; + private static Symbol Qvarref = "varref"; + private static Symbol Qinteger = "integer"; + private static Symbol Qstring = "string"; + private static Symbol Qsymbol = "symbol"; + private static Symbol Qlist = "list"; + + private static Symbol Qdefun = "defun"; + private static Symbol Qfname = "fname"; + private static Symbol Qargs = "args"; + private static Symbol Qargs_unevalled = "args-unevalled"; + private static Symbol Qfixed = "fixed"; + private static Symbol Qoptional = "optional"; + private static Symbol Qrest = "rest"; + + private static Symbol Qdefvar = "defvar"; + private static Symbol Qvname = "vname"; + private static Symbol Qdescription = "description"; + private static Symbol Qrange = "range"; public abstract class Function { - public Name name; + public Symbol name; public int min_arg, max_arg; public Function () { } - public Function (Name name, int min_arg, int max_arg) + public Function (Symbol name, int min_arg, int max_arg) { this.name = name; this.min_arg = min_arg; @@ -129,21 +130,25 @@ namespace System.Xml.Expression public Builtin builtin; public bool setvar; - public Subroutine (Builtin builtin, Name name, bool setvar, + public Subroutine (Builtin builtin, Symbol name, bool setvar, int min_arg, int max_arg) : base (name, min_arg, max_arg) { this.builtin = builtin; + this.setvar = setvar; } public override Term Call (Domain domain, Variable vari, Term[] args) { - args = (Term[]) args.Clone (); - for (int i = 0; i < args.Length; i++) + if (args != null) { - args[i] = args[i].Eval (domain); - if (domain.Thrown) - return args[i]; + args = (Term[]) args.Clone (); + for (int i = 0; i < args.Length; i++) + { + args[i] = args[i].Eval (domain); + if (domain.Thrown) + return args[i]; + } } return builtin (domain, vari, args); } @@ -153,7 +158,7 @@ namespace System.Xml.Expression { public Builtin builtin; - public SpecialForm (Builtin builtin, Name name, + public SpecialForm (Builtin builtin, Symbol name, int min_arg, int max_arg) : base (name, min_arg, max_arg) { @@ -172,51 +177,91 @@ namespace System.Xml.Expression internal Variable[] args; internal Term[] body; - public Lambda (XmlNode node, Domain domain) - { - int nfixed = 0; - int noptional = 0; - int nrest = 0; - name = node.Attributes[Nfname].Value; + public Lambda (Domain domain, XmlNode node) + { + int nfixed = 0; + int noptional = 0; + int nrest = 0; + name = node.Attributes[Qfname].Value; - node = node.FirstChild; - if (node != null - && (node.Name == Nargs || node.Name == Nargs_unevalled)) - { - XmlNode n; - args_evalled = node.Name == Nargs; - for (n = node.FirstChild; n != null; n = n.NextSibling) - { - if (n.Name == Nfixed) - nfixed++; - else if (n.Name == Noptional) - noptional++; - else if (n.Name == Nrest) - nrest++; - else - throw new Exception ("Invalid argument type: " + n); - } - min_arg = nfixed; - max_arg = nfixed + noptional + nrest; - args = new Variable[max_arg]; - n = node.FirstChild; - for (int i = 0; i < max_arg; n = n.NextSibling) - args[i++] = domain.Defvar ((Name) n.Attributes[0].Value); - if (nrest == 1) - max_arg = - max_arg; - } - else - { - min_arg = max_arg = 0; - } - } + node = node.FirstChild; + if (node != null + && (node.Name == Qargs || node.Name == Qargs_unevalled)) + { + XmlNode n; + args_evalled = node.Name == Qargs; + for (n = node.FirstChild; n != null; n = n.NextSibling) + { + if (n.Name == Qfixed) + nfixed++; + else if (n.Name == Qoptional) + noptional++; + else if (n.Name == Qrest) + nrest++; + else + throw new Exception ("Invalid argument type: " + n); + } + min_arg = nfixed; + max_arg = nfixed + noptional + nrest; + args = new Variable[max_arg]; + n = node.FirstChild; + for (int i = 0; i < max_arg; n = n.NextSibling) + args[i++] = domain.Defvar ((Symbol) n.Attributes[0].Value); + if (nrest == 1) + max_arg = - max_arg; + } + else + { + min_arg = max_arg = 0; + } + } - public void SetBody (XmlNode node, Domain domain) + public Lambda (Domain domain, Symbol name, + bool args_evalled, Symbol[] args) + { + int nfixed = 0; + int noptional = 0; + int nrest = 0; + + this.name = name; + this.args_evalled = args_evalled; + if (args != null) + { + int i = 0; + for (i = 0; i < args.Length; i++, nfixed++) + if (args[i] == Qoptional || args[i] == Qrest) + break; + if (i < args.Length) + { + if (args[i] == Qoptional) + { + for (i++; i < args.Length; i++, noptional++) + if (args[i] == Qrest) + break; + if (i < args.Length) + nrest = 1; + } + } + min_arg = nfixed; + max_arg = nfixed + noptional + nrest; + this.args = new Variable[max_arg]; + int j; + for (i = j = 0; j < this.args.Length; i++) + if (args[i] != Qoptional || args[i] != Qrest) + this.args[j++] = domain.Defvar (args[i]); + } + else + { + min_arg = max_arg = 0; + } + } + + public void SetBody (Domain domain, XmlNode node) { for (node = node.FirstChild; node != null; node = node.NextSibling) - if (node.Name != Ndescription - && node.Name != Nargs - && node.Name != Nargs_unevalled) + if (node.Name != Qdescription + && node.Name != Qargs + && node.Name != Qargs_unevalled) break; int nterms = 0; for (XmlNode n = node; n != null; n = n.NextSibling) @@ -225,10 +270,15 @@ namespace System.Xml.Expression { body = new Term[nterms]; for (nterms = 0; node != null; node = node.NextSibling, nterms++) - body[nterms] = new Term (node, domain); + body[nterms] = new Term (domain, node); } } + public void SetBody (Term[] body) + { + this.body = body; + } + public override Term Call (Domain domain, Variable vari, Term[] args) { Bindings current = domain.bindings; @@ -271,13 +321,13 @@ namespace System.Xml.Expression public class Variable : TermValue { - public readonly Name name; + public readonly Symbol name; public string desc; internal Term default_val; internal Term val; object range; - public Variable (Name name, Term value) + public Variable (Symbol name, Term value) { this.name = name; val = value; @@ -286,7 +336,7 @@ namespace System.Xml.Expression public virtual bool ValueP (Term val) { return true; } - public Variable Clone () + public override TermValue Clone () { Variable v = new Variable (name, val); v.desc = desc; @@ -355,7 +405,7 @@ namespace System.Xml.Expression return false; } - public Int (Name name, string description, int value, int[] range) + public Int (Symbol name, string description, int value, int[] range) : base (name, new Term (value)) { if (! SubsetP (value, range)) @@ -391,6 +441,8 @@ namespace System.Xml.Expression private static bool SubsetP (string[] r1, string[] r2) { + if (r2 == null) + return true; foreach (string s in r1) if (! SubsetP (s, r2)) return false; @@ -399,13 +451,15 @@ namespace System.Xml.Expression private static bool SubsetP (string str, string[] r) { + if (r == null) + return true; foreach (string s in r) if (str == s) return true; return false; } - public Str (Name name, string description, string value, string[] range) + public Str (Symbol name, string description, string value, string[] range) : base (name, new Term (value)) { if (! SubsetP (value, range)) @@ -437,25 +491,29 @@ namespace System.Xml.Expression public class Sym : Variable { - public Name[] range; + public Symbol[] range; - private static bool SubsetP (Name[] r1, Name[] r2) + private static bool SubsetP (Symbol[] r1, Symbol[] r2) { - foreach (Name n in r1) + if (r2 == null) + return true; + foreach (Symbol n in r1) if (! SubsetP (n, r2)) return false; return true; } - private static bool SubsetP (Name name, Name[] r) + private static bool SubsetP (Symbol name, Symbol[] r) { - foreach (Name n in r) + if (r == null) + return true; + foreach (Symbol n in r) if (name == n) return true; return false; } - public Sym (Name name, string description, Name value, Name[] range) + public Sym (Symbol name, string description, Symbol value, Symbol[] range) : base (name, new Term (value)) { if (! SubsetP (value, range)) @@ -467,18 +525,18 @@ namespace System.Xml.Expression public override bool ValueP (Term term) { - if (! (term.objval is Name)) + if (! (term.objval is Symbol)) return false; - return SubsetP (term.Nameval, range); + return SubsetP (term.Symval, range); } public override object Range { get { return range; } set { - Name[] r = (Name[]) value; + Symbol[] r = (Symbol[]) value; if (! SubsetP (r, range) - || ! SubsetP (val.Nameval, r) - || ! SubsetP (default_val.Nameval, r)) + || ! SubsetP (val.Symval, r) + || ! SubsetP (default_val.Symval, r)) throw new Exception ("Invalid range"); range = r; } @@ -526,10 +584,10 @@ namespace System.Xml.Expression #if false internal class ThrowException : Exception { - Name tag; + Symbol tag; public object value; - public ThrowException (Name tag, object value) : base () + public ThrowException (Symbol tag, object value) : base () { this.tag = tag; this.value = value; @@ -541,7 +599,7 @@ namespace System.Xml.Expression { private object val; - public CatchTag (Name name) { val = name.name; } + public CatchTag (Symbol name) { val = name.name; } private CatchTag (int i) { val = i; } public static CatchTag Return = new CatchTag (0); @@ -564,28 +622,25 @@ namespace System.Xml.Expression public object context; public int depth = 0; - internal Dictionary functions; - internal Dictionary> - modules = new Dictionary> (); - internal Dictionary variables; + internal Dictionary termtypes + = new Dictionary (); + internal Dictionary functions + = new Dictionary (); + internal Dictionary variables + = new Dictionary (); internal Bindings bindings; private Stack catch_stack = new Stack (); private int catch_count = 0; - internal Domain () - { - functions = new Dictionary (); - variables = new Dictionary (); - } + internal Domain () { } - public Domain (object context) : this (basic, context) - { - } + public Domain (object context) : this (basic, context) { } public Domain (Domain parent, object context) { - functions = new Dictionary (parent.functions); - variables = new Dictionary (parent.variables); + termtypes = new Dictionary (parent.termtypes); + functions = new Dictionary (parent.functions); + variables = new Dictionary (parent.variables); this.context = context; } @@ -613,7 +668,7 @@ namespace System.Xml.Expression catch_count--; } - internal bool Thrown { + public bool Thrown { get { return catch_count < catch_stack.Count; } } @@ -644,65 +699,80 @@ namespace System.Xml.Expression } } + public void DefTerm (Symbol name, TermParser parser) + { + termtypes[name] = new TermType (name, parser); + } + public void DefSubr (Builtin builtin, string str, bool setvar, int min_arg, int max_arg, params string[] aliases) { - Name name = str; + Symbol name = str; Function func = new Function.Subroutine (builtin, name, setvar, min_arg, max_arg); functions[name] = func; foreach (string a in aliases) - functions[(Name) a] = func; + functions[(Symbol) a] = func; } public void DefSpecial (Builtin builtin, string str, int min_arg, int max_arg, params string[] aliases) { - Name name = str; + Symbol name = str; Function func = new Function.SpecialForm (builtin, name, min_arg, max_arg); functions[name] = func; foreach (string a in aliases) - functions[(Name) a] = func; + functions[(Symbol) a] = func; } public void DefAlias (string alias, string str) { - functions[(Name) alias] = functions[(Name) str]; + functions[(Symbol) alias] = functions[(Symbol) str]; } - internal Function.Lambda RegisterFunction (XmlNode node) + public void Defun (Symbol name, bool args_evalled, + Symbol[] args, Term[] body, bool prototype) { - Function.Lambda lambda = new Function.Lambda (node, this); + Function func; - functions[lambda.name] = lambda; - return lambda; + if (prototype || ! functions.TryGetValue (name, out func)) + { + func = new Function.Lambda (this, name, args_evalled, args); + functions[name] = func; + } + if (! prototype) + ((Function.Lambda) func).SetBody (body); } - public void Defun (Name name, Name[] args, bool args_evalled) + public void Defun (XmlNode node, bool prototype) { - Function func = new Function.Lambda (this, name, args, args_evalled) + Symbol name = node.Attributes[Qfname].Value; + Function func; + + if (prototype || ! functions.TryGetValue (name, out func)) + { + func = new Function.Lambda (this, node); + functions[name] = func; + } + if (! prototype) + ((Function.Lambda) func).SetBody (this, node); } - public void Defun (XmlNode node) + public void Defun (Function func) { - Name name = node.Attributes[Nfname].Value; - Function func; - - if (! functions.TryGetValue (name, out func)) - func = RegisterFunction (node); - ((Function.Lambda) func).SetBody (node, this); + functions[func.name] = func; } public Variable Defvar (XmlNode node) { - Name name = node.Attributes[0].Value; + Symbol name = node.Attributes[0].Value; String desc; Variable vari; node = node.FirstChild; - if (node.Name == Ndescription) + if (node != null && node.Name == Qdescription) { desc = node.InnerText; node = node.NextSibling; @@ -711,7 +781,7 @@ namespace System.Xml.Expression desc = null; if (node != null) { - Name type = node.Name; + Symbol type = node.Name; XmlNodeList range_list = null; int nranges = 0; string val = node.InnerText; @@ -723,7 +793,7 @@ namespace System.Xml.Expression nranges = range_list.Count; } - if (type == Ninteger) + if (type == Qinteger) { int intval = parse_integer (val); int[] range = null; @@ -733,7 +803,7 @@ namespace System.Xml.Expression for (int i = 0; i < nranges; i++) { XmlNode n = range_list[i]; - if (n.Name == Nrange) + if (n.Name == Qrange) { range[i * 2] = parse_integer (n.FirstChild.InnerText); @@ -744,7 +814,7 @@ namespace System.Xml.Expression { range[i * 2] = range[i * 2 + 1] - = parse_integer (n.InnerText); + = parse_integer (n.FirstChild.InnerText); } } } @@ -753,7 +823,7 @@ namespace System.Xml.Expression { if (! (vari is Variable.Int)) throw new Exception ("Inalid value"); - vari = vari.Clone (); + vari = (Variable) vari.Clone (); Term v = new Term (intval); vari.Value = v; vari.DefaultValue = v; @@ -763,21 +833,21 @@ namespace System.Xml.Expression else vari = new Variable.Int (name, desc, intval, range); } - else if (type == Nstring) + else if (type == Qstring) { string[] range = null; if (range_list != null) { range = new string[nranges]; for (int i = 0; i < nranges; i++) - range[i] = range_list[i].InnerText; + range[i] = range_list[i].FirstChild.InnerText; } if (variables.TryGetValue (name, out vari)) { if (! (vari is Variable.Str)) throw new Exception ("Invalid value"); - vari = vari.Clone (); + vari = (Variable) vari.Clone (); Term v = new Term (val); vari.Value = v; vari.DefaultValue = v; @@ -787,21 +857,21 @@ namespace System.Xml.Expression else vari = new Variable.Str (name, desc, val, range); } - else if (type == Nsymbol) + else if (type == Qsymbol) { - Name[] range = null; + Symbol[] range = null; if (range_list != null) { - range = new Name[nranges]; + range = new Symbol[nranges]; for (int i = 0; i < nranges; i++) - range[i] = range_list[i].InnerText; + range[i] = range_list[i].FirstChild.InnerText; } if (variables.TryGetValue (name, out vari)) { if (! (vari is Variable.Sym)) throw new Exception ("Invalid value"); - vari = vari.Clone (); + vari = (Variable) vari.Clone (); Term v = new Term (val); vari.Value = v; vari.DefaultValue = v; @@ -817,7 +887,7 @@ namespace System.Xml.Expression else { if (variables.TryGetValue (name, out vari)) - vari = vari.Clone (); + vari = (Variable) vari.Clone (); else vari = new Variable (name, Zero); } @@ -831,14 +901,14 @@ namespace System.Xml.Expression return vari; } - internal Variable Defvar (Name name) + internal Variable Defvar (Symbol name) { Variable vari = new Variable (name, Zero); variables[name] = vari; return vari; } - internal Function GetFunc (Name name) + internal Function GetFunc (Symbol name) { Function func; @@ -847,7 +917,7 @@ namespace System.Xml.Expression return func; } - public bool CopyFunc (Domain domain, Name name) + public bool CopyFunc (Domain domain, Symbol name) { Function func = GetFunc (name); @@ -857,11 +927,11 @@ namespace System.Xml.Expression public void CopyFunc (Domain domain) { - foreach (KeyValuePair kv in functions) + foreach (KeyValuePair kv in functions) domain.functions[kv.Key] = kv.Value; } - public Variable GetVar (Name name, bool create) + public Variable GetVar (Symbol name, bool create) { Variable vari; @@ -877,10 +947,10 @@ namespace System.Xml.Expression public override string ToString () { string str = "<(functions"; - foreach (KeyValuePair kv in functions) + foreach (KeyValuePair kv in functions) str += " " + kv.Key; str += ") (variabls"; - foreach (KeyValuePair kv in variables) + foreach (KeyValuePair kv in variables) str += " " + kv.Key; str += ")"; if (bindings != null) @@ -904,6 +974,22 @@ namespace System.Xml.Expression Console.Write (fmt, arg); } } + + public object SaveValues () + { + Dictionary values = new Dictionary (); + + foreach (KeyValuePair kv in variables) + values[kv.Value] = kv.Value.val.Clone (); + return values; + } + + public void RestoreValues (object values) + { + foreach (KeyValuePair kv + in (Dictionary) values) + kv.Key.val = kv.Value; + } } public delegate Term Builtin (Domain domain, Variable vari, Term[] args); @@ -912,6 +998,8 @@ namespace System.Xml.Expression static Xexpression () { + basic.DefTerm ("funcall", Funcall.parser); + basic.DefSubr (Fset, "set", true, 1, 1, "="); basic.DefSubr (Fnot, "not", false, 1, 1, "!"); basic.DefSubr (Fadd, "add", true, 1, -1, "+"); @@ -938,6 +1026,7 @@ namespace System.Xml.Expression 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"); @@ -969,9 +1058,9 @@ namespace System.Xml.Expression int n = vari == null ? 0 : vari.val.Intval; foreach (Term arg in args) - n += (int) arg; + n += arg.Intval; if (vari == null) - return n; + return new Term (n); vari.val.intval = n; return vari.val; } @@ -980,9 +1069,9 @@ namespace System.Xml.Expression { int n = vari == null ? 1 : vari.val.Intval; foreach (Term arg in args) - n *= (int) arg; + n *= arg.Intval; if (vari == null) - return n; + return new Term (n); vari.val.intval = n; return vari.val; } @@ -1002,9 +1091,9 @@ namespace System.Xml.Expression i = 0; } while (i < args.Length) - n -= (int) args[i++]; + n -= args[i++].Intval; if (vari == null) - return n; + return new Term (n); vari.val.intval = n; return vari.val; } @@ -1026,7 +1115,7 @@ namespace System.Xml.Expression while (i < args.Length) n /= args[i++].Intval; if (vari == null) - return n; + return new Term (n); vari.val.intval = n; return vari.val; } @@ -1034,7 +1123,7 @@ namespace System.Xml.Expression private static Term Fmod (Domain domain, Variable vari, Term[] args) { if (vari == null) - return (args[0].Intval % args[1].Intval); + return new Term (args[0].Intval % args[1].Intval); vari.val.intval = vari.val.Intval % args[0].Intval; return vari.val; } @@ -1043,9 +1132,9 @@ namespace System.Xml.Expression { int n = vari == null ? 0 : vari.val.Intval; foreach (Term arg in args) - n |= (int) arg; + n |= arg.Intval; if (vari == null) - return n; + return new Term (n); vari.val.intval = n; return vari.val; } @@ -1065,9 +1154,9 @@ namespace System.Xml.Expression i = 0; } while (i < args.Length) - n &= (int) args[i++]; + n &= args[i++].Intval; if (vari == null) - return n; + return new Term (n); vari.val.intval = n; return vari.val; } @@ -1075,7 +1164,7 @@ namespace System.Xml.Expression private static Term Flsh (Domain domain, Variable vari, Term[] args) { if (vari == null) - return args[0].Intval << args[1].Intval; + return new Term (args[0].Intval << args[1].Intval); vari.val.intval = vari.val.Intval << args[0].Intval; return vari.val; } @@ -1083,7 +1172,7 @@ namespace System.Xml.Expression private static Term Frsh (Domain domain, Variable vari, Term[] args) { if (vari == null) - return args[0].Intval >> args[1].Intval; + return new Term (args[0].Intval >> args[1].Intval); vari.val.intval = vari.val.Intval >> args[0].Intval; return vari.val; } @@ -1114,11 +1203,11 @@ namespace System.Xml.Expression private static Term Flt (Domain domain, Variable vari, Term[] args) { - int n = (int) args[0]; + int n = args[0].Intval; for (int i = 1; i < args.Length; i++) { - int n1 = (int) args[i]; + int n1 = args[i].Intval; if (n >= n1) return Zero; n = n1; @@ -1128,10 +1217,10 @@ namespace System.Xml.Expression private static Term Fle (Domain domain, Variable vari, Term[] args) { - int n = (int) args[0]; + int n = args[0].Intval; for (int i = 1; i < args.Length; i++) { - int n1 = (int) args[i]; + int n1 = args[i].Intval; if (n > n1) return Zero; n = n1; @@ -1141,10 +1230,10 @@ namespace System.Xml.Expression private static Term Fgt (Domain domain, Variable vari, Term[] args) { - int n = (int) args[0]; + int n = args[0].Intval; for (int i = 1; i < args.Length; i++) { - int n1 = (int) args[i]; + int n1 = args[i].Intval; if (n <= n1) return Zero; n = n1; @@ -1154,10 +1243,10 @@ namespace System.Xml.Expression private static Term Fge (Domain domain, Variable vari, Term[] args) { - int n = (int) args[0]; + int n = args[0].Intval; for (int i = 1; i < args.Length; i++) { - int n1 = (int) args[i]; + int n1 = args[i].Intval; if (n < n1) return Zero; n = n1; @@ -1431,8 +1520,8 @@ namespace System.Xml.Expression return TermInt; if (args[0].IsStr) return TermStr; - if (args[0].IsName) - return TermName; + if (args[0].IsSymbol) + return TermSymbol; if (args[0].IsList) return TermList; return TermTerm; @@ -1442,7 +1531,7 @@ namespace System.Xml.Expression { Term result = Zero; try { - domain.Catch (new CatchTag (args[0].Nameval)); + domain.Catch (new CatchTag (args[0].Symval)); result = args[1].Eval (domain); } finally { domain.Uncatch (); @@ -1452,13 +1541,28 @@ namespace System.Xml.Expression public static Term Fthrow (Domain domain, Variable vari, Term[] args) { - domain.ThrowTag (new CatchTag (args[0].Nameval)); + domain.ThrowTag (new CatchTag (args[0].Symval)); return (args.Length == 1 ? Zero : args[1]); } - public class TermValue + public delegate TermValue TermParser (Domain domain, XmlNode node); + + public class TermType + { + public readonly Symbol type; + internal readonly TermParser parser; + + public TermType (Symbol type, TermParser parser) + { + this.type = type; + this.parser = parser; + } + } + + public abstract class TermValue { public virtual Term Eval (Domain domain) { return new Term (this); } + public virtual TermValue Clone () { return this; } } private class Funcall : TermValue @@ -1467,47 +1571,66 @@ namespace System.Xml.Expression internal Variable vari; internal Term[] args; - public Funcall (XmlNode node, Domain domain) + private Funcall (Function func, Variable vari, Term[] args) { - 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); + this.func = func; + this.vari = vari; + this.args = args; } - public Funcall (Domain domain, Name fname, Term[] args) + public Funcall (Domain domain, Symbol fname, Term[] args) { func = domain.GetFunc (fname); + if (args != null) + { + int nargs = args.Length; + if (nargs < func.min_arg + || (func.max_arg >= 0 && nargs > func.max_arg)) + throw new Exception ("Invalid number of arguments to: " + + fname + " " + nargs); + } this.args = args; } - public Funcall (Domain domain, Name fname, Name vname, Term[] args) + public Funcall (Domain domain, Symbol fname, Symbol vname, Term[] args) { func = domain.GetFunc (fname); - vari = domain.GetVar (vname, true); + if (args != null) + { + int nargs = args.Length; + if (nargs < func.min_arg + || (func.max_arg >= 0 && nargs > func.max_arg)) + throw new Exception ("Invalid number of arguments to: " + + fname + " " + nargs); + } this.args = args; + if (vname != Qnull) + vari = domain.GetVar (vname, true); + } + + internal static TermValue parser (Domain domain, XmlNode node) + { + Symbol fname = node.Name; + Symbol vname = Qnull; + XmlAttribute attr; + + if (fname == Qfuncall) + fname = node.Attributes[Qfname].Value; + attr = node.Attributes[Qvname]; + if (attr != null) + vname = attr.Value; + + XmlNodeList nlist = node.ChildNodes; + int nargs = nlist.Count; + Term[] args = new Term[nargs]; + for (int i = 0; i < nargs; i++) + args[i] = new Term (domain, nlist[i]); + return new Funcall (domain, fname, vname, args); } public override Term Eval (Domain domain) { - domain.DebugWrite (true, "(({0}", func.name); - for (int i = 0; i < args.Length; i++) - domain.DebugWrite (false, " {0}", args[i].ToString ()); - domain.DebugWrite (false, ")"); + domain.DebugWrite (true, ToString ()); domain.depth++; Term result = func.Call (domain, vari, args); domain.depth--; @@ -1515,15 +1638,25 @@ namespace System.Xml.Expression return result; } + public override TermValue Clone () + { + return new Funcall (func, vari, args); + } + public override string ToString () { - string str = ""; - str += "\">"; - foreach (Term e in args) - str += e; - return (str + ""); + return str + "/>"; + str += ">"; + if (func is Function.SpecialForm) + str += "..."; + else + foreach (Term e in args) + str += e; + return (str + ""); } } @@ -1532,18 +1665,23 @@ namespace System.Xml.Expression public int intval; public object objval; + // ... public Term (int i) { intval = i; objval = null; } - public Term (Name name) { intval = 0; objval = name; } + // ... + public Term (Symbol name) { intval = 0; objval = name; } + // ... public Term (string str) { intval = 0; objval = str; } + // ... public Term (List list) { intval = 0; objval = list; } + public Term (Term term) { intval = term.intval; objval = term.objval; } public Term (TermValue obj) { intval = 0; objval = obj; } - public Term (XmlNode node, Domain domain) + public Term (Domain domain, XmlNode node) { - Name name = node.Name; + Symbol name = node.Name; - if (name == Ninteger) + if (name == Qinteger) { intval = parse_integer (node.InnerText); objval = null; @@ -1551,25 +1689,53 @@ namespace System.Xml.Expression else { intval = 0; - if (name == Nsymbol) - objval = (Name) node.InnerText; - else if (name == Nstring) + if (name == Qsymbol) + objval = (Symbol) node.InnerText; + else if (name == Qstring) objval = node.InnerText.Clone (); - else if (name == Nvarref) - objval = domain.GetVar ((Name) node.Attributes[0].Value, true); - else if (name == Nlist) + else if (name == Qvarref) + objval = domain.GetVar ((Symbol) node.Attributes[0].Value, true); + else if (name == Qlist) { List list = new List (); for (node = node.FirstChild; node != null; node = node.NextSibling) - list.Add (new Term (node, domain)); + list.Add (new Term (domain, node)); objval = list; } else - objval = new Funcall (node, domain); + { + TermType term_type; + + if (domain.termtypes.TryGetValue (name, out term_type)) + objval = term_type.parser (domain, node); + else + objval = Funcall.parser (domain, node); + } } } + // + public Term (Domain domain, Symbol vname) + { + intval = 0; + objval = domain.GetVar (vname, true); + } + + // ... + public Term (Domain domain, Symbol fname, Term[] args) + { + intval = 0; + objval = new Funcall (domain, fname, args); + } + + // ... + public Term (Domain domain, Symbol fname, Symbol vname, Term[] args) + { + intval = 0; + objval = new Funcall (domain, fname, vname, args); + } + public object Objval { get { if (objval == null) @@ -1594,11 +1760,11 @@ namespace System.Xml.Expression } } - public string Nameval { + public string Symval { get { - if (! IsName) + if (! IsSymbol) throw new Exception ("term is not symbol: " + this); - return (Name) objval; + return (Symbol) objval; } } @@ -1621,7 +1787,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 IsSymbol { get { return (objval is Symbol); } } public bool IsList { get { return (objval is List); } } public bool IsType (Type type) @@ -1632,30 +1798,24 @@ namespace System.Xml.Expression public Term Eval (Domain domain) { - if (objval == null || objval is Name || objval is string) + if (objval == null || objval is Symbol || objval is string) return this; if (objval is List) return new Term ((List) objval); - if (objval is TermValue) - return ((TermValue) objval).Eval (domain); - throw new Exception ("invalid Term object: " + objval); - } - - public static explicit operator int (Term term) - { - if (term.objval != null) - throw new Exception ("Not an integer term: " + term); - return term.intval; - } - - public static explicit operator Name (Term term) - { - return (Name) term.objval; + return ((TermValue) objval).Eval (domain); } - public static implicit operator Term (int i) + public Term Clone () { - return new Term (i); + if (objval == null || objval is Symbol || objval is string) + return this; + if (objval is List) + { + List list = new List (); + list.InsertRange (0, ((List) objval)); + return new Term (list); + } + return new Term (((TermValue) objval).Clone ()); } public override string ToString () @@ -1664,7 +1824,7 @@ namespace System.Xml.Expression if (objval == null) str = "" + intval + ""; - else if (objval is Name) + else if (objval is Symbol) str = "" + objval + ""; else if (objval is string) str = "" + objval + ""; @@ -1675,12 +1835,10 @@ namespace System.Xml.Expression str += e; str += ""; } - else if (objval is Funcall) - str = ""; - else if (objval is Variable) - str = ""; else if (objval is Term) str = "" + objval + ""; + else if (objval is TermValue) + str = ((TermValue) objval).ToString (); else throw new Exception ("invalid Term object: " + objval); return str; @@ -1689,11 +1847,11 @@ namespace System.Xml.Expression 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"); + static private Term TermInt = new Term (Qinteger); + static private Term TermStr = new Term (Qstring); + static private Term TermSymbol = new Term (Qsymbol); + static private Term TermList = new Term (Qlist); + static private Term TermTerm = new Term ((Symbol) "term"); internal static int parse_integer (string str) { @@ -1746,54 +1904,67 @@ namespace System.Xml.Expression private Term[] terms; - private void parse_terms (Domain domain, XmlNode node) + public static Term[] ParseTerms (Domain domain, XmlNode node) { int nterms = 0; for (XmlNode n = node; n != null; n = n.NextSibling) if (n.NodeType == XmlNodeType.Element) { - if (n.Name == Ndefun) - domain.RegisterFunction (n); - else if (n.Name == Ndefvar) + if (n.Name == Qdefun) + domain.Defun (n, true); + else if (n.Name == Qdefvar) domain.Defvar (n); else nterms++; } - - terms = new Term[nterms]; + Term[] terms = new Term[nterms]; int i = 0; for (XmlNode n = node; n != null; n = n.NextSibling) if (n.NodeType == XmlNodeType.Element) { - if (n.Name == Ndefun) - domain.Defun (n); - else if (n.Name != Ndefvar) - terms[i++]= new Term (n, domain); + if (n.Name == Qdefun) + domain.Defun (n, false); + else if (n.Name != Qdefvar) + terms[i++]= new Term (domain, n); } + return terms; + } + + public static Term Eval (Domain domain, Term[] terms) + { + Term result = new Term (0); + foreach (Term term in terms) + { + result = term; + if (result.Objval is Funcall) + while ((result = result.Eval (domain)).Objval is Funcall); + } + return result; } + public Xexpression (Domain domain, XmlNode node) { - parse_terms (domain, node); + terms = ParseTerms (domain, node); } public Xexpression (Domain domain, string url) { - XmlDocument doc = new XmlDocument (Name.Table); + XmlDocument doc = new XmlDocument (Symbol.Table); XmlNode node; - using (XmlTextReader reader = new XmlTextReader (url, Name.Table)) + using (XmlTextReader reader = new XmlTextReader (url, Symbol.Table)) { do { reader.Read (); } while (reader.NodeType != XmlNodeType.None && (reader.NodeType != XmlNodeType.Element - || reader.Name != Nexpr)); + || reader.Name != Qexpr)); if (reader.NodeType == XmlNodeType.None) throw new Exception ("Node not found"); node = doc.ReadNode (reader); } - parse_terms (domain, node.FirstChild); + terms = ParseTerms (domain, node.FirstChild); } public Term Eval (Domain domain)