X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=XmlExpr.cs;h=53c764182e5d58486a937efc58929d09175e92fb;hb=eefa0b9efaf141df3fbfadb8bc31b09e6d55adc3;hp=947d32619084b03e686b57ef1def534782ab7b22;hpb=cd5dc7564e13dcc267d5f2513664b5d36e28074a;p=m17n%2Fm17n-lib-cs.git diff --git a/XmlExpr.cs b/XmlExpr.cs index 947d326..53c7641 100644 --- a/XmlExpr.cs +++ b/XmlExpr.cs @@ -2,73 +2,75 @@ using System; using System.Collections; using System.Collections.Generic; using System.IO; +using System.Reflection; using System.Xml; -namespace System.Xml.Expression +namespace System.Xml { - public abstract class Xex + public class Xexpression { - public static bool Debug = false; + private static int trace_depth = 0; - public struct Name : IEquatable + public static int TraceDepth { + get { return trace_depth; } + set { trace_depth = value; } + } + + public struct Symbol : IEquatable { private static NameTable nt = new NameTable (); private string name; - public Name (string str) - { - name = nt.Add (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) - { - return name.name; - } + public static implicit operator string (Symbol sym) { return sym.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); } public override bool Equals (object obj) { - return Object.ReferenceEquals (this.name, obj); + return (obj is Symbol ? this == (Symbol) obj + : obj is string ? this.name == (string) obj + : false); } public override int GetHashCode () @@ -76,51 +78,72 @@ namespace System.Xml.Expression return name.GetHashCode (); } - public static NameTable Table { get { return nt; } } + public static NameTable NameTable { get { return nt; } } public override string ToString () { return name; } } - private static Name Nexpr = "expr"; + private static Symbol Qexpr = "expr"; + + private static Symbol Qnull = ""; + private static Symbol Qfuncall = "funcall"; + private static Symbol Qinteger = "integer"; + private static Symbol Qstring = "string"; + private static Symbol Qsymbol = "symbol"; + private static Symbol Qlist = "list"; + + public static Symbol Qdefun = "defun"; + public static Symbol Qdefmacro = "defmacro"; + private static Symbol Qfname = "fname"; + private static Symbol Qargs = "args"; + private static Symbol Qfixed = "fixed"; + private static Symbol Qoptional = "optional"; + private static Symbol Qrest = "rest"; - private static Name Nfuncall = "funcall"; - private static Name Nvariable = "variable"; - private static Name Ninteger = "integer"; - private static Name Nstring = "string"; - private static Name Nboolean = "boolean"; - private static Name Nsymbol = "symbol"; - private static Name Nlist = "list"; - private static Name Nobject = "object"; + public static Symbol Qdefvar = "defvar"; + private static Symbol Qvname = "vname"; + private static Symbol Qdescription = "description"; + private static Symbol Qrange = "range"; - 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 Noptional = "optional"; - private static Name Nrest = "rest"; - private static Name Nbody = "body"; + private static Symbol Qename = "ename"; - private static Name Ndefvar = "defvar"; - private static Name Ndescription = "description"; - private static Name Nrange = "range"; + public static partial class Error + { + // Load time errors. + public static Symbol UnknownFunction = "unknown function"; + public static Symbol InvalidArgumentNumber = "invalid argument number"; + public static Symbol VariableNotAcceptable = "variable not acceptable"; + } + + public static partial class Error + { + // Run time errors. + public static Symbol ArithmeticError = "arithmetic error"; + public static Symbol InvalidArgumentType = "invalid argument type"; + public static Symbol NoVariable = "no-variable"; + public static Symbol InvalidVariableType = "invalid variable type"; + public static Symbol NoOuterLoop = "no outer loop"; + public static Symbol UnknownError = "unknown error"; + } - private static Name Nprogn = "progn"; - internal abstract class Function + public abstract class Function { - public Name name; + public Symbol name; public int min_arg, max_arg; + public bool setvar; public Function () { } - public Function (Name name, int min_arg, int max_arg) + public Function (Symbol name, int min_arg, int max_arg, bool setvar) { this.name = name; this.min_arg = min_arg; this.max_arg = max_arg; + this.setvar = setvar; } - public abstract object Call (object[] args, Domain domain); + public abstract Term Call (Domain domain, Variable vari, Term[] args); public override string ToString () { @@ -131,28 +154,26 @@ namespace System.Xml.Expression { public Builtin builtin; - public Subroutine (Builtin builtin, Name name, + public Subroutine (Builtin builtin, Symbol name, bool setvar, int min_arg, int max_arg) - : base (name, min_arg, max_arg) + : base (name, min_arg, max_arg, setvar) { this.builtin = builtin; } - public override object Call (object[] args, Domain domain) + public override Term Call (Domain domain, Variable vari, Term[] args) { - object result; - - for (int i = 0; i < args.Length; i++) + if (args.Length > 0) { - object val = args[i]; - if (val is Xex) - val = ((Xex) val).Eval (domain); - if (val == null) - throw new Exception (args[i] + ":evaled to null"); - args[i] = val; + args = (Term[]) args.Clone (); + for (int i = 0; i < args.Length; i++) + { + args[i] = args[i].Eval (domain); + if (domain.Thrown ()) + return args[i]; + } } - result = builtin (args, domain); - return result; + return builtin (domain, vari, args); } } @@ -160,235 +181,468 @@ namespace System.Xml.Expression { public Builtin builtin; - public SpecialForm (Builtin builtin, Name name, + public SpecialForm (Builtin builtin, Symbol name, bool setvar, int min_arg, int max_arg) - : base (name, min_arg, max_arg) + : base (name, min_arg, max_arg, setvar) { this.builtin = builtin; } - public override object Call (object[] args, Domain domain) + public override Term Call (Domain domain, Variable vari, Term[] args) { - return builtin (args, domain); + return builtin (domain, vari, args); } } - internal class Lambda : Function + private static void parse_head (Domain domain, XmlNode node, + out Symbol name, + out int min_arg, out int max_arg, + out Variable[] args) + { + int nfixed = 0; + int noptional = 0; + int nrest = 0; + name = node.Attributes[Qfname].Value; + + node = node.FirstChild; + if (node != null && node.Name == Qargs) + { + XmlNode n; + for (n = node.FirstChild; n != null; n = n.NextSibling) + { + if (n.Name == Qfixed) + nfixed += n.ChildNodes.Count; + else if (n.Name == Qoptional) + noptional += n.ChildNodes.Count; + 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) + { + for (XmlNode nn = n.FirstChild; nn != null; nn = nn.NextSibling) + args[i++] = domain.Defvar ((Symbol) nn.Attributes[0].Value); + } + if (nrest == 1) + max_arg = - max_arg; + } + else + { + min_arg = max_arg = 0; + args = new Variable[0]; + } + } + + private static void parse_body (Domain domain, XmlNode node, + out Term[] body) + { + for (node = node.FirstChild; node != null; node = node.NextSibling) + if (node.Name != Qdescription + && node.Name != Qargs) + break; + int nterms = 0; + for (XmlNode n = node; n != null; n = n.NextSibling) + nterms++; + if (nterms > 0) + { + body = new Term[nterms]; + for (nterms = 0; node != null; node = node.NextSibling, nterms++) + body[nterms] = new Term (domain, node); + } + else + body = null; + } + + internal class Macro : Function { - internal bool args_evalled; - internal Name[] args; - internal Xex[] body; + internal Variable[] args; + internal Term[] body; + + public Macro (Domain domain, XmlNode node) + { + parse_head (domain, node, out name, out min_arg, out max_arg, + out args); + setvar = false; + } - public Lambda (XmlNode node) + public void SetBody (Domain domain, XmlNode node) { - int nargs = 0, noptions = 0, nrest = 0; - name = node.Attributes[Nfname].Value; - - node = node.FirstChild; - if (node != null - && (node.Name == Nargs || node.Name == Nargs_unevalled)) + parse_body (domain, node, out body); + } + + public override Term Call (Domain domain, Variable vari, Term[] args) + { + Bindings current = domain.bindings; + Term result = Zero; + int rest_idx = max_idx < 0 ? - max_idx : args.Length; + + for (int i = 0; i < rest_idx; i++) + domain.Bind (this.args[i], args[i]); + if (i < args.Length) + { + List rest = new List (); + + for (; i < args.Length; i++) + rest.Add (args[i]); + domain.Bind (this.args[rest_idx], rest); + } + + if (body != null) { - XmlNode n; - args_evalled = node.Name == Nargs; - for (n = node.FirstChild; n != null; n = n.NextSibling) + domain.Catch (CatchTag.Return); + foreach (Term term in body) { - if (n.Name != Nsymbol) + result = term.Eval (domain); + if (domain.Thrown ()) break; - nargs++; } - 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; - if (nrest == 1) - max_arg = - max_arg; - args = new Name[max_arg]; - n = node.FirstChild; - for (int i = 0; i < max_arg; n = n.NextSibling) - if (n.Name == Nsymbol) - args[i++] = n.InnerText; - } - else - { - min_arg = max_arg = 0; + domain.Uncatch (); } + domain.UnboundTo (current); + return result; } + } - public void SetBody (XmlNode node, Domain domain) - { + internal class Lambda : Function + { + internal Variable[] args; + internal Term[] body; - for (node = node.FirstChild; node != null && node.Name != Nbody; - node = node.NextSibling); - if (node != null) - { - XmlNodeList nlist = node.ChildNodes; + public Lambda (Domain domain, XmlNode node) + { + parse_head (domain, node, out name, out min_arg, out max_arg, + out args); + setvar = false; + } - body = new Xex[nlist.Count]; - for (int i = 0; i < nlist.Count; i++) - body[i] = New (nlist[i], domain); - } + public Lambda (Domain domain, Symbol name, Symbol[] args) + { + int nfixed = 0; + int noptional = 0; + int nrest = 0; + + this.name = name; + if (args.Length > 0) + { + 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; + } + setvar = false; + } + + public void SetBody (Domain domain, XmlNode node) + { + parse_body (domain, node, out body); } - public override object Call (object[] args, Domain domain) + public void SetBody (Term[] body) + { + this.body = body; + } + + public override Term Call (Domain domain, Variable vari, Term[] args) { Bindings current = domain.bindings; - object result = false; + Term result = Zero; try { int i; - if (args_evalled) - for (i = 0; i < min_arg; i++) - args[i] = ((Xex) args[i]).Eval (domain); + if (args.Length > 0) + { + Term[] newargs = new Term[args.Length]; + for (i = 0; i < min_arg; i++) + newargs[i] = args[i].Eval (domain); + args = newargs; + } for (i = 0; i < min_arg; i++) + domain.Bind (this.args[i], args[i]); + if (body != null) { - Variable var = domain.GetVar (this.args[i]); - domain.Bind (var, args[i]); + try { + domain.Catch (CatchTag.Return); + foreach (Term term in body) + { + result = term.Eval (domain); + if (domain.Thrown ()) + return result; + } + } finally { + domain.Uncatch (); + } } - foreach (Xex e in body) - result = e.Eval (domain); } finally { domain.UnboundTo (current); } return result; } - - public override string ToString () - { - string str = "(" + name; - foreach (Name a in args) - str += " " + a; - return (str + ")"); - } } } - internal abstract class Variable + public class Variable { - public readonly Name name; - public readonly Name type; - internal object val; + public Domain domain; + public readonly Symbol name; + protected Term val; - public Variable (Name name, Name type, object value) + public Variable (Domain domain, Symbol name, Term val) { - if (value != null) - Value = value; + this.domain = domain; this.name = name; - this.type = type; + this.val = val; + } + + public virtual bool ValueP (Term val) { return true; } + + public virtual Variable Clone (Domain domain) + { + return new Variable (domain, name, val); } - public object Value + public virtual void Reset () { val = Zero; } + + public Term Value { get { return val; } - set - { - if (! ValueP (value)) - throw new Exception ("Invalid value of " + name + ": " + value); - val = value; - } + set { + if (! ValueP (value)) + throw new Exception ("Invalid value: " + value); + val = value; + } + } + + public Term SetValue (int i) + { + val.intval = i; + val.objval = null; + return val; } - public abstract bool ValueP (object value); + public Term SetValue (string s) + { + val.objval = s; + return val; + } public override string ToString () { return name + "(" + val + ")"; } - } - internal class VarInt : Variable - { - public struct Range + public abstract class Typed : Variable { - public int from, to; - } + protected string desc; + private Term default_val; + + protected Typed (Domain domain, Symbol name, Term val, string desc) + : base (domain, name, val) + { + this.desc = desc; + default_val = val; + } - public Range[] ranges; + public override void Reset () { val = default_val; } - public VarInt (Name name, object value) : base (name, Ninteger, value) { } + public string Description { + get { return desc; } + set { desc = value; } + } + } - public override bool ValueP (object value) + public class Int : Typed { - int i; + private int[] range; - if (! (value is int)) - return false; - if (ranges == null) - return true; - i = (int) value; - foreach (Range r in ranges) - if (i >= r.from && i <= r.to) + public bool IsSubrange (int[] r) + { + if (range == null) + return true; + for (int i = 0; i < r.Length; i += 2) + { + int j; + for (j = 0; j < range.Length; j += 2) + if (range[j] <= r[i] && range[j + 1] >= r[i + 1]) + break; + if (j >= range.Length) + return false; + } return true; - return false; - } - } + } - internal class VarStr : Variable - { - public string[] ranges; + public Int (Domain domain, Symbol name, int n, string desc, int[] range) + : base (domain, name, new Term (n), desc) + { + if (range != null && range.Length % 2 == 1) + throw_exception ("Range length for {0} not even", name); + this.range = range; + if (! ValueP (val)) + throw_exception ("Invalid integer value for {0}: {1}", name, val); + } + + public override bool ValueP (Term term) + { + if (! term.IsInt) + return false; + if (range == null) + return true; + int n = term.Intval; + for (int i = 0; i < range.Length; i += 2) + if (range[i] <= n && range[i + 1] >= n) + return true; + return false; + } + + public override Variable Clone (Domain domain) + { + return new Int (domain, name, val.Intval, desc, range); + } - public VarStr (Name name, object value) : base (name, Nstring, value) { } + public int[] Range { get { return range; } set { range = value; } } + } - public override bool ValueP (object value) + public class Str : Typed { - string str; + private string[] range; - if (! (value is string)) - return false; - if (ranges == null) - return true; - str = (string) value; - foreach (string s in ranges) - if (s == str) + public bool IsSubrange (string[] r) + { + if (range == null) + return true; + for (int i = 0; i < r.Length; i++) + { + int j; + for (j = 0; j < range.Length; j++) + if (range[j] == r[i]) + break; + if (j >= range.Length) + return false; + } return true; - return false; - } - } + } - internal class VarBool : Variable - { - public VarBool (Name name, object value) - : base (name, Nboolean, value) { } + public Str (Domain domain, Symbol name, string str, string desc, + string[] range) + : base (domain, name, new Term (str), desc) + { + this.range = range; + if (! ValueP (val)) + throw_exception ("Invalid string value for {0}: {1}", name, val); + } - public override bool ValueP (object value) - { - if (! (value is bool)) + public override bool ValueP (Term term) + { + if (! term.IsStr) + return false; + if (range == null) + return true; + string str = term.Strval; + foreach (string s in range) + if (str == s) + return true; return false; - return true; - } - } + } - internal class VarMisc : Variable - { - public VarMisc (Name name, object value) : base (name, Nobject, value) { } + public override Variable Clone (Domain domain) + { + return new Str (domain, name, val.Strval, desc, range); + } + + public string[] Range { get { return range; } set { range = value; } } + } - public override bool ValueP (object value) + public class Sym : Typed { - return true; + public Symbol[] range; + + public bool IsSubrange (Symbol[] r) + { + if (range == null) + return true; + for (int i = 0; i < r.Length; i++) + { + int j; + for (j = 0; j < range.Length; j++) + if (range[j] == r[i]) + break; + if (j >= range.Length) + return false; + } + return true; + } + + public Sym (Domain domain, Symbol name, Symbol sym, string desc, + Symbol[] range) + : base (domain, name, new Term (sym), desc) + { + this.range = range; + if (! ValueP (val)) + throw_exception ("Invalid symbol value for {0}: {1}", name, val); + } + + public override bool ValueP (Term term) + { + if (! term.IsSymbol) + return false; + if (range == null) + return true; + Symbol name = term.Symval; + foreach (Symbol n in range) + if (name == n) + return true; + return false; + } + + public override Variable Clone (Domain domain) + { + return new Sym (domain, name, val.Symval, desc, range); + } + + public Symbol[] Range { get { return range; } set { range = value; } } } } internal class Bindings { private Variable vari; - private object old_value; + private Term old_value; private Bindings next; private Bindings (Variable vari) { this.vari = vari; - old_value = vari.val; + old_value = vari.Value; } - public static Bindings Bind (Bindings bindings, - Variable vari, object value) + public static Bindings Bind (Bindings bindings, Variable vari, Term val) { Bindings b = new Bindings (vari); - b.vari.Value = value; + b.vari.Value = val; b.next = bindings; return b; } @@ -396,7 +650,7 @@ namespace System.Xml.Expression internal Bindings UnboundTo (Bindings boundary) { for (Bindings b = this; b != boundary; b = b.next) - b.vari.val = b.old_value; + b.vari.Value = b.old_value; return boundary; } @@ -409,47 +663,67 @@ namespace System.Xml.Expression } } -#if false - internal class ThrowException : Exception + private static void throw_exception (string fmt, params object[] args) { - Name tag; - public object value; + throw new Exception (String.Format (fmt, args)); + } - public ThrowException (Name tag, object value) : base () - { - this.tag = tag; - this.value = value; - } + internal struct CatchTag + { + private Term tag; + + public CatchTag (Symbol sym) { tag = new Term (sym); } + public CatchTag (Symbol sym, string msg) { tag = new Term (sym, msg); } + public CatchTag (ErrorTerm e) { tag = new Term (e); } + private CatchTag (int i) { tag = new Term (i); } + + public Term Tag { get { return tag; } } + + public static CatchTag Return = new CatchTag (0); + public static CatchTag Break = new CatchTag (1); } -#endif public class Domain { + public Symbol name; public object context; public int depth = 0; - - internal Dictionary functions; - internal Dictionary variables; + private Stack call_stack = new Stack (); + + 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 (Symbol name) { this.name = name; } - internal Domain () + public Domain (Symbol name, object context) + : this (name, basic, context) { } + + public Domain (Symbol name, Domain parent, object context) : this (name) { - functions = new Dictionary (); - variables = new Dictionary (); + termtypes = new Dictionary (parent.termtypes); + functions = new Dictionary (parent.functions); + variables = new Dictionary (parent.variables); + this.context = context; } - public Domain (object context) : this (basic, context) + internal void PushTerm (Term term) { + call_stack.Push (term); } - public Domain (Domain parent, object context) + internal void PopTerm () { - functions = new Dictionary (parent.functions); - variables = new Dictionary (parent.variables); - this.context = context; + call_stack.Pop (); } - internal void Bind (Variable vari, object value) + internal void Bind (Variable vari, Term value) { bindings = Bindings.Bind (bindings, vari, value); } @@ -460,50 +734,196 @@ namespace System.Xml.Expression bindings = bindings.UnboundTo (boundary); } - public void DefSubr (Builtin builtin, string str, - int min_arg, int max_arg) + 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--; + } + + public bool Thrown () { return catch_count < catch_stack.Count; } + + public bool Thrown (out bool caught) + { + if (catch_count < catch_stack.Count) + { + caught = catch_count == catch_stack.Count - 1; + return true; + } + caught = false; + return false; + } + + internal void ThrowReturn () + { + foreach (CatchTag elt in catch_stack) + { + catch_count--; + if (elt.Tag == CatchTag.Return.Tag) + break; + } + } + + internal bool ThrowBreak () + { + if (catch_stack.Peek ().Tag != CatchTag.Break.Tag) + return false; + catch_count--; + return true; + } + + internal void ThrowSymbol (Term tag) + { + foreach (CatchTag elt in catch_stack) + { + catch_count--; + if (elt.Tag.Matches (tag)) + break; + } + } + + internal Term ThrowError (Term tag) + { + tag = tag.Clone (); + ErrorTerm e = tag.objval as ErrorTerm; + e.CallStack = call_stack.ToArray (); + + foreach (CatchTag elt in catch_stack) + { + catch_count--; + if (elt.Tag.Matches (tag)) + break; + } + return tag; + } + + public void DefType (Type type) { - Name name = str; - functions[name] - = new Function.Subroutine (builtin, name, min_arg, max_arg); + if (! type.IsSubclassOf (typeof (TermValue))) + throw new Exception ("Not a subclass of TermValue: " + type); + BindingFlags flags = BindingFlags.Static | BindingFlags.NonPublic; + FieldInfo finfo = type.GetField ("name", flags); + if (finfo == null || finfo.FieldType != typeof (Symbol)) + throw new Exception ("No \"name\" field of string type: " + type); + Symbol name = (Symbol) finfo.GetValue (null); + if (termtypes.ContainsKey (name) + || functions.ContainsKey (name)) + throw new Exception ("already defined: " + name); + Type[] types = new Type[] { typeof (Domain), typeof (XmlNode) }; + MethodInfo minfo = type.GetMethod ("Parser", types); + if (minfo == null || minfo.ReturnType != typeof (TermValue)) + throw new Exception ("No \"Parser\" method of correct type: " + type); + termtypes[name] = minfo; } - public void DefSpecial (Builtin builtin, string str, - int min_arg, int max_arg) + public void DefSubr (Builtin builtin, string str, bool setvar, + int min_arg, int max_arg, params string[] aliases) { - Name name = str; - functions[name] - = new Function.SpecialForm (builtin, name, min_arg, max_arg); + Symbol name = str; + if (termtypes.ContainsKey (name)) + throw new Exception ("already defined as termtype: " + name); + Function func = new Function.Subroutine (builtin, name, setvar, + min_arg, max_arg); + functions[name] = func; + foreach (string a in aliases) + functions[(Symbol) a] = func; } - internal Function.Lambda RegisterFunction (XmlNode node) + public void DefSpecial (Builtin builtin, string str, bool setvar, + int min_arg, int max_arg, + params string[] aliases) { - Function.Lambda lambda = new Function.Lambda (node); + Symbol name = str; + if (termtypes.ContainsKey (name)) + throw new Exception ("already defined as termtype: " + name); + Function func = new Function.SpecialForm (builtin, name, setvar, + min_arg, max_arg); + functions[name] = func; + foreach (string a in aliases) + functions[(Symbol) a] = func; + } - functions[lambda.name] = lambda; - return lambda; + public void DefAlias (string alias, string str) + { + functions[(Symbol) alias] = functions[(Symbol) str]; } - internal Function Defun (XmlNode node) + public void Defun (Symbol name, Symbol[] args, Term[] body, + bool prototype) { - Name name = node.Attributes[Nfname].Value; Function func; - if (! functions.TryGetValue (name, out func)) - func = RegisterFunction (node); - ((Function.Lambda) func).SetBody (node, this); - return func; + if (termtypes.ContainsKey (name)) + throw new Exception ("already defined as termtype: " + name); + if (prototype || ! functions.TryGetValue (name, out func)) + { + func = new Function.Lambda (this, name, args); + functions[name] = func; + } + if (! prototype) + ((Function.Lambda) func).SetBody (body); + } + + public void Defun (XmlNode node, bool prototype) + { + Symbol name = node.Attributes[Qfname].Value; + if (termtypes.ContainsKey (name)) + throw new Exception ("already defined as termtype: " + name); + 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 (Function func) + { + functions[func.name] = func; + } + + public void Defmacro (XmlNode node, bool prototype) + { + Symbol name = node.Attributes[Qfname].Value; + if (termtypes.ContainsKey (name)) + throw new Exception ("already defined as termtype: " + name); + Function func; + + if (prototype || ! functions.TryGetValue (name, out func)) + { + func = new Function.Macro (this, node); + functions[name] = func; + } + if (! prototype) + ((Function.Macro) func).SetBody (this, node); } - public void Defvar (Name name, XmlNode node) + public Variable Defvar (XmlNode node) { + Symbol name = node.Attributes[0].Value; + String desc; Variable vari; - if (node.Name == Ndescription) - node = node.NextSibling; + node = node.FirstChild; + if (node != null && node.Name == Qdescription) + { + desc = node.InnerText; + node = node.NextSibling; + } + else + desc = null; if (node != null) { - Name type = node.Name; + Symbol type = node.Name; XmlNodeList range_list = null; int nranges = 0; string val = node.InnerText; @@ -515,55 +935,164 @@ namespace System.Xml.Expression nranges = range_list.Count; } - if (type == Ninteger) + if (type == Qinteger) { - VarInt vi = new VarInt (name, parse_integer (val)); + int n = parse_integer (val); + int[] range = null; if (range_list != null) { - vi.ranges = new VarInt.Range[nranges]; - + range = new int[nranges * 2]; for (int i = 0; i < nranges; i++) { - XmlNode n = range_list[i]; - - if (n.Name == Nrange) + XmlNode nd = range_list[i]; + if (nd.Name == Qrange) { - vi.ranges[i].from = - parse_integer (n.FirstChild.InnerText); - vi.ranges[i].to = - parse_integer (n.LastChild.InnerText); + range[i * 2] + = parse_integer (nd.FirstChild.InnerText); + range[i * 2 + 1] + = parse_integer (nd.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 (nd.FirstChild.InnerText); } } } - vari = vi; + vari = DefvarInt (name, n, desc, range); } - else if (type == Nstring) + else if (type == Qstring) { - VarStr vs = new VarStr (name, val); + string[] range = null; if (range_list != null) - vs.ranges = new string[nranges]; - for (int i = 0; i < nranges; i++) - vs.ranges[i] = range_list[i].Value; - vari = vs; + { + range = new string[nranges]; + for (int i = 0; i < nranges; i++) + range[i] = range_list[i].FirstChild.InnerText; + } + vari = DefvarStr (name, val, desc, range); } - else if (type == Nboolean) + else if (type == Qsymbol) { - vari = new VarBool (name, val == "true"); + Symbol[] range = null; + if (range_list != null) + { + range = new Symbol[nranges]; + for (int i = 0; i < nranges; i++) + range[i] = range_list[i].FirstChild.InnerText; + } + vari = DefvarSym (name, (Symbol) val, desc, range); } else throw new Exception ("Unknown type: " + type); } else - vari = new VarMisc (name, null); + { + if (variables.TryGetValue (name, out vari)) + vari = vari.Clone (this); + else + vari = new Variable (this, name, Zero); + variables[name] = vari; + } + return vari; + } + + public Variable Defvar (Variable vari) + { + vari = vari.Clone (this); + variables[vari.name] = vari; + return vari; + } + + internal Variable Defvar (Symbol name) + { + Variable vari = new Variable (this, name, Zero); variables[name] = vari; + return vari; + } + + public Variable DefvarInt (Symbol name, int n, string desc, int[] range) + { + Variable vari; + + if (variables.TryGetValue (name, out vari)) + { + Variable.Int intvari = vari as Variable.Int; + if (intvari == null) + throw new Exception ("Variable type mismatch: " + name); + if (range != null) + { + if (! intvari.IsSubrange (range)) + throw new Exception ("Variable range mismatch: " + name); + intvari.Range = range;; + } + if (desc != null) + intvari.Description = desc; + } + else + { + vari = new Variable.Int (this, name, n, desc, range); + variables[name] = vari; + } + return vari; + } + + public Variable DefvarStr (Symbol name, string str, string desc, + string[] range) + { + Variable vari; + + if (variables.TryGetValue (name, out vari)) + { + Variable.Str strvari = vari as Variable.Str; + if (strvari == null) + throw new Exception ("Variable type mismatch: " + name); + if (range != null) + { + if (! strvari.IsSubrange (range)) + throw new Exception ("Variable range mismatch: " + name); + strvari.Range = range; + } + if (desc != null) + strvari.Description = desc; + } + else + { + vari = new Variable.Str (this, name, str, desc, range); + variables[name] = vari; + } + return vari; } - internal Function GetFunc (Name name) + public Variable DefvarSym (Symbol name, Symbol sym, string desc, + Symbol[] range) + { + Variable vari; + + if (variables.TryGetValue (name, out vari)) + { + Variable.Sym symvari = vari as Variable.Sym; + if (symvari == null) + throw new Exception ("Variable type mismatch: " + name); + if (range != null) + { + if (! symvari.IsSubrange (range)) + throw new Exception ("Variable range mismatch: " + name); + symvari.Range = range; + } + if (desc != null) + symvari.Description = desc; + } + else + { + vari = new Variable.Sym (this, name, sym, desc, range); + variables[name] = vari; + } + return vari; + } + + internal Function GetFunc (Symbol name) { Function func; @@ -572,7 +1101,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); @@ -582,27 +1111,31 @@ namespace System.Xml.Expression public void CopyFunc (Domain domain) { - foreach (KeyValuePair kv in functions) + foreach (KeyValuePair kv in functions) domain.functions[kv.Key] = kv.Value; } - internal Variable GetVar (Name name) + public Variable GetVar (Symbol name, bool create) { Variable vari; if (! variables.TryGetValue (name, out vari)) - variables[name] = vari = new VarMisc (name, null); + { + if (! create) + return null; + variables[name] = vari = new Variable (this, name, Zero); + } return vari; } public override string ToString () { string str = "<(functions"; - foreach (KeyValuePair kv in functions) + foreach (KeyValuePair kv in functions) str += " " + kv.Key; str += ") (variabls"; - foreach (KeyValuePair kv in variables) - str += " " + kv.Key; + foreach (KeyValuePair kv in variables) + str += " " + kv.Value; str += ")"; if (bindings != null) str += " " + bindings; @@ -612,499 +1145,1090 @@ namespace System.Xml.Expression return str; } - public void DebugWrite (bool head, string fmt, params object[] arg) + internal void TraceWrite (string fmt, params string[] arg) { - if (Debug) + if (trace_depth > depth) { - if (head) - { - Console.WriteLine (); - for (int i = 0; i < depth; i++) - Console.Write (" "); - } - Console.Write (fmt, arg); + for (int i = 0; i < depth; i++) + Console.Write (" "); + Console.WriteLine (fmt, arg); } } + + public object SaveValues () + { + Dictionary values = new Dictionary (); + + foreach (KeyValuePair kv in variables) + values[kv.Value] = kv.Value.Value.Clone (); + return values; + } + + public void RestoreValues (object values) + { + foreach (KeyValuePair kv + in (Dictionary) values) + kv.Key.Value = kv.Value; + } } - public delegate object Builtin (object[] args, Domain domain); + public delegate Term Builtin (Domain domain, Variable vari, Term[] args); - private static Domain basic = new Domain (); + private static Domain basic = new Domain ("basic"); - internal static Function Fprogn; + static Xexpression () + { + basic.DefType (typeof (Varref)); + basic.DefType (typeof (Funcall)); + basic.DefType (typeof (ErrorTerm)); + + 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.DefSubr (Fthrow, "throw", false, 1, 2); + + basic.DefSpecial (Fand, "and", false, 1, -1, "&&"); + basic.DefSpecial (For, "or", false, 1, -1, "||"); + basic.DefSpecial (Fprogn, "progn", false, 0, -1, "expr"); + basic.DefSpecial (Fif, "if", false, 2, 3); + basic.DefSpecial (Fwhen, "when", false, 1, -1); + basic.DefSpecial (Floop, "loop", false, 1, -1); + basic.DefSpecial (Fwhile, "while", false, 1, -1); + basic.DefSpecial (Fcond, "cond", false, 1, -1); + basic.DefSpecial (Fforeach, "foreach", true, 2, -1); + basic.DefSpecial (Fquote, "quote", false, 1, 1); + basic.DefSpecial (Ftype, "type", false, 1, 1); + basic.DefSpecial (Fcatch, "catch", true, 2, -1); + } - static Xex () + private static Term Fset (Domain domain, Variable vari, Term[] args) { - basic.DefSubr (set_value, "set", 2, 2); - basic.DefSubr (set_value, "=", 2, 2); - basic.DefSpecial (and, "and", 1, -1); - basic.DefSpecial (and, "&&", 1, -1); - basic.DefSpecial (or, "or", 1, -1); - basic.DefSpecial (or, "||", 1, -1); - basic.DefSubr (not, "not", 1, 1); - basic.DefSubr (not, "!", 1, 1); - basic.DefSubr (add, "add", 2, -1); - basic.DefSubr (add, "+", 2, -1); - basic.DefSubr (mul, "mul", 2, -1); - basic.DefSubr (mul, "*", 2, -1); - basic.DefSubr (sub, "sub", 1, -1); - basic.DefSubr (sub, "-", 1, -1); - basic.DefSubr (div, "div", 2, -1); - basic.DefSubr (div, "/", 2, -1); - basic.DefSubr (mod, "mod", 2, 2); - basic.DefSubr (mod, "%", 2, 2); - basic.DefSubr (logior, "logior", 2, -1); - basic.DefSubr (logior, "|", 2, -1); - basic.DefSubr (logand, "logand", 2, -1); - basic.DefSubr (logand, "&", 2, -1); - basic.DefSubr (add_set, "add-set", 2, -1); - basic.DefSubr (add_set, "+=", 2, -1); - basic.DefSubr (mul_set, "mul-set", 2, -1); - basic.DefSubr (mul_set, "*=", 2, -1); - basic.DefSubr (sub_set, "sub-set", 2, -1); - basic.DefSubr (sub_set, "-=", 2, -1); - basic.DefSubr (div_set, "div-set", 2, -1); - basic.DefSubr (div_set, "/=", 2, -1); - basic.DefSubr (mod_set, "mod-set", 2, 2); - basic.DefSubr (mod_set, "%=", 2, 2); - basic.DefSubr (logior_set, "logior-set", 2, -1); - basic.DefSubr (logior_set, "|=", 2, -1); - basic.DefSubr (logand_set, "logand-set", 2, -1); - basic.DefSubr (logand_set, "&=", 2, -1); - basic.DefSubr (lsh, "lsh", 2, 2); - basic.DefSubr (lsh, "<<", 2, 2); - basic.DefSubr (rsh, "rsh", 2, 2); - basic.DefSubr (rsh, ">>", 2, 2); - basic.DefSubr (lsh_set, "lsh-set", 2, 2); - basic.DefSubr (lsh_set, "<<=", 2, 2); - basic.DefSubr (rsh_set, "rsh-set", 2, 2); - basic.DefSubr (rsh_set, ">>=", 2, 2); - basic.DefSubr (eq, "eq", 2, -1); - basic.DefSubr (eq, "==", 2, -1); - basic.DefSubr (noteq, "noteq", 2, 2); - basic.DefSubr (noteq, "!=", 2, 2); - basic.DefSubr (less_than, "lt", 2, -1); - basic.DefSubr (less_than, "<", 2, -1); - basic.DefSubr (less_eq, "le", 2, -1); - basic.DefSubr (less_eq, "<=", 2, -1); - basic.DefSubr (greater_than, "gt", 2, -1); - basic.DefSubr (greater_than, ">", 2, -1); - basic.DefSubr (greater_eq, "ge", 2, -1); - basic.DefSubr (greater_eq, ">=", 2, -1); - basic.DefSubr (eval_clause, "eval", 1, 1); - basic.DefSpecial (progn_clause, "progn", 0, -1); - basic.DefSpecial (progn_clause, "expr", 0, -1); - basic.DefSpecial (if_clause, "if", 2, -1); - basic.DefSpecial (when_clause, "when", 1, -1); - basic.DefSpecial (while_clause, "while", 1, -1); - - Fprogn = basic.GetFunc (Nprogn); + if (vari == null) + return new Term (new ErrorTerm (Error.NoVariable, "")); + vari.Value = args[0]; + return args[0]; } - private static bool is_true (object val) + private static Term Fnot (Domain domain, Variable vari, Term[] args) { - return (val is bool ? (bool) val - : val is int ? (int) val == 0 - : true); + return args[0].IsTrue ? Zero : One; } - private static object set_value (object[] args, Domain domain) + private static Term Fadd (Domain domain, Variable vari, Term[] args) { - Variable vari = domain.GetVar ((Name) args[0]); + int n = vari == null ? 0 : vari.Value.Intval; - vari.Value = args[1]; - return vari.val; + foreach (Term arg in args) + n += arg.Intval; + return (vari == null ? new Term (n) : vari.SetValue (n)); } - private static object and (object[] args, Domain domain) + private static Term Fmul (Domain domain, Variable vari, Term[] args) { - foreach (object arg in args) - if (! is_true (((Xex) arg).Eval (domain))) - return false; - return true; + int n = vari == null ? 1 : vari.Value.Intval; + foreach (Term arg in args) + n *= arg.Intval; + return (vari == null ? new Term (n) : vari.SetValue (n)); } - private static object or (object[] args, Domain domain) + private static Term Fsub (Domain domain, Variable vari, Term[] args) { - foreach (object arg in args) - if (is_true (((Xex) arg).Eval (domain))) - return true; - return false; + int n, i; + + if (vari == null) + { + n = args[0].Intval; + i = 1; + } + else + { + n = vari.Value.Intval; + i = 0; + } + while (i < args.Length) + n -= args[i++].Intval; + return (vari == null ? new Term (n) : vari.SetValue (n)); } - private static object not (object[] args, Domain domain) + private static Term Fdiv (Domain domain, Variable vari, Term[] args) { - return ! is_true (args); + int n, i; + + if (vari == null) + { + n = args[0].Intval; + i = 1; + } + else + { + n = vari.Value.Intval; + i = 0; + } + while (i < args.Length) + n /= args[i++].Intval; + return (vari == null ? new Term (n) : vari.SetValue (n)); } - private static object add (object[] args, Domain domain) + private static Term Fmod (Domain domain, Variable vari, Term[] args) { - int n = 0; - foreach (object arg in args) - n += (int) arg; - return n; + int n = args[0].Intval % args[1].Intval; + + return (vari == null ? new Term (n) : vari.SetValue (n)); } - private static object mul (object[] args, Domain domain) + private static Term Flogior (Domain domain, Variable vari, Term[] args) { - int n = 1; - foreach (object arg in args) - n *= (int) arg; - return n; + int n = vari == null ? 0 : vari.Value.Intval; + foreach (Term arg in args) + n |= arg.Intval; + return (vari == null ? new Term (n) : vari.SetValue (n)); } - private static object sub (object[] args, Domain domain) + private static Term Flogand (Domain domain, Variable vari, 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; + int n, i; + + if (vari == null) + { + n = args[0].Intval; + i = 1; + } + else + { + n = vari.Value.Intval; + i = 0; + } + while (i < args.Length) + n &= args[i++].Intval; + return (vari == null ? new Term (n) : vari.SetValue (n)); } - private static object div (object[] args, Domain domain) + private static Term Flsh (Domain domain, Variable vari, Term[] args) { - int n = (int) args[0]; - for (int i = 1; i < args.Length; i++) - n /= (int) args[i]; - return n; + int n = args[0].Intval << args[1].Intval; + return (vari == null ? new Term (n) : vari.SetValue (n)); } - private static object mod (object[] args, Domain domain) + private static Term Frsh (Domain domain, Variable vari, Term[] args) { - return ((int) args[0] % (int) args[1]); + int n = args[0].Intval >> args[1].Intval; + return (vari == null ? new Term (n) : vari.SetValue (n)); } - private static object logior (object[] args, Domain domain) + private static Term Feq (Domain domain, Variable vari, Term[] args) { - int n = 0; - foreach (object arg in args) - n |= (int) arg; - return n; + Term o = args[0]; + + if (o.objval == null) + { + for (int i = 1; i < args.Length; i++) + if (args[i].objval != null || args[i].intval != o.intval) + return Zero; + } + else + { + for (int i = 1; i < args.Length; i++) + if (o.objval.Equals (args[i].objval)) + return Zero; + } + return One; } - private static object logand (object[] args, Domain domain) + private static Term Fnoteq (Domain domain, Variable vari, Term[] args) { - int n = (int) args[0]; - for (int i = 1; i < args.Length; i++) - n &= (int) args[i]; - return n; + return Feq (domain, vari, args); } - private static object add_set (object[] args, Domain domain) + private static Term Flt (Domain domain, Variable vari, Term[] args) { - Variable vari = domain.GetVar ((Name) ((Xex.Const) args[0]).val); - int n = (int) vari.val; + int n = args[0].Intval; for (int i = 1; i < args.Length; i++) - n += (int) args[i]; - vari.val = n; - return n; + { + int n1 = args[i].Intval; + if (n >= n1) + return Zero; + n = n1; + } + return One; } - private static object mul_set (object[] args, Domain domain) + private static Term Fle (Domain domain, Variable vari, Term[] args) { - Variable vari = domain.GetVar ((Name) ((Xex.Const) args[0]).val); - int n = (int) vari.val; - + int n = args[0].Intval; for (int i = 1; i < args.Length; i++) - n *= (int) args[i]; - vari.val = n; - return n; + { + int n1 = args[i].Intval; + if (n > n1) + return Zero; + n = n1; + } + return One; } - private static object sub_set (object[] args, Domain domain) + private static Term Fgt (Domain domain, Variable vari, Term[] args) { - Variable vari = domain.GetVar ((Name) ((Xex.Const) args[0]).val); - int n = (int) vari.val; - + int n = args[0].Intval; for (int i = 1; i < args.Length; i++) - n -= (int) args[i]; - vari.val = n; - return n; + { + int n1 = args[i].Intval; + if (n <= n1) + return Zero; + n = n1; + } + return One; } - private static object div_set (object[] args, Domain domain) + private static Term Fge (Domain domain, Variable vari, Term[] args) { - Variable vari = domain.GetVar ((Name) ((Xex.Const) args[0]).val); - int n = (int) vari.val; - + int n = args[0].Intval; for (int i = 1; i < args.Length; i++) - n /= (int) args[i]; - vari.val = n; - return n; + { + int n1 = args[i].Intval; + if (n < n1) + return Zero; + n = n1; + } + return One; } - private static object mod_set (object[] args, Domain domain) + private static Term Fappend (Domain domain, Variable vari, Term[] args) { - Variable vari = domain.GetVar ((Name) ((Xex.Const) args[0]).val); - int n = (int) vari.val; + List list; - for (int i = 1; i < args.Length; i++) - n %= (int) args[i]; - vari.val = n; - return n; + if (vari == null) + list = new List (); + else + list = vari.Value.Listval; + + foreach (Term arg in args) + { + if (arg.IsList) + list.AddRange ((List) arg.objval); + else + list.Add (arg); + } + if (vari == null) + { + Term result; + result.intval = 0; + result.objval = list; + return result; + } + return vari.Value; } - private static object logior_set (object[] args, Domain domain) + private static Term Fconcat (Domain domain, Variable vari, Term[] args) { - Variable vari = domain.GetVar ((Name) ((Xex.Const) args[0]).val); - int n = (int) vari.val; + string str; - for (int i = 1; i < args.Length; i++) - n |= (int) args[i]; - vari.val = n; - return n; + if (vari == null) + str = ""; + else + str = vari.Value.Strval; + + foreach (Term arg in args) + { + if (arg.IsStr) + str += (string) arg.objval; + else if (arg.IsList) + foreach (Term term in (List) arg.objval) + str += (char) term.Intval; + else + str += (char) arg.Intval; + } + + if (vari == null) + { + Term term; + term.intval = 0; + term.objval = str; + return term; + } + return vari.SetValue (str); } - private static object logand_set (object[] args, Domain domain) + private static Term Fnth (Domain domain, Variable vari, Term[] args) { - Variable vari = domain.GetVar ((Name) ((Xex.Const) args[0]).val); - int n = (int) vari.val; + Term result; - for (int i = 1; i < args.Length; i++) - n &= (int) args[i]; - vari.val = n; - return n; + if (args[1].IsStr) + { + result.intval = ((string) args[1].objval)[args[0].Intval]; + result.objval = null; + } + else if (args[1].IsList) + { + result = ((List) args[1].objval)[args[0].Intval]; + } + else + throw new Exception ("Term is not enumelable: " + args[1]); + return result; } - private static object lsh (object[] args, Domain domain) + private static Term Fcopy (Domain domain, Variable vari, Term[] args) { - return (int) args[0] << (int) args[1]; + Term result; + + result.intval = 0; + result.objval = new List (args[0].Listval); + return result; } - private static object lsh_set (object[] args, Domain domain) + private static Term Fins (Domain domain, Variable vari, Term[] args) { - Variable vari = domain.GetVar ((Name) ((Xex.Const) args[0]).val); - int n = (int) vari.val; + Term term = vari.Value; + + if (term.IsStr) + { + string str = term.Strval.Insert (args[0].Intval, args[1].Strval); + vari.SetValue (str); + } + else if (vari.Value.IsList) + vari.Value.Listval.InsertRange (args[0].Intval, args[1].Listval); + else + throw new Exception ("term is not collection: " + vari.Value); + return vari.Value; + } - n <<= (int) args[1]; - vari.val = n; - return n; + private static Term Fdel (Domain domain, Variable vari, Term[] args) + { + if (vari.Value.IsStr) + { + string str + = vari.Value.Strval.Remove (args[0].Intval, + args[1].Intval - args[0].Intval); + vari.SetValue (str); + } + else if (vari.Value.IsList) + vari.Value.Listval.RemoveRange (args[0].Intval, + args[1].Intval - args[0].Intval); + else + throw new Exception ("term is not collection: " + vari.Value); + return vari.Value; } - private static object rsh (object[] args, Domain domain) + private static Term Fand (Domain domain, Variable vari, Term[] args) { - return (int) args[0] >> (int) args[1]; + foreach (Term arg in args) + if (! arg.Eval (domain).IsTrue) + return Zero; + return One; } - private static object rsh_set (object[] args, Domain domain) + private static Term For (Domain domain, Variable vari, Term[] args) { - Variable vari = domain.GetVar ((Name) ((Xex.Const) args[0]).val); - int n = (int) vari.val; + foreach (Term arg in args) + if (arg.Eval (domain).IsTrue) + return One; + return Zero; + } - n >>= (int) args[1]; - vari.val = n; - return n; + private static Term Feval (Domain domain, Variable vari, Term[] args) + { + return (args[0].Eval (domain)); } - private static object eq (object[] args, Domain domain) + private static Term Fprogn (Domain domain, Variable vari, Term[] args) { - object o = args[0]; + Term result = One; - for (int i = 1; i < args.Length; i++) - if (o != args[i]) - return false; - return true; + foreach (Term arg in args) + result = arg.Eval (domain); + return result; } - private static object noteq (object[] args, Domain domain) + private static Term Fif (Domain domain, Variable vari, Term[] args) { - return (args[0] != args[1]); + if (args[0].Eval (domain).IsTrue) + return args[1].Eval (domain); + if (args.Length == 2) + return Zero; + return args[2].Eval (domain); } - private static object less_than (object[] args, Domain domain) + private static Term Fwhen (Domain domain, Variable vari, Term[] args) { - int n = (int) args[0]; - + if (! args[0].Eval (domain).IsTrue) + return Zero; + Term result = One; for (int i = 1; i < args.Length; i++) - { - int n1 = (int) args[i]; - if (n >= n1) - return false; - n = n1; - } - return true; + result = args[i].Eval (domain); + return result; } - private static object less_eq (object[] args, Domain domain) + private static Term Freturn (Domain domain, Variable vari, Term[] args) { - int n = (int) args[0]; - for (int i = 1; i < args.Length; i++) - { - int n1 = (int) args[i]; - if (n > n1) - return false; - n = n1; - } - return true; + domain.ThrowReturn (); + return args.Length == 0 ? Zero : args[0]; + } + + private static Term Fbreak (Domain domain, Variable vari, Term[] args) + { + if (! domain.ThrowBreak ()) + return domain.ThrowError (new Term (Error.NoOuterLoop, null)); + 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 object greater_than (object[] args, Domain domain) + private static Term Fwhile (Domain domain, Variable vari, Term[] args) { - int n = (int) args[0]; - for (int i = 1; i < args.Length; i++) - { - int n1 = (int) args[i]; - if (n <= n1) - return false; - n = n1; - } - return true; + 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 object greater_eq (object[] args, Domain domain) + private static Term Fcond (Domain domain, Variable vari, Term[] args) { - int n = (int) args[0]; - for (int i = 1; i < args.Length; i++) + foreach (Term arg in args) { - int n1 = (int) args[i]; - if (n < n1) - return false; - n = n1; + List list = arg.Listval; + Term result = list[0].Eval (domain); + + if (result.IsTrue) + { + for (int i = 1; i < list.Count; i++) + { + domain.depth++; + result = list[i].Eval (domain); + domain.depth--; + if (domain.Thrown ()) + return result; + } + return result; + } } - return true; + return Zero; } - private static object eval_clause (object[] args, Domain domain) + private static Term Fforeach (Domain domain, Variable vari, Term[] args) { - return ((Xex) args[0]).Eval (domain); + Term result = args[0].Eval (domain); + if (domain.Thrown ()) + return result; + List list = result.Listval; + Bindings current = domain.bindings; + + 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); + } + } + } finally { + domain.Uncatch (); + } + return result; } - private static object progn_clause (object[] args, Domain domain) + private static Term Fquote (Domain domain, Variable vari, Term[] args) { - object result = true; + return args[0]; + } - foreach (object arg in args) - result = ((Xex) arg).Eval (domain); - return result; + 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].IsSymbol) + return TermSymbol; + if (args[0].IsList) + return TermList; + return TermTerm; } - private static object if_clause (object[] args, Domain domain) + public static Term Fcatch (Domain domain, Variable vari, Term[] args) { - object result; + Term result = Zero; + bool caught; - if (is_true (((Xex) args[0]).Eval (domain))) - result = ((Xex) args[1]).Eval (domain); - else + domain.Catch (new CatchTag (args[0].Symval)); + for (int i = 1; i < args.Length; i++) { - result = false; - for (int i = 2; i < args.Length; i++) - result = ((Xex) args[i]).Eval (domain); + result = args[i].Eval (domain); + if (domain.Thrown (out caught)) + { + domain.Uncatch (); + if (caught) + { + if (vari != null) + vari.Value = result; + return One; + } + return result; + } } - return result; + domain.Uncatch (); + if (vari != null) + vari.Value = result; + return Zero; } - private static object when_clause (object[] args, Domain domain) + public static Term Fthrow (Domain domain, Variable vari, Term[] args) { - if (! is_true (((Xex) args[0]).Eval (domain))) - return false; - - object result = true; - for (int i = 1; i < args.Length; i++) - result = ((Xex) args[i]).Eval (domain); - return result; + if (args[0].IsSymbol) + { + domain.ThrowSymbol (args[0]); + return (args[args.Length - 1]); + } + if (args[0].IsError) + return domain.ThrowError (args[0]); + return domain.ThrowError (new Term (Error.InvalidArgumentType, + args[0].ToString ())); } - private static object while_clause (object[] args, Domain domain) + public abstract class TermValue { - while (is_true (((Xex) args[0]).Eval (domain))) - for (int i = 1; i < args.Length; i++) - ((Xex) args[i]).Eval (domain); - return false; + public virtual Term Eval (Domain domain) { return new Term (this); } + public virtual TermValue Clone () { return this; } + public virtual bool IsTrue { get { return true; } } + public virtual bool Matches (TermValue other) { return Equals (other); } + public override abstract bool Equals (object obj); + public override abstract int GetHashCode (); + public abstract string ToString (bool detail); } - public abstract object Eval (Domain domain); - public abstract Name TypeOf { get; } + private class Varref : TermValue + { + private static Symbol name = "varref"; + public static Symbol Name { get { return name; } } + + private Symbol vname; + private Variable vari; + + public Varref (Symbol vname) { this.vname = vname; } + + public override Term Eval (Domain domain) + { + if (vari == null || vari.domain != domain) + vari = domain.GetVar (vname, true); + return vari.Value; + } + + public static TermValue Parser (Domain domain, XmlNode node) + { + return new Varref ((Symbol) node.Attributes[Qvname].Value); + } + + public override bool Equals (object obj) + { + Varref varref = obj as Varref; + return (varref != null && varref.vari.name == vari.name); + } + + public override int GetHashCode () + { + return vari.name.GetHashCode (); + } + + public override string ToString () { return ToString (true); } - private class Funcall : Xex + public override string ToString (bool detail) + { + return ""; + } + } + + private class Funcall : TermValue { + private static Symbol name = "funcall"; + public static Symbol Name { get { return name; } } + internal Function func; - internal Xex[] args; - internal object[] real_args; + internal Variable vari; + internal Term[] args; - public Funcall (Function func, Xex[] args) + public Funcall (Function func, Variable vari, Term[] args) { + int nargs = args.Length; + + if (nargs < func.min_arg + || (func.max_arg >= 0 && nargs > func.max_arg)) + throw_exception ("Invalid number of arguments to {0}: ", + func.name, nargs); + if (! func.setvar && vari != null) + throw_exception ("vname attribute not acceptable: ", func.name); this.func = func; + this.vari = vari; this.args = args; - real_args = new object[args.Length]; } - public override object Eval (Domain domain) + public static TermValue Parser (Domain domain, XmlNode node) { - domain.DebugWrite (true, "(({0}", func); - for (int i = 0; i < args.Length; i++) - { - domain.DebugWrite (false, " {0}", args[i]); - real_args[i] = args[i]; - } - domain.DebugWrite (false, ")"); - domain.depth += 2; - object result = func.Call (real_args, domain); - domain.depth -= 2; - domain.DebugWrite (true, " => {0})", result); + Symbol fname = node.Name; + XmlAttribute attr; + + if (fname == Qfuncall) + fname = node.Attributes[Qfname].Value; + Function func = domain.GetFunc (fname); + Variable vari; + attr = node.Attributes[Qvname]; + vari = attr == null ? null : domain.GetVar (attr.Value, true); + 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 (func, vari, args); + } + + public override Term Eval (Domain domain) + { + domain.TraceWrite (ToString ()); + domain.depth++; + Term result = func.Call (domain, vari, args); + domain.depth--; + domain.TraceWrite ("=> {0}", result.ToString ()); return result; } - public override Name TypeOf { get { return Nfuncall; } } + public override TermValue Clone () + { + return new Funcall (func, vari, args); + } - public override string ToString () + public override bool Equals (object obj) + { + Funcall funcall = obj as Funcall; + return (obj != null + && funcall.func == func + && funcall.vari == vari + && funcall.args.Length == args.Length); + } + + public override int GetHashCode () { - string str = "(" + func.name; - if (args != null) - foreach (Xex e in args) - str += " " + e.ToString (); - return (str + ")"); + return func.GetHashCode () ^ args.Length; + } + + public override string ToString () { return ToString (true); } + + public override string ToString (bool detail) + { + string str = "<" + func.name; + if (vari != null) + str += " vname=\"" + vari.name + "\""; + if (args.Length == 0 || ! detail) + return str + "/>"; + str += ">"; + if (func is Function.SpecialForm) + { + for (int i = 0; i < args.Length; i++) + str += "."; + } + else + foreach (Term e in args) + str += e; + return (str + ""); } } - private class Varref : Xex + internal class ErrorTerm : TermValue { - internal Variable vari; + private static Symbol name = "error"; + public static Symbol Name { get { return name; } } + + private readonly Symbol ename; + private string message; + private Term[] stack; + + public ErrorTerm (Symbol ename, string message) + { + this.ename = ename; + this.message = message; + } - public Varref (Variable vari) { this.vari = vari; } + public static TermValue Parser (Domain domain, XmlNode node) + { + XmlAttribute attr = node.Attributes[Qename]; + Symbol ename = attr == null ? Qnull : (Symbol) attr.Value; + string message = node.InnerText; + return new ErrorTerm (ename, message); + } - public override object Eval (Domain domain) + public Term[] CallStack { get { return stack; } set { stack = value; } } + + public override TermValue Clone () { - domain.DebugWrite (true, "(get-value {0})", vari); - return vari.val; + return new ErrorTerm (ename, message); } - public override Name TypeOf { get { return Nvariable; } } + public override bool Equals (object obj) + { + ErrorTerm e = obj as ErrorTerm; + if (e == null || e.ename != ename || e.message != message + || (e.stack == null ? stack != null + : (stack == null || e.stack.Length != stack.Length))) + return false; + if (stack != null) + for (int i = 0; i < stack.Length; i++) + if (! stack[i].Equals (e.stack[i])) + return false; + return true; + } - public override string ToString () + public override int GetHashCode () { - return "$" + vari.name + "/" + vari.val; + return ename.GetHashCode (); } + + public override bool Matches (TermValue term) + { + ErrorTerm e = term as ErrorTerm; + return (e != null && (ename == Qnull || e.ename == ename)); + } + + public override string ToString () { return ToString (true); } + + public override string ToString (bool detail) + { + string str = ""; + if (message != null) + str += message; + if (stack != null) + for (int i = 0; i < stack.Length; i++) + str += stack[i].ToString (false); + return str + ""; + } } - private class Const : Xex + public struct Term { - public object val; + public int intval; + public object objval; + + // ... + public Term (int i) { intval = i; objval = null; } + // ... + public Term (Symbol name) { intval = 0; objval = name; } + // ... + public Term (string str) { intval = 0; objval = str; } + // ... + public Term (List list) { intval = 0; objval = list; } + // ERROR-MESSASGE + public Term (Symbol name, string message) + { + intval = 0; + objval = new ErrorTerm (name, message); + } + + public Term (TermValue obj) { intval = 0; objval = obj; } - public Const (object val) { this.val = val; } + public Term (Domain domain, XmlNode node) + { + Symbol name = node.Name; - public override object Eval (Domain domain) + if (name == Qinteger) + { + intval = parse_integer (node.InnerText); + objval = null; + } + else + { + intval = 0; + if (name == Qsymbol) + objval = (Symbol) node.InnerText; + else if (name == Qstring) + objval = node.InnerText.Clone (); + else if (name == Qlist) + { + List list = new List (); + for (node = node.FirstChild; node != null; + node = node.NextSibling) + list.Add (new Term (domain, node)); + objval = list; + } + else + { + MethodInfo minfo; + + if (domain.termtypes.TryGetValue (name, out minfo)) + objval = (TermValue) minfo.Invoke (null, new Object[] { domain, node}); + else + { + Funcall funcall = (Funcall) Funcall.Parser (domain, node); + if (funcall.func is Function.Macro) + { + Term result = funcall.Eval (domain); + intval = result.intval; + objval = result.objval; + } + else + objval = funcall; + } + } + } + } + + // + public Term (Domain domain, Symbol vname) + { + intval = 0; + objval = new Varref (vname); + } + + // ... + public Term (Domain domain, Symbol fname, Term[] args) + : this (domain, fname, Qnull, args) { } + + // ... + public Term (Domain domain, Symbol fname, Symbol vname, Term[] args) + { + intval = 0; + + Function func = domain.GetFunc (fname); + Variable vari = vname == Qnull ? null : domain.GetVar (vname, true); + Funcall funcall = new Funcall (func, vari, args); + if (func is Function.Macro) + { + Term result = funcall.Eval (domain); + intval = result.intval; + objval = result.objval; + } + else + objval = funcall; + } + + public object Objval { + get { + if (objval == null) + throw new Exception ("term is an integer: " + this); + return objval; + } + } + + public int Intval { + get { + if (objval != null) + throw new Exception ("term is not integer: " + this); + return intval; + } + } + + public string Strval { + get { + if (! IsStr) + throw new Exception ("term is not a string: " + this); + return (string) objval; + } + } + + public string Symval { + get { + if (! IsSymbol) + throw new Exception ("term is not a symbol: " + this); + return (Symbol) objval; + } + } + + public List Listval { + get { + if (! IsList) + throw new Exception ("term is not a list: " + this); + return (List) objval; + } + } + + public bool IsTrue { + get { + return (objval == null + ? (intval != 0) + : objval is List + ? (((List) objval).Count != 0) + : objval is TermValue + ? ((TermValue) objval).IsTrue + : true); + } + } + + public bool IsInt { get { return (objval == null); } } + public bool IsStr { get { return (objval is string); } } + public bool IsSymbol { get { return (objval is Symbol); } } + public bool IsList { get { return (objval is List); } } + public bool IsError { get { return (objval is ErrorTerm); } } + + public Term Eval (Domain domain) { - domain.DebugWrite (true, "(const {0})\n", val); - return val; + try { + domain.PushTerm (this); + if (objval == null || objval is Symbol || objval is string + || objval is List) + return this; + return ((TermValue) objval).Eval (domain); + } finally { + domain.PopTerm (); + } + } + + public Term Clone () + { + 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 Name TypeOf { - get + public static bool operator== (Term t1, Term t2) + { + return t1.Equals (t2); + } + + public static bool operator!= (Term t1, Term t2) { return ! (t1 == t2); } + + public override bool Equals (object obj) + { + if (! (obj is Term)) + return false; + Term term = (Term) obj; + if (IsInt) + return term.IsInt && term.Intval == Intval; + if (IsStr) + return term.IsStr && term.Strval == Strval; + if (IsSymbol) + return term.IsSymbol && term.Symval == Symval; + if (IsList) { - return (val is int ? Ninteger - : val is string ? Nstring - : val is bool ? Nboolean - : val is Name ? Nsymbol - : Nlist); + if (! term.IsList) + return false; + List l1 = objval as List; + List l2 = term.objval as List; + + if (l1.Count != l2.Count) + return false; + for (int i = 0; i < l1.Count; i++) + if (! l1[i].Equals (l2[i])) + return false; + return true; } + return ((TermValue) objval).Equals (obj); + } + + public override int GetHashCode () { return intval; } + + public bool Matches (Term term) + { + if (IsInt) + return term.IsInt && term.Intval == Intval; + if (IsStr) + return term.IsStr && term.Strval == Strval; + if (IsSymbol) + return term.IsSymbol && term.Symval == Symval; + if (IsList) + return (((List) objval).Count > 0 + && ((List) objval)[0].Matches (term)); + return ((TermValue) objval).Matches ((TermValue) term.objval); } - public override string ToString () { return val.ToString (); } + public override string ToString () { return ToString (true); } + + public string ToString (bool detail) + { + string str; + + if (objval == null) + str = "" + intval + ""; + else if (objval is Symbol) + str = "" + objval + ""; + else if (objval is string) + str = "" + objval + ""; + else if (objval is List) + { + if (detail) + { + str = ""; + foreach (Term e in (List) objval) + str += e; + str += ""; + } + else + str = ""; + } + else if (objval is Term) + str = "" + objval + ""; + else if (objval is TermValue) + str = ((TermValue) objval).ToString (detail); + else + throw new Exception ("invalid Term object: " + objval); + return str; + } } + static private Term Zero = new Term (0); + static private Term One = new Term (1); + 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) { int len = str.Length; @@ -1116,7 +2240,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++) @@ -1152,98 +2278,100 @@ namespace System.Xml.Expression return negative ? - i : i; } - private static int pre_parse (XmlNodeList nlist, Domain domain) + private Term[] terms; + + public static Term[] ParseTerms (Domain domain, XmlNode node) { - int len = 0; - foreach (XmlNode node in nlist) - { - if (node.Name == Ndefun) - domain.RegisterFunction (node); - else if (node.Name == Ndefvar) - domain.Defvar ((Name) node.Attributes[0].Value, node.FirstChild); - else - len++; - } - return len; + int nterms = 0; + for (XmlNode n = node; n != null; n = n.NextSibling) + if (n.NodeType == XmlNodeType.Element) + { + if (n.Name == Qdefun) + domain.Defun (n, true); + else if (n.Name == Qdefmacro) + domain.Defmacro (n, true); + else if (n.Name == Qdefvar) + domain.Defvar (n); + else + 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 == Qdefun) + domain.Defun (n, false); + else if (n.Name == Qdefmacro) + domain.Defmacro (n, false); + else if (n.Name != Qdefvar) + terms[i++]= new Term (domain, n); + } + return terms; } - private static void post_parse (XmlNodeList nlist, Xex[] args, - Domain domain) + public static Term Eval (Domain domain, Term[] terms) { - for (int i = 0, j = 0; i < nlist.Count; i++) + Term result = new Term (0); + foreach (Term term in terms) { - XmlNode node = nlist[i]; - - if (node.Name == Ndefun) - domain.Defun (node); - else if (node.Name != Ndefvar) - args[j++] = New (node, domain); + result = term; + if (result.Objval is Funcall) + while ((result = result.Eval (domain)).Objval is Funcall); } + return result; } - public static Xex New (string url, Domain domain) + + public Xexpression (Domain domain, XmlNode node) { - XmlDocument doc = new XmlDocument (Name.Table); + terms = ParseTerms (domain, node); + } + + public Xexpression (Domain domain, string url) + { + XmlDocument doc = new XmlDocument (Symbol.NameTable); XmlNode node; - using (XmlTextReader reader = new XmlTextReader (url, Name.Table)) + using (XmlTextReader reader = new XmlTextReader (url, doc.NameTable)) { do { reader.Read (); } while (reader.NodeType != XmlNodeType.None && (reader.NodeType != XmlNodeType.Element - || Nexpr != reader.Name)); + || reader.Name != Qexpr)); if (reader.NodeType == XmlNodeType.None) throw new Exception ("Node not found"); node = doc.ReadNode (reader); } - - return New (node, domain); + terms = ParseTerms (domain, node.FirstChild); } - public static Xex New (XmlNode node, Domain domain) + public Term Eval (Domain domain) { - Name name = node.Name; - Xex xex; - if (name == Nvariable) - { - Variable vari = domain.GetVar ((Name) node.Attributes[0].Value); - xex = new Xex.Varref (vari); - } - else if (name == Ninteger) - xex = new Xex.Const (parse_integer (node.InnerText)); - else if (name == Nstring) - xex = new Xex.Const (node.InnerText); - else if (name == Nsymbol) - xex = new Xex.Const ((Name) node.InnerText); - else if (name == Nboolean) - xex = new Xex.Const (node.InnerText == "true"); - else if (name == Nlist) - { - List list = new List (); - for (XmlNode n = node.FirstChild; n != null; n = n.NextSibling) - list.Add (New (n, domain)); - xex = new Xex.Const (list); - } - else - { - if (name == Nfuncall) - name = node.Attributes[0].Value; - Function func = domain.GetFunc (name); + Term result = Zero; - XmlNodeList nlist = node.ChildNodes; - int nargs = nlist.Count; + domain.depth = 0; + try { + domain.Catch (CatchTag.Return); + foreach (Term term in terms) + { + result = term.Eval (domain); + if (domain.Thrown ()) + return result; + } + } finally { + domain.Uncatch (); + } + return result; + } - if (nargs < func.min_arg - || (func.max_arg >= 0 && nargs > func.max_arg)) - throw new Exception ("Invalid number of arguments to: " - + name + " " + nargs); - nargs = pre_parse (nlist, domain); - Xex[] args = new Xex[nargs]; - post_parse (nlist, args, domain); - xex = new Xex.Funcall (func, args); - } - return xex; + public override string ToString () + { + string str = ""; + for (int i = 0; i < terms.Length; i++) + str += terms[i]; + return str; } } }