return (object) n1.name != (object) n2;
}
+ public static bool operator== (string n1, Name n2)
+ {
+ return (object) n1 == (object) n2.name;
+ }
+
+ public static bool operator!= (string n1, Name n2)
+ {
+ return (object) n1 != (object) n2.name;
+ }
+
public bool Equals (Name name)
{
return Object.ReferenceEquals (this.name, name.name);
private static Name Nobject = "object";
private static Name Ndefun = "defun";
- private static Name Ndefmacro = "defmacro";
private static Name Ndefvar = "defvar";
private static Name Nconst = "const";
private static Name Nvariable = "variable";
private static Name Npossible_value = "possible-value";
private static Name Nfuncall = "funcall";
- private static Name Nmname = "mname";
private static Name Nprogn = "progn";
+ private static Name Neval = "eval";
internal class Function
{
internal class Lambda
{
- internal Variable[] args;
+ internal Xex[] args;
internal Xex[] body;
- public Lambda (XmlNode node, Domain domain)
+ public Lambda (XmlNode node, Domain domain) { }
+
+ public void SetArgs (XmlNode node, int nargs, Domain domain)
{
- Set (node, domain);
+ args = new Xex[nargs];
+ for (i = 0, n = node.FirstChild; i < nargs; n = n.NextSibling)
+ if (n.Name != Noptional && n.Name != Nrest)
+ args[i++] = new Xex (n, domain);
}
- public void Set (XmlNode node, Domain domain)
+ public void SetBody (XmlNode node, Domain domain)
{
- XmlNodeList body = node.ChildNodes;
- int idx = 0;
+ XmlNodeList nlist = node.ChildNodes;
- if (Nargs == body[0].Name)
- {
- XmlNodeList args = body[0].ChildNodes;
- if (this.args == null)
- this.args = new Name[args.Count];
- for (int i = 0; i < args.Count; i++)
- this.args[i] = args[i].InnerText;
- idx++;
- }
- else if (this.args == null)
- this.args = new Name[0];
- if (this.body == null)
- this.body = new Xex[body.Count - idx];
- for (int i = 0; idx < body.Count; i++, idx++)
- this.body[i] = new Xex (body[idx], domain);
+ body = new Xex[nlist.Count];
+ for (int i = 0; i < nlist.Count; i++)
+ body[i] = new Xex (nlist[idx], domain);
}
}
this.specialp = specialp;
}
- internal Function (Name name, XmlNode node, Domain domain)
+ public Function (Name name, int min_arg, int max_arg)
{
this.name = name;
- lambda = new Lambda (node, domain);
- this.min_arg = this.max_arg = lambda.args.Length;
+ this.min_arg = min_arg;
+ this.max_arg = max_arg;
}
- internal Function (Name name, int nargs, bool specialp)
+ public void Setup (XmlNode node, Domain domain)
{
- this.name = name;
- this.min_arg = this.max_arg = nargs;
+ lambda = new Lambda ();
+ node = node.FirstChild;
+ if (node.Name == Nargs)
+ {
+ lambda.SetArgs (node, max_arg, domain);
+ node = node.NextSibling;
+ }
+ if (node.Name == Nbody)
+ lambda.SetBody (node, domain);
+ }
+
+ public static Name ParseHead (XmlNode node,
+ out int min_arg, out int max_arg)
+ {
+ Name name = node.Attributes[Ffname].Value;
+ int nargs = 0, noptions = 0, nrest = 0;
+ XmlNode n;
+
+ for (n = node.FirstChild; n != null; n = n.NextSibling)
+ {
+ if (n.Name == Noptional || n.Name == Nrest)
+ break;
+ nargs++;
+ }
+ if (n.Name == Noptional)
+ for (n = n.NextSibling; n != null; n = n.NextSibling)
+ {
+ if (n.Name == Nrest)
+ break;
+ noptions++;
+ }
+ if (n.Name == Nrest)
+ for (n = n.NextSibling; n != null; n = n.NextSibling)
+ nrest++;
+ min_arg = nargs;
+ max_arg = nargs + noptions + nrest;
+ if (nrest == 1)
+ max_arg = - max_arg;
+ return name;
}
public object Call (Xex[] args, Domain domain)
Console.Write ("calling (" + this + "(");
try {
- if (! specialp)
- foreach (Xex e in args)
- e.Eval (domain);
+ foreach (Xex e in args)
+ Console.Write (e);
Console.WriteLine (")");
if (builtin != null)
- return builtin (args, domain);
+ {
+ if (! specialp)
+ foreach (Xex a in args)
+ a.Eval ();
+ return builtin (args, domain);
+ }
if (lambda == null)
return null;
- for (int i = 0; i < args.Length; i++)
- domain.Bind (bindings, lambda.args[i], args[i].val);
+
+ int i;
+ for (i = 0; i < min_arg; i++)
+ {
+ Xex a = lambda.args[i];
+ bool isdirect = a.args == null;
+ Name name = isdirect ? (Name) a.val : (Name) a.args[0].val;
+ Variable var = new VarMisc (name, null);
+
+ if (! isdirect)
+ args[i].Eval ();
+ domain.Bind (bindings, var, args[i]);
+ }
foreach (Xex e in lambda.body)
{
result = e.Eval (domain);
public readonly Name type;
internal object val;
- public Variable (Name name, Name type, object value)
+ public Variable (Name name, Name type, Xex value)
{
+ if (value != null)
+ Value = value;
this.name = name;
this.type = type;
- val = value;
}
public object Value
public Range[] ranges;
- public VarInt (Name name, int value) : base (name, Ninteger, value) { }
+ public VarInt (Name name, object value) : base (name, Ninteger, value) { }
public override bool ValueP (object value)
{
{
public string[] ranges;
- public VarStr (Name name, string value) : base (name, Nstring, value) { }
+ public VarStr (Name name, object value) : base (name, Nstring, value) { }
public override bool ValueP (object value)
{
internal class VarBool : Variable
{
- public VarBool (Name name, bool value) : base (name, Nboolean, value) { }
+ public VarBool (Name name, object value)
+ : base (name, Nboolean, value) { }
- public override bool ValueP (object value)
+ public override bool ValueP (Xex value)
{
- return value is bool;
+ if (! (value is bool))
+ return false;
+ return true;
}
}
public class Domain
{
- private Domain parent;
public object context;
- internal Dictionary<Name, Function> functions
- = new Dictionary<Name, Function> ();
- internal Dictionary<Name, Variable> variables
- = new Dictionary<Name, Variable> ();
+ internal Dictionary<Name, Function> functions;
+ internal Dictionary<Name, Variable> variables;
internal Bindings bindings;
- internal Domain () { }
+ internal Domain ()
+ {
+ functions = new Dictionary<Name, Function> ();
+ variables = new Dictionary<Name, Variable> ();
+ }
public Domain (object context) : this (basic, context)
{
public Domain (Domain parent, object context)
{
- this.parent = parent;
+ functions = new Dictionary<Name, Function> (parent.functions);
+ variables = new Dictionary<Name, Function> (parent.variables);
this.context = context;
}
internal void UnboundTo (Bindings boundary)
{
- if (boundary != null)
- bindings = bindings.UnboundTo (boundary);
+ bindings = bindings.UnboundTo (boundary);
}
public void Defun (Name name, Builtin builtin, int min_arg, int max_arg)
Defun (name, builtin, min_arg, max_arg, false);
}
- public void Defun (Name name, Builtin builtin, int min_arg, int max_arg,
- bool specialp)
+ public void Defun (Name name, Builtin builtin,
+ int min_arg, int max_arg, bool specialp)
{
Function func;
}
}
- public void Defun (XmlNode node)
+ internal Function RegisterFunction (XmlNode node)
{
- Name name = node.Attributes[0].Value;
- Function func;
-
- if (functions.TryGetValue (name, out func))
- {
- XmlNode args = node.FirstChild;
- int nargs = args.Name == Nargs ? args.ChildNodes.Count : 0;
+ int min_arg, max_arg;
+ Name name = Function.ParseHead (node, out min_arg, out max_arg);
+ Function func = new Function (name, min_arg, max_arg);
- if (func.min_arg < nargs || func.max_arg > nargs)
- throw new Exception ("Incompatible argument numbers to override: "
- + name);
- if (func.lambda == null)
- func.lambda = new Function.Lambda (node, this);
- else
- func.lambda.Set (node, this);
- func.builtin = null;
- }
- else
- {
- func = new Function (name, node, this);
- functions[name] = func;
- }
+ functions[name] = func;
+ return func;
}
- public void Defun (Name name, int nargs, bool specialp)
+ internal Function Defun (XmlNode node)
{
Function func;
- if (functions.TryGetValue (name, out func))
- {
- if (func.min_arg < nargs || func.max_arg > nargs)
- throw new Exception ("Incompatible argument numbers to override: "
- + name);
- func.min_arg = func.max_arg = nargs;
- func.specialp = specialp;
- func.builtin = null;
- }
- else
- {
- func = new Function (name, nargs, specialp);
- functions[name] = func;
- }
+ if (! functions.TryGetValue (name, out func))
+ func = RegisterFunction (node);
+ func.Setup (node, this);
}
public void Defvar (Name name, XmlNode node)
foreach (XmlNode node in nlist)
{
if (node.Name == Ndefun)
- {
- XmlNode n = node.FirstChild;
- domain.Defun ((Name) node.Attributes[0].Value,
- n.Name == Nargs ? n.ChildNodes.Count : 0, false);
- }
- else if (node.Name == Ndefmacro)
- {
- XmlNode n = node.FirstChild;
- domain.Defun ((Name) node.Attributes[0].Value,
- n.Name == Nargs ? n.ChildNodes.Count : 0, true);
- }
+ domain.RegisterFunction (node);
else if (node.Name == Ndefvar)
- {
- domain.Defvar ((Name) node.Attributes[0].Value, node.FirstChild);
- }
+ domain.Defvar ((Name) node.Attributes[0].Value, node.FirstChild);
else
len++;
}
if (node.Name == Ndefun)
domain.Defun (node);
- else if (node.Name == Ndefmacro)
- domain.Defun (node);
else if (node.Name != Ndefvar)
args[j++] = new Xex (node, domain);
}
Setup (node, domain);
}
-
// EXPR = SYMBOL | MTEXT | INTEGER | FUNCALL | PROGN
// FUNCALL = '(' SYMBOL EXPR* ')'
// PROGN = '(' EXPR * ')'