- public abstract class Function
- {
- public Symbol name;
- public int min_arg, max_arg;
-
- public Function () { }
-
- public Function (Symbol name, int min_arg, int max_arg)
- {
- this.name = name;
- this.min_arg = min_arg;
- this.max_arg = max_arg;
- }
-
- public abstract Term Call (Domain domain, Variable vari, Term[] args);
-
- public override string ToString ()
- {
- return name;
- }
-
- internal class Subroutine : Function
- {
- public Builtin builtin;
- public 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)
- {
- if (args != null)
- {
- 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);
- }
- }
-
- internal class SpecialForm : Function
- {
- public Builtin builtin;
-
- public SpecialForm (Builtin builtin, Symbol name,
- int min_arg, int max_arg)
- : base (name, min_arg, max_arg)
- {
- this.builtin = builtin;
- }
-
- public override Term Call (Domain domain, Variable vari, Term[] args)
- {
- return builtin (domain, vari, args);
- }
- }
-
- 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++;
- 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;
- args = null;
- }
- }
-
- 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 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);
- }
-
- public void SetBody (Domain domain, XmlNode node)
- {
- parse_body (domain, node, out body);
- }
-
- public override Term Call (Domain domain, Variable vari, Term[] args)
- {
- Bindings current = domain.bindings;
- Term result = Zero;
-
- try {
- for (int i = 0; i < min_arg; i++)
- domain.Bind (this.args[i], args[i]);
- if (body != null)
- {
- try {
- domain.Catch (CatchTag.Return);
- foreach (Term term in body)
- {
- result = term.Eval (domain);
- if (domain.Thrown)
- return result;
- }
- } finally {
- domain.Uncatch ();
- }
- }
- } finally {
- domain.UnboundTo (current);
- }
- return result;
- }
- }
-
- internal class Lambda : Function
- {
- internal Variable[] args;
- internal Term[] body;
-
- public Lambda (Domain domain, XmlNode node)
- {
- parse_head (domain, node, out name, out min_arg, out max_arg,
- out args);
- }
-
- public Lambda (Domain domain, Symbol name, Symbol[] args)
- {
- int nfixed = 0;
- int noptional = 0;
- int nrest = 0;
-
- this.name = name;
- 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)
- {
- parse_body (domain, node, out body);
- }
-
- public void SetBody (Term[] body)
- {
- this.body = body;
- }
-
- public override Term Call (Domain domain, Variable vari, Term[] args)
- {
- Bindings current = domain.bindings;
- Term result = Zero;
-
- try {
- int i;
- if (args != null)
- {
- 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)
- {
- try {
- domain.Catch (CatchTag.Return);
- foreach (Term term in body)
- {
- result = term.Eval (domain);
- if (domain.Thrown)
- return result;
- }
- } finally {
- domain.Uncatch ();
- }
- }
- } finally {
- domain.UnboundTo (current);
- }
- return result;
- }
- }
- }