*** empty log message ***
authorhanda <handa>
Wed, 16 Sep 2009 08:16:56 +0000 (08:16 +0000)
committerhanda <handa>
Wed, 16 Sep 2009 08:16:56 +0000 (08:16 +0000)
XmlExpr.cs
xex.cs
xex.txt
xex.xml

index a3e2b30..7d6cec1 100644 (file)
@@ -8,6 +8,14 @@ namespace System.Xml.Expression
 {
   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 ();
@@ -93,6 +101,7 @@ namespace System.Xml.Expression
     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";
@@ -105,9 +114,11 @@ namespace System.Xml.Expression
 
     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;
@@ -115,7 +126,7 @@ namespace System.Xml.Expression
        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 ()
       {
@@ -133,19 +144,23 @@ namespace System.Xml.Expression
            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;
        }
       }
@@ -161,109 +176,102 @@ namespace System.Xml.Expression
            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);
          }
@@ -273,7 +281,7 @@ namespace System.Xml.Expression
        public override string ToString ()
        {
          string str = "(" + name;
-         foreach (Xex a in args)
+         foreach (Name a in args)
            str += " " + a;
          return (str + ")");
        }
@@ -300,7 +308,7 @@ namespace System.Xml.Expression
        set
          {
            if (! ValueP (value))
-             throw new Exception ("Invalid value type: " + value);
+             throw new Exception ("Invalid value of " + name + ": " + value);
            val = value;
          }
       }
@@ -388,16 +396,16 @@ namespace System.Xml.Expression
       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;
@@ -415,7 +423,7 @@ namespace System.Xml.Expression
       {
        string str = "(bindings";
        for (Bindings b = this; b != null; b = b.next)
-         str += " " + vari;
+         str += " " + vari.name + "=" + b.old_value;
        return str + ")";
       }
     }
@@ -462,7 +470,7 @@ namespace System.Xml.Expression
       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)
@@ -487,44 +495,11 @@ namespace System.Xml.Expression
          = 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;
       }
 
@@ -535,7 +510,7 @@ namespace System.Xml.Expression
 
        if (! functions.TryGetValue (name, out func))
          func = RegisterFunction (node);
-       ((Function.Lambda) func).Setup (node, this);
+       ((Function.Lambda) func).SetBody (node, this);
        return func;
       }
 
@@ -550,6 +525,7 @@ namespace System.Xml.Expression
            Name type = node.Name;
            XmlNodeList range_list = null;
            int nranges = 0;
+           string val = node.InnerText;
 
            node = node.NextSibling;
            if (node != null)
@@ -572,13 +548,13 @@ namespace System.Xml.Expression
                        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;
                          }
                      }
@@ -638,13 +614,6 @@ namespace System.Xml.Expression
        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";
@@ -663,7 +632,7 @@ namespace System.Xml.Expression
       }
     }
 
-    public delegate object Builtin (Xex[] args, Domain domain);
+    public delegate object Builtin (object[] args, Domain domain);
 
     private static Domain basic = new Domain ();
 
@@ -673,10 +642,10 @@ namespace System.Xml.Expression
     {
       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);
@@ -744,219 +713,219 @@ namespace System.Xml.Expression
              : 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;
@@ -964,12 +933,12 @@ namespace System.Xml.Expression
       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;
@@ -977,12 +946,12 @@ namespace System.Xml.Expression
       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;
@@ -990,12 +959,12 @@ namespace System.Xml.Expression
       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;
@@ -1003,79 +972,79 @@ namespace System.Xml.Expression
       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;
@@ -1090,17 +1059,15 @@ namespace System.Xml.Expression
     {
       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;
@@ -1109,20 +1076,24 @@ namespace System.Xml.Expression
 
     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)
@@ -1221,9 +1192,6 @@ namespace System.Xml.Expression
       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;
diff --git a/xex.cs b/xex.cs
index 084b43a..30b0c8a 100644 (file)
--- a/xex.cs
+++ b/xex.cs
@@ -11,7 +11,7 @@ public class Test
     Xex.Domain domain = new Xex.Domain (null);
     Xex xex = Xex.New ("xex.xml", domain);
 
-    Console.WriteLine (xex);
+    Xex.Debug = true;
     Console.WriteLine (xex.Eval (domain));
   }
 }
diff --git a/xex.txt b/xex.txt
index 8926360..575304f 100644 (file)
--- a/xex.txt
+++ b/xex.txt
@@ -8,12 +8,12 @@ TYPE = 'integer' | 'string' | 'boolean' | 'symbol' | 'list'
 DEFUN =
   '<defun fname="' FUNCNAME ? ">'
   ARGS ?
-  TERM *
+  BODY ?
   '</defun>'
 
 ARGS =
   '<args>' SYMBOL * OPTIONAL ? REST ? '</args>'
-  | '<unevaled-args>' SYMBOL * OPTIONAL ? REST ? '</args>'
+  | '<args-unevalled>' SYMBOL * OPTIONAL ? REST ? '</args-unevalled>'
 
 OPTIONAL =
   '<optional/>' SYMBOL *
