*** empty log message ***
authorhanda <handa>
Mon, 14 Sep 2009 13:51:43 +0000 (13:51 +0000)
committerhanda <handa>
Mon, 14 Sep 2009 13:51:43 +0000 (13:51 +0000)
XmlExpr.cs
xex.txt
xex.xml

index 733f592..33439d6 100644 (file)
@@ -49,6 +49,16 @@ namespace System.Xml.Expression
          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);
@@ -81,7 +91,6 @@ namespace System.Xml.Expression
     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";
@@ -89,41 +98,33 @@ namespace System.Xml.Expression
     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);
        }
       }
 
@@ -143,17 +144,54 @@ namespace System.Xml.Expression
        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)
@@ -163,16 +201,31 @@ namespace System.Xml.Expression
 
        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);
@@ -197,11 +250,12 @@ namespace System.Xml.Expression
       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
@@ -229,7 +283,7 @@ namespace System.Xml.Expression
 
       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)
       {
@@ -251,7 +305,7 @@ namespace System.Xml.Expression
     {
       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)
       {
@@ -271,11 +325,14 @@ namespace System.Xml.Expression
 
     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;
       }
     }
 
@@ -343,16 +400,17 @@ namespace System.Xml.Expression
 
     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)
       {
@@ -360,7 +418,8 @@ namespace System.Xml.Expression
 
       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;
       }
 
@@ -371,8 +430,7 @@ namespace System.Xml.Expression
 
       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)
@@ -380,8 +438,8 @@ namespace System.Xml.Expression
        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;
 
@@ -403,50 +461,23 @@ namespace System.Xml.Expression
          }
       }
 
-      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)
@@ -1061,21 +1092,9 @@ namespace System.Xml.Expression
       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++;
        }
@@ -1090,8 +1109,6 @@ namespace System.Xml.Expression
 
          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);
        }
@@ -1187,7 +1204,6 @@ namespace System.Xml.Expression
       Setup (node, domain);
     }
 
-
     // EXPR = SYMBOL | MTEXT | INTEGER | FUNCALL | PROGN
     // FUNCALL = '(' SYMBOL EXPR* ')'
     // PROGN = '(' EXPR * ')'
diff --git a/xex.txt b/xex.txt
index cdd2f9e..d6e6cbc 100644 (file)
--- a/xex.txt
+++ b/xex.txt
@@ -11,14 +11,14 @@ DEFUN =
   TERM *
   '</defun>'
 
-DEFMACRO =
-  '<defmacro mname="' MACRONAME '">'
-  ARGS ?
-  TERM *
-  '</defmacro>'
-
 ARGS =
-  '<args>' SYMBOL * '</args>' | '<args/>'
+  '<args>' [ SYMBOL | VAR ] * OPTIONAL ? REST ? '</args>'
+
+OPTIONAL =
+  '<optional/>' [ SYMBOL | VAR ] *
+
+REST =
+  '<rest/>' [ SYMBOL | VAR ]
 
 DEFVAR = DEFVAR-INT DEFVAR-STR DEFVAR-BOOL
 
@@ -62,9 +62,7 @@ LIST =
   '<const type="list">' DIRECT * '</const>' | <const type="list"/>
 
 FUNCALL =
-  '<funcall id="' [ FUNCNAME | MACRONAME ] '">' TERM * '</funcall>'
-  | '<funcall fname="' PREDEFINED-FUNC-NAME '">' TERM * '</funcall>'
-  | '<funcall mname="' PREDEFINED-MACRO-NAME '">' TERM * '</funcall>'
+  '<funcall fname="' PREDEFINED-FUNC-NAME '">' TERM * '</funcall>'
   | '<' PREDEFINED-FUNC-SYMBOL '>' TERM * '</' PREDEFINED-FUNC-SYMBOL '>'
   | '<' PREDEFINED-MACRO-SYMBOL '>' TERM * '</' PREDEFINED-MACRO-SYMBOL '>'
 
diff --git a/xex.xml b/xex.xml
index 4a8547b..09f7c34 100644 (file)
--- a/xex.xml
+++ b/xex.xml
@@ -1,8 +1,12 @@
 <?xml version='1.0'?>
 <expr>
   <defun fname="temp">
-    <args><const type="symbol">x</const><const type="symbol">y</const></args>
-    <add><variable vname="x"/><variable vname="y"/></add>
+    <args>
+      <const type="symbol">x</const><const type="symbol">y</const>
+    </args>
+    <body>
+      <add><variable vname="x"/><variable vname="y"/></add>
+    </body>
   </defun>
 
   <set>