{
public abstract class Xex
{
+ public static bool Debug = false;
+
+ public static void DebugWrite (string fmt, params object[] arg)
+ {
+ if (Debug)
+ Console.Write (fmt, arg);
+ }
+
public struct Name : IEquatable<Name>
{
private static NameTable nt = new NameTable ();
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";
internal abstract class Function
{
- public readonly Name name;
+ public Name name;
public int min_arg, max_arg;
+ public Function () { }
+
public Function (Name name, int min_arg, int max_arg)
{
this.name = name;
this.max_arg = max_arg;
}
- public abstract object Call (Xex[] args, Domain domain);
+ public abstract object Call (object[] args, Domain domain);
public override string ToString ()
{
this.builtin = builtin;
}
- public override object Call (Xex[] args, Domain domain)
+ public override object Call (object[] args, Domain domain)
{
object result;
- foreach (Xex a in args)
- if (a.Eval (domain) == null)
- throw new Exception (a + ":evaled to null");
- Console.Write ("calling (" + this);
- foreach (Xex a in args)
- Console.Write (" " + a);
- Console.Write (") => ");
+ for (int i = 0; i < args.Length; i++)
+ {
+ object val = ((Xex) args[i]).Eval (domain);
+ if (val == null)
+ throw new Exception (args[i] + ":evaled to null");
+ args[i] = val;
+ }
+ DebugWrite ("calling (" + this);
+ foreach (object a in args)
+ DebugWrite (" " + a);
+ DebugWrite (") => ");
result = builtin (args, domain);
- Console.WriteLine (result);
+ DebugWrite (result + "\n");
return result;
}
}
this.builtin = builtin;
}
- public override object Call (Xex[] args, Domain domain)
+ public override object Call (object[] args, Domain domain)
{
object result;
- Console.Write ("calling (" + this);
- foreach (Xex a in args)
- Console.Write (" " + a);
- Console.Write (") => ");
+ DebugWrite ("calling (" + this);
+ foreach (object a in args)
+ DebugWrite (" " + a);
+ DebugWrite (") => ");
result = builtin (args, domain);
- Console.WriteLine (result);
+ DebugWrite (result + "\n");
return result;
}
}
internal class Lambda : Function
{
- internal bool args_evaled = true;
+ internal bool args_evalled;
internal Name[] args;
internal Xex[] body;
public Lambda (XmlNode node)
{
- Name name = node.Attributes[Nfname].Value;
int nargs = 0, noptions = 0, nrest = 0;
- XmlNode n;
+ name = node.Attributes[Nfname].Value;
node = node.FirstChild;
- if (node != null && node.Name == Nargs)
+ if (node != null
+ && (node.Name == Nargs || node.Name == Nargs_unevalled))
{
- for (XmlNode n = node.FirstChild; n != null; n = n.NextSibling)
+ XmlNode n;
+ args_evalled = node.Name == Nargs;
+ for (n = node.FirstChild; n != null; n = n.NextSibling)
{
- if (n.Name == Noptional || n.Name == Nrest)
+ if (n.Name != Nsymbol)
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 && 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;
-
-
- args = new Xex[nargs];
- node = node.FirstChild;
- for (int i = 0; i < nargs; node = node.NextSibling)
- if (node.Name != Noptional && node.Name != Nrest)
- args[i++] = New (node, domain);
+ {
+ 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;
+ }
}
public void SetBody (XmlNode node, Domain domain)
{
- XmlNodeList nlist = node.ChildNodes;
-
- body = new Xex[nlist.Count];
- for (int i = 0; i < nlist.Count; i++)
- body[i] = New (nlist[i], domain);
- }
- public void Setup (XmlNode node, Domain domain)
- {
- node = node.FirstChild;
- if (node.Name == Nargs)
+ for (node = node.FirstChild; node != null && node.Name != Nbody;
+ node = node.NextSibling);
+ if (node != null)
{
- SetArgs (node, max_arg, domain);
- node = node.NextSibling;
+ XmlNodeList nlist = node.ChildNodes;
+
+ body = new Xex[nlist.Count];
+ for (int i = 0; i < nlist.Count; i++)
+ body[i] = New (nlist[i], domain);
}
- if (node.Name == Nbody)
- SetBody (node, domain);
}
- public override object Call (Xex[] args, Domain domain)
+ public override object Call (object[] args, Domain domain)
{
Bindings current = domain.bindings;
object result = false;
try {
int i;
+ if (args_evalled)
+ for (i = 0; i < min_arg; i++)
+ args[i] = ((Xex) args[i]).Eval (domain);
for (i = 0; i < min_arg; i++)
{
- Xex a = this.args[i];
- bool isdirect = a is Xex.Const;
- Name name = (isdirect
- ? (Name) a.val : ((Xex.Varref) a).vari.name);
- Variable var = domain.GetVar (name);
-
- if (isdirect)
- domain.Bind (var, args[i]);
- else
- domain.Bind (var, args[i].Eval (domain));
+ Variable var = domain.GetVar (this.args[i]);
+ domain.Bind (var, args[i]);
}
- Console.Write ("calling (" + this);
+ DebugWrite ("calling (" + this);
foreach (Xex e in body)
result = e.Eval (domain);
- Console.WriteLine (result);
+ DebugWrite (") => " + result + "\n");
} finally {
domain.UnboundTo (current);
}
public override string ToString ()
{
string str = "(" + name;
- foreach (Xex a in args)
+ foreach (Name a in args)
str += " " + a;
return (str + ")");
}
set
{
if (! ValueP (value))
- throw new Exception ("Invalid value type: " + value);
+ throw new Exception ("Invalid value of " + name + ": " + value);
val = value;
}
}
private object old_value;
private Bindings next;
- private Bindings (Variable vari, object value)
+ private Bindings (Variable vari)
{
this.vari = vari;
- old_value = value;
+ old_value = vari.val;
}
public static Bindings Bind (Bindings bindings,
Variable vari, object value)
{
- Bindings b = new Bindings (vari, vari.val);
+ Bindings b = new Bindings (vari);
b.vari.Value = value;
b.next = bindings;
{
string str = "(bindings";
for (Bindings b = this; b != null; b = b.next)
- str += " " + vari;
+ str += " " + vari.name + "=" + b.old_value;
return str + ")";
}
}
internal void Bind (Variable vari, object value)
{
bindings = Bindings.Bind (bindings, vari, value);
- Console.WriteLine ("binding " + vari);
+ DebugWrite ("binding " + vari);
}
internal void UnboundTo (Bindings boundary)
= new Function.SpecialForm (builtin, name, min_arg, max_arg);
}
- private static Name ParseHead (XmlNode node, out bool evaled,
- out int min_arg, out int max_arg)
- {
- Name name = node.Attributes[Nfname].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 != null && n.Name == Noptional)
- for (n = n.NextSibling; n != null; n = n.NextSibling)
- {
- if (n.Name == Nrest)
- break;
- noptions++;
- }
- if (n != null && 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;
- }
-
internal Function.Lambda RegisterFunction (XmlNode node)
{
- bool evaled;
- int min_arg, max_arg;
- Name name = ParseHead (node, out evaled, out min_arg, out max_arg);
- Function.Lambda lambda = new Function.Lambda (name, min_arg, max_arg);
+ Function.Lambda lambda = new Function.Lambda (node);
- functions[name] = lambda;
+ functions[lambda.name] = lambda;
return lambda;
}
if (! functions.TryGetValue (name, out func))
func = RegisterFunction (node);
- ((Function.Lambda) func).Setup (node, this);
+ ((Function.Lambda) func).SetBody (node, this);
return func;
}
Name type = node.Name;
XmlNodeList range_list = null;
int nranges = 0;
+ string val = node.InnerText;
node = node.NextSibling;
if (node != null)
if (n.Name == Nrange)
{
vi.ranges[i].from =
- parse_integer (n.FirstChild.Value);
+ parse_integer (n.FirstChild.InnerText);
vi.ranges[i].to =
- parse_integer (n.LastChild.Value);
+ parse_integer (n.LastChild.InnerText);
}
else
{
- int num = parse_integer (n.Value);
+ int num = parse_integer (n.InnerText);
vi.ranges[i].from = vi.ranges[i].to = num;
}
}
return vari;
}
- internal Variable GetVar (Xex e)
- {
- if (! (e.val is Name))
- throw new Exception ("Not a symbol" + e.val);
- return GetVar ((Name) e.val);
- }
-
public override string ToString ()
{
string str = "<(functions";
}
}
- public delegate object Builtin (Xex[] args, Domain domain);
+ public delegate object Builtin (object[] args, Domain domain);
private static Domain basic = new Domain ();
{
basic.DefSubr (set_value, "set", 2, 2);
basic.DefSubr (set_value, "=", 2, 2);
- basic.DefSubr (and, "and", 1, -1);
- basic.DefSubr (and, "&&", 1, -1);
- basic.DefSubr (or, "or", 1, -1);
- basic.DefSubr (or, "||", 1, -1);
+ 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);
: true);
}
- private static object set_value (Xex[] args, Domain domain)
+ private static object set_value (object[] args, Domain domain)
{
- Variable vari = domain.GetVar (args[0]);
+ Variable vari = domain.GetVar ((Name) args[0]);
- vari.Value = args[1].val;
+ vari.Value = args[1];
return vari.val;
}
- private static object and (Xex[] args, Domain domain)
+ private static object and (object[] args, Domain domain)
{
- foreach (Xex arg in args)
- if (! is_true (arg.val))
+ foreach (object arg in args)
+ if (! is_true (((Xex) arg).Eval (domain)))
return false;
return true;
}
- private static object or (Xex[] args, Domain domain)
+ private static object or (object[] args, Domain domain)
{
- foreach (Xex arg in args)
- if (is_true (arg.val))
+ foreach (object arg in args)
+ if (is_true (((Xex) arg).Eval (domain)))
return true;
return false;
}
- private static object not (Xex[] args, Domain domain)
+ private static object not (object[] args, Domain domain)
{
- return ! is_true (args[0].val);
+ return ! is_true (args);
}
- private static object add (Xex[] args, Domain domain)
+ private static object add (object[] args, Domain domain)
{
int n = 0;
- foreach (Xex e in args)
- n += (int) e.val;
+ foreach (object arg in args)
+ n += (int) arg;
return n;
}
- private static object mul (Xex[] args, Domain domain)
+ private static object mul (object[] args, Domain domain)
{
int n = 1;
- foreach (Xex e in args)
- n *= (int) e.val;
+ foreach (object arg in args)
+ n *= (int) arg;
return n;
}
- private static object sub (Xex[] args, Domain domain)
+ private static object sub (object[] args, Domain domain)
{
- int n = (int) args[0].val;
+ int n = (int) args[0];
if (args.Length == 1)
return - n;
for (int i = 1; i < args.Length; i++)
- n -= (int) args[i].val;
+ n -= (int) args[i];
return n;
}
- private static object div (Xex[] args, Domain domain)
+ private static object div (object[] args, Domain domain)
{
- int n = (int) args[0].val;
+ int n = (int) args[0];
for (int i = 1; i < args.Length; i++)
- n /= (int) args[i].val;
+ n /= (int) args[i];
return n;
}
- private static object mod (Xex[] args, Domain domain)
+ private static object mod (object[] args, Domain domain)
{
- return ((int) args[0].val % (int) args[1].val);
+ return ((int) args[0] % (int) args[1]);
}
- private static object logior (Xex[] args, Domain domain)
+ private static object logior (object[] args, Domain domain)
{
int n = 0;
- foreach (Xex e in args)
- n |= (int) e.val;
+ foreach (object arg in args)
+ n |= (int) arg;
return n;
}
- private static object logand (Xex[] args, Domain domain)
+ private static object logand (object[] args, Domain domain)
{
- int n = (int) args[0].val;
+ int n = (int) args[0];
for (int i = 1; i < args.Length; i++)
- n &= (int) args[i].val;
+ n &= (int) args[i];
return n;
}
- private static object add_set (Xex[] args, Domain domain)
+ private static object add_set (object[] args, Domain domain)
{
- Variable vari = domain.GetVar (args[0]);
+ Variable vari = domain.GetVar ((Name) ((Xex.Const) args[0]).val);
int n = (int) vari.val;
for (int i = 1; i < args.Length; i++)
- n += (int) args[i].val;
+ n += (int) args[i];
vari.val = n;
return n;
}
- private static object mul_set (Xex[] args, Domain domain)
+ private static object mul_set (object[] args, Domain domain)
{
- Variable vari = domain.GetVar (args[0]);
+ Variable vari = domain.GetVar ((Name) ((Xex.Const) args[0]).val);
int n = (int) vari.val;
for (int i = 1; i < args.Length; i++)
- n *= (int) args[i].val;
+ n *= (int) args[i];
vari.val = n;
return n;
}
- private static object sub_set (Xex[] args, Domain domain)
+ private static object sub_set (object[] args, Domain domain)
{
- Variable vari = domain.GetVar (args[0]);
+ Variable vari = domain.GetVar ((Name) ((Xex.Const) args[0]).val);
int n = (int) vari.val;
for (int i = 1; i < args.Length; i++)
- n -= (int) args[i].val;
+ n -= (int) args[i];
vari.val = n;
return n;
}
- private static object div_set (Xex[] args, Domain domain)
+ private static object div_set (object[] args, Domain domain)
{
- Variable vari = domain.GetVar (args[0]);
+ Variable vari = domain.GetVar ((Name) ((Xex.Const) args[0]).val);
int n = (int) vari.val;
for (int i = 1; i < args.Length; i++)
- n /= (int) args[i].val;
+ n /= (int) args[i];
vari.val = n;
return n;
}
- private static object mod_set (Xex[] args, Domain domain)
+ private static object mod_set (object[] args, Domain domain)
{
- Variable vari = domain.GetVar (args[0]);
+ Variable vari = domain.GetVar ((Name) ((Xex.Const) args[0]).val);
int n = (int) vari.val;
for (int i = 1; i < args.Length; i++)
- n %= (int) args[i].val;
+ n %= (int) args[i];
vari.val = n;
return n;
}
- private static object logior_set (Xex[] args, Domain domain)
+ private static object logior_set (object[] args, Domain domain)
{
- Variable vari = domain.GetVar (args[0]);
+ Variable vari = domain.GetVar ((Name) ((Xex.Const) args[0]).val);
int n = (int) vari.val;
for (int i = 1; i < args.Length; i++)
- n |= (int) args[i].val;
+ n |= (int) args[i];
vari.val = n;
return n;
}
- private static object logand_set (Xex[] args, Domain domain)
+ private static object logand_set (object[] args, Domain domain)
{
- Variable vari = domain.GetVar (args[0]);
+ Variable vari = domain.GetVar ((Name) ((Xex.Const) args[0]).val);
int n = (int) vari.val;
for (int i = 1; i < args.Length; i++)
- n &= (int) args[i].val;
+ n &= (int) args[i];
vari.val = n;
return n;
}
- private static object lsh (Xex[] args, Domain domain)
+ private static object lsh (object[] args, Domain domain)
{
- return (int) args[0].val << (int) args[1].val;
+ return (int) args[0] << (int) args[1];
}
- private static object lsh_set (Xex[] args, Domain domain)
+ private static object lsh_set (object[] args, Domain domain)
{
- Variable vari = domain.GetVar (args[0]);
+ Variable vari = domain.GetVar ((Name) ((Xex.Const) args[0]).val);
int n = (int) vari.val;
- n <<= (int) args[1].val;
+ n <<= (int) args[1];
vari.val = n;
return n;
}
- private static object rsh (Xex[] args, Domain domain)
+ private static object rsh (object[] args, Domain domain)
{
- return (int) args[0].val >> (int) args[1].val;
+ return (int) args[0] >> (int) args[1];
}
- private static object rsh_set (Xex[] args, Domain domain)
+ private static object rsh_set (object[] args, Domain domain)
{
- Variable vari = domain.GetVar (args[0]);
+ Variable vari = domain.GetVar ((Name) ((Xex.Const) args[0]).val);
int n = (int) vari.val;
- n >>= (int) args[1].val;
+ n >>= (int) args[1];
vari.val = n;
return n;
}
- private static object eq (Xex[] args, Domain domain)
+ private static object eq (object[] args, Domain domain)
{
- int n = (int) args[0].val;
+ object o = args[0];
for (int i = 1; i < args.Length; i++)
- if (n != (int) args[i].val)
+ if (o != args[i])
return false;
return true;
}
- private static object noteq (Xex[] args, Domain domain)
+ private static object noteq (object[] args, Domain domain)
{
- return ((int) args[0].val != (int) args[1].val);
+ return (args[0] != args[1]);
}
- private static object less_than (Xex[] args, Domain domain)
+ private static object less_than (object[] args, Domain domain)
{
- int n = (int) args[0].val;
+ int n = (int) args[0];
for (int i = 1; i < args.Length; i++)
{
- int n1 = (int) args[i].val;
+ int n1 = (int) args[i];
if (n >= n1)
return false;
n = n1;
return true;
}
- private static object less_eq (Xex[] args, Domain domain)
+ private static object less_eq (object[] args, Domain domain)
{
- int n = (int) args[0].val;
+ int n = (int) args[0];
for (int i = 1; i < args.Length; i++)
{
- int n1 = (int) args[i].val;
+ int n1 = (int) args[i];
if (n > n1)
return false;
n = n1;
return true;
}
- private static object greater_than (Xex[] args, Domain domain)
+ private static object greater_than (object[] args, Domain domain)
{
- int n = (int) args[0].val;
+ int n = (int) args[0];
for (int i = 1; i < args.Length; i++)
{
- int n1 = (int) args[i].val;
+ int n1 = (int) args[i];
if (n <= n1)
return false;
n = n1;
return true;
}
- private static object greater_eq (Xex[] args, Domain domain)
+ private static object greater_eq (object[] args, Domain domain)
{
- int n = (int) args[0].val;
+ int n = (int) args[0];
for (int i = 1; i < args.Length; i++)
{
- int n1 = (int) args[i].val;
+ int n1 = (int) args[i];
if (n < n1)
return false;
n = n1;
return true;
}
- private static object eval_clause (Xex[] args, Domain domain)
+ private static object eval_clause (object[] args, Domain domain)
{
- return ((Xex) args[0].val).Eval (domain);
+ return ((Xex) args[0]).Eval (domain);
}
- private static object progn_clause (Xex[] args, Domain domain)
+ private static object progn_clause (object[] args, Domain domain)
{
object result = true;
- foreach (Xex e in args)
- result = e.Eval (domain);
+ foreach (object arg in args)
+ result = ((Xex) arg).Eval (domain);
return result;
}
- private static object if_clause (Xex[] args, Domain domain)
+ private static object if_clause (object[] args, Domain domain)
{
object result;
- if (is_true (args[0].Eval (domain)))
- result = args[1].Eval (domain);
+ if (is_true (((Xex) args[0]).Eval (domain)))
+ result = ((Xex) args[1]).Eval (domain);
else
{
result = false;
for (int i = 2; i < args.Length; i++)
- result = args[i].Eval (domain);
+ result = ((Xex) args[i]).Eval (domain);
}
return result;
}
- private static object when_clause (Xex[] args, Domain domain)
+ private static object when_clause (object[] args, Domain domain)
{
- if (! is_true (args[0].Eval (domain)))
+ if (! is_true (((Xex) args[0]).Eval (domain)))
return false;
object result = true;
for (int i = 1; i < args.Length; i++)
- result = args[i].Eval (domain);
+ result = ((Xex) args[i]).Eval (domain);
return result;
}
- private static object while_clause (Xex[] args, Domain domain)
+ private static object while_clause (object[] args, Domain domain)
{
- while (is_true (args[0].Eval (domain)))
+ while (is_true (((Xex) args[0]).Eval (domain)))
for (int i = 1; i < args.Length; i++)
- args[i].Eval (domain);
+ ((Xex) args[i]).Eval (domain);
return false;
}
- // FUNCALL: function != null
- // VARREF: function == null, args[0] = DIRECT-SYMBOL
- // DIRECT: function == null, args == null
-
- private object val;
public abstract object Eval (Domain domain);
- public object Val { get { return val; } }
+ public abstract Name TypeOf { get; }
private class Funcall : Xex
{
internal Function func;
internal Xex[] args;
+ internal object[] real_args;
public Funcall (Function func, Xex[] args)
{
this.func = func;
this.args = args;
+ real_args = new object[args.Length];
}
public override object Eval (Domain domain)
{
- val = func.Call (args, domain);
- return val;
+ for (int i = 0; i < args.Length; i++)
+ real_args[i] = args[i];
+ return func.Call (real_args, domain);
}
+ public override Name TypeOf { get { return Nfuncall; } }
+
public override string ToString ()
{
string str = "(" + func.name;
{
internal Variable vari;
- public Varref (Variable vari)
- {
- this.vari = vari;
- }
+ public Varref (Variable vari) { this.vari = vari; }
public override object Eval (Domain domain)
{
- val = vari.val;
- return val;
+ return vari.val;
}
+ public override Name TypeOf { get { return Nvariable; } }
+
public override string ToString ()
{
return "$" + vari.name + "/" + vari.val;
private class Const : Xex
{
- public Const (object val)
- {
- this.val = val;
- }
+ public object val;
- public override object Eval (Domain domain)
- {
- return val;
- }
+ public Const (object val) { this.val = val; }
- public override string ToString ()
- {
- return val.ToString ();
+ public override object Eval (Domain domain) { return val; }
+
+ public override Name TypeOf {
+ get
+ {
+ return (val is int ? Ninteger
+ : val is string ? Nstring
+ : val is bool ? Nboolean
+ : val is Name ? Nsymbol
+ : Nlist);
+ }
}
+
+ public override string ToString () { return val.ToString (); }
}
internal static int parse_integer (string str)
return New (node, domain);
}
- // EXPR = SYMBOL | MTEXT | INTEGER | FUNCALL | PROGN
- // FUNCALL = '(' SYMBOL EXPR* ')'
- // PROGN = '(' EXPR * ')'
public static Xex New (XmlNode node, Domain domain)
{
Name name = node.Name;