@@ -21,6 +21,9 @@ OPTIONAL =
 REST =
   '<rest/>' SYMBOL
 
+BODY =
+  '<body>' TERM * '</body>'
+
 DEFVAR = DEFVAR-INT DEFVAR-STR DEFVAR-BOOL
 
 DEFVAR-INT =
@@ -60,12 +63,16 @@ BOOL =
 SYMBOL =
   '<symbol>' NAME '</symbol>'
 LIST =
-  '<list>' DIRECT * '</list>' | <list/>
+  '<list>' TERM * '</list>' | <list/>
+TYPE =
+  '<type>' 
+  [ 'integer' | 'string' | 'boolean' | 'symbol' | 'list'
+    | 'variable' | 'funcall' ]
+  '</type>'
 
 FUNCALL =
   '<funcall fname="' PREDEFINED-FUNC-NAME '">' TERM * '</funcall>'
   | '<' PREDEFINED-FUNC-SYMBOL '>' TERM * '</' PREDEFINED-FUNC-SYMBOL '>'
-  | '<' PREDEFINED-MACRO-SYMBOL '>' TERM * '</' PREDEFINED-MACRO-SYMBOL '>'
 
 PREDEFINED-FUNC-SYMBOL =
   'set'
@@ -77,7 +84,11 @@ PREDEFINED-FUNC-SYMBOL =
   | 'logand' | 'logior' | 'logxor' | 'lsh'
   | 'logand-set' | 'logior-set' | 'logxor-set' | 'lsh-set'
   | 'append' | 'concat' | 'substr'
-  | 'cons' | 'car' | 'cdr' | 'nth'
+  | 'tolist' | 'tostring'
+  | 'cons' | 'car' | 'cdr' | 'nth' | 'copy' | 'ins' | 'del'
+  | 'case' | 'cond' | 'if' | 'progn' | 'when'
+  | 'while' | 'for' | 'foreach'
+  | 'typeof'
 
 PREDEFINED-FUNC-NAME =
   PREDEFINED-FUNC-SYMBOL
@@ -89,7 +100,24 @@ PREDEFINED-FUNC-NAME =
   | '+=' | '-=' | '*=' | '/=' | '%='
   | '&=' | '|=' | '~=' | '<<=' | '>>='
 
-PREDEFINED-MACRO-SYMBOL =
-  'case' | 'cond' | 'if' | 'progn' | 'when' | 'while'
+(set SYMBOL TERM)
+(and TERM *) (or TERM *) (not TERM)
+
+ARITH =
+  'add' | 'sub' | 'mul' | 'div' | 'mod' | 'add' | 'sub' | 'mul' | 'div' | 'mod'
+  | 'logand' | 'logior' | 'logxor' | 'lsh'
+  
+ARITH-SET =
+  'add-set' | 'sub-set' | 'mul-set' | 'div-set' | 'mod-set'
+  | 'logand-set' | 'logior-set' | 'logxor-set' | 'lsh-set'
+
+ARITH-ARG = [ INT | VAR | FUNCALL ]
 
-PREDEFINED-MACRO-NAME = PREDEFINED-MACRO-SYMBOL
+(lt ARITH-ARG *) (le ARITH-ARG *) (eq ARITH-ARG *)
+  (ge ARITH-ARG *) (gt ARITH-ARG *)
+(add ARITH-ARG *) (sub ARITH-ARG *) (mul ARITH-ARG *) (div ARITH-ARG *)
+  (mod ARITH-ARG *)
+(add-set SYMBOL ARITH-ARG *) (sub-set SYMBOL ARITH-ARG *)
+  (mul-set SYMBOL ARITH-ARG *) (div-set SYMBOL ARITH-ARG *)
+  (mod-set SYMBOL ARITH-ARG *)
+(logand ARITH-ARG
diff --git a/xex.xml b/xex.xml
index eac6b92..2a32d58 100644 (file)
--- a/xex.xml
+++ b/xex.xml
@@ -1,24 +1,20 @@
 <?xml version='1.0'?>
 <expr>
-  <defun fname="temp">
-    <args>
-      <symbol>xx</symbol><variable vname="y"/>
-    </args>
+  <defun fname="factorial">
+    <args><symbol>x</symbol></args>
     <body>
-      <add><eval><variable vname="xx"/></eval><variable vname="y"/></add>
+      <if><lt><variable vname="x"/><integer>2</integer></lt>
+       <variable vname="x"/>
+       <mul>
+         <funcall fname="factorial">
+           <sub><variable vname="x"/><integer>1</integer></sub>
+         </funcall>
+         <variable vname="x"/>
+       </mul>
+      </if>
     </body>
   </defun>
 
-  <defvar vname="x">
-    <integer>10</integer>
-    <possible-value>
-      <integer>10</integer>
-      <range><integer>1</integer><integer>4</integer></range>
-    </possible-value>
-  </defvar>
-
-  <temp>
-    <variable vname="x"/>
-    <integer>1</integer>
-  </temp>
+  <set><symbol>x</symbol><integer>10</integer></set>
+  <funcall fname="factorial"><variable vname="x"/></funcall>
 </expr>