From 906840b0dde33b7bae6ed3d939a9feaf845f9848 Mon Sep 17 00:00:00 2001
From: handa <handa>
Date: Mon, 14 Sep 2009 13:51:43 +0000
Subject: [PATCH] *** empty log message ***

---
 XmlExpr.cs |  230 ++++++++++++++++++++++++++++++++----------------------------
 xex.txt    |   18 +++--
 xex.xml    |    8 ++-
 3 files changed, 137 insertions(+), 119 deletions(-)

diff --git a/XmlExpr.cs b/XmlExpr.cs
index 733f592..33439d6 100644
--- a/XmlExpr.cs
+++ b/XmlExpr.cs
@@ -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
--- 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
--- 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>
-- 
1.7.10.4