X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=MExpression.cs;h=d8fbadfce8bac430c1b78f3ac2f6ac324c754fe9;hb=3c39b282b53d78ca6e76ababf377aec3a081303a;hp=70bebd87c8d61d3e1af691e7304857e6a8473fa7;hpb=022f7789c6fa5adac2ad2dd52e296478b4bd1007;p=m17n%2Fm17n-lib-cs.git

diff --git a/MExpression.cs b/MExpression.cs
index 70bebd8..d8fbadf 100644
--- a/MExpression.cs
+++ b/MExpression.cs
@@ -2,6 +2,8 @@ using System;
 using System.Collections;
 using System.Collections.Generic;
 using System.IO;
+using System.Xml;
+
 using M17N;
 using M17N.Core;
 
@@ -9,39 +11,33 @@ namespace M17N.Core
 {
   public class MExpression
   {
-    private static MSymbol Mvarref = MSymbol.Of ("symbol-value");
-    private static MSymbol Mdefun = MSymbol.Of ("defun");
-    private static MSymbol Mcond = MSymbol.Of ("cond");
-    private static MSymbol Mprogn = MSymbol.Of ("progn");
-    private static MSymbol Mwhen = MSymbol.Of ("when");
+    private static MSymbol Mvarref = "symbol-value";
+    private static MSymbol Mdefun = "defun";
+    private static MSymbol Mcond = "cond";
+    private static MSymbol Mprogn = "progn";
+    private static MSymbol Mwhen = "when";
 
     public class Domain
     {
-      internal MPlist functions;
-      internal MPlist bindings;
+      private Domain parent;
+      internal MPlist functions = new MPlist ();
+      internal MPlist bindings = new MPlist ();
+      private Stack<MPlist> boundaries = new Stack<MPlist> ();
       internal Translator translator;
       public object context;
 
       internal Domain ()
       {
-	functions = new MPlist ();
-	bindings = new MPlist ();
+	boundaries.Push (bindings);
       }
 
-      public Domain (object context)
-      {
-	functions = basic.functions;
-	bindings = basic.bindings;
-	translator = basic.translator;
-	this.context = context;
-      }
+      public Domain (object context) : this (basic, context) { }
 
       public Domain (Domain parent, object context)
       {
-	functions = parent.functions;
-	bindings = parent.bindings;
-	translator = parent.translator;
+	this.parent = parent;
 	this.context = context;
+	boundaries.Push (bindings);
       }
 
       public void AddTranslator (Translator translator)
@@ -57,27 +53,91 @@ namespace M17N.Core
 	bindings = bindings.Cons (sym, value);
       }
 
-      public void Defun (string name, Evaluator evaluator,
-			 int min_arg, int max_arg)
+      public MPlist SetBoundary ()
+      {
+	boundaries.Push (bindings);
+	return bindings;
+      }
+
+      public void UnboundTo (MPlist boundary)
+      {
+	while (boundary != boundaries.Pop ());
+	while (bindings != boundary)
+	  bindings = bindings.next;
+      }
+
+      public void Defun (string name, Builtin builtin, int min_arg, int max_arg)
+      {
+	Defun (name, builtin, min_arg, max_arg, false);
+      }
+
+      public void Defun (string name, Builtin builtin, int min_arg, int max_arg,
+			 bool specialp)
       {
-	Defun (name, evaluator, min_arg, max_arg, false);
+	MSymbol sym = name;
+	Function func = (Function) functions.Get (sym);
+
+	if (func != null)
+	  {
+	    if (func.min_arg < min_arg || func.max_arg > max_arg)
+	      throw new Exception ("Incompatible argument numbers to override: "
+				   + name);
+	    func.builtin = builtin;
+	    func.lambda = null;
+	    func.min_arg = min_arg;
+	    func.max_arg = max_arg;
+	    func.specialp = specialp;
+	  }
+	else
+	  {
+	    func = new Function (sym, builtin, min_arg, max_arg, specialp);
+	    functions = functions.Cons (sym, func);
+	  }
       }
 
-      public void Defun (string name, Evaluator evaluator,
-			 int min_arg, int max_arg, bool special)
+      public void Defun (MSymbol sym, MPlist args, MPlist body)
       {
-	MSymbol sym = MSymbol.Of (name);
-	Function func = new Function (sym, evaluator,
-				      min_arg, max_arg, special);
+	Function func = (Function) functions.Get (sym);
 
-	functions = functions.Cons (sym, func);
+	if (func != null)
+	  {
+	    int nargs = args == null ? 0 : args.Count;
+
+	    if (func.min_arg < nargs || func.max_arg > nargs)
+	      throw new Exception ("Incompatible argument numbers to override: "
+				   + sym);
+	    func.lambda.SetArgs (args);
+	    func.lambda.SetBody (body, this);
+	    func.builtin = null;
+	  }
+	else
+	  {
+	    func = new Function (sym, args, body, this);
+	    functions = functions.Cons (sym, func);
+	  }	    
       }
 
-      internal void Defun (MSymbol sym, MPlist args, MPlist body)
+      public void Defun (XmlNode node)
       {
-	Function func = new Function (sym, args, body, this);
+	MSymbol sym = node.Attributes["id"].Value;
+	Function func = (Function) functions.Get (sym);
 
-	functions = functions.Cons (sym, func);
+	if (func != null)
+	  {
+	    XmlNode args = node.FirstChild;
+	    int nargs = args.Name == "args" ? args.ChildNodes.Count : 0;
+
+	    if (func.min_arg < nargs || func.max_arg > nargs)
+	      throw new Exception ("Incompatible argument numbers to override: "
+				   + sym);
+	    func.lambda.Set (node, this);
+	    func.builtin = null;
+	  }
+	else
+	  {
+	    func = new Function (sym, node, this);
+	    functions = functions.Cons (sym, func);
+	  }	    
       }
 
       internal Function GetFunc (MSymbol name)
@@ -85,27 +145,53 @@ namespace M17N.Core
 	Function func = (Function) functions.Get (name);
 
 	if (func == null)
-	  throw new Exception ("Unknown function: " + name);
+	  {
+	    if (parent != null)
+	      return parent.GetFunc (name);
+	    throw new Exception ("Unknown function: " + name);
+	  }
 	return func;
       }
 
+      public bool CopyFunc (Domain domain, MSymbol name)
+      {
+	Function func = (Function) functions.Get (name);
+	if (func == null)
+	  return false;
+	domain.functions = domain.functions.Cons (name, func);
+	return true;
+      }
+
+      public void CopyFunc (Domain domain)
+      {
+	foreach (MPlist p in functions)
+	  domain.functions = domain.functions.Cons (p.key, p.val);
+      }
+
       public object GetValue (MSymbol name)
       {
 	MPlist slot = bindings.Find (name);
 
 	if (slot == null)
-	  throw new Exception ("Unbound variable: " + name);
+	  {
+	    if (parent != null)
+	      return parent.GetValue (name);
+	    throw new Exception ("Unbound variable: " + name);
+	  }
 	return slot.val;
       }
 
       public object SetValue (MSymbol name, object val)
       {
-	MPlist slot = bindings.Find (name);
+	MPlist boundary = boundaries.Peek ();
 
-	if (slot == null)
-	  bindings = bindings.Cons (name, val);
-	else
-	  slot.val = val;
+	for (MPlist plist = bindings; plist != boundary; plist = plist.next)
+	  if (plist.key == name)
+	    {
+	      plist.val = val;
+	      return val;
+	    }
+	bindings = bindings.Cons (name, val);
 	return val;
       }
 
@@ -116,6 +202,8 @@ namespace M17N.Core
 
       public void Translate (MPlist plist)
       {
+	if (parent != null)
+	  parent.Translate (plist);
 	if (translator != null)
 	  for (MPlist p = plist; ! p.IsEmpty; p = p.next)
 	    translator (p, this);
@@ -134,56 +222,105 @@ namespace M17N.Core
       }
     }
 
-    public delegate object Evaluator (MExpression[] args, Domain domain);
+    public delegate object Builtin (MExpression[] args, Domain domain);
     public delegate void Translator (MPlist plist, Domain domain);
 
     internal class Function
     {
-      private class Lambda
+      internal class Lambda
       {
-	internal readonly MSymbol[] args;
-	internal readonly MExpression[] body;
+	internal MSymbol[] args;
+	internal MExpression[] body;
 
 	public Lambda (MPlist args, MPlist body, Domain domain)
 	{
-	  int len;
+	  SetArgs (args);
+	  SetBody (body, domain);
+	}
+
+	public Lambda (XmlNode node, Domain domain)
+	{
+	  Set (node, domain);
+	}
 
-	  len = args.Count;
-	  this.args = new MSymbol[len];
-	  for (int i = 0; ! args.IsEmpty; i++, args = args.next)
+	public void SetArgs (MPlist args)
+	{
+	  int len = args == null ? 0 : args.Count;
+
+	  if (this.args == null)
+	    this.args = new MSymbol[len];
+	  for (int i = 0; i < len; i++, args = args.next)
 	    this.args[i] = args.Symbol;
-	  len = body.Count;
-	  this.body = new MExpression[len];
-	  for (int i = 0; ! body.IsEmpty; i++, body = body.next)
-	    this.body[i] = new MExpression (body.key, body.val, domain);
+	}
+
+	public void SetBody (MPlist body, Domain domain)
+	{
+	  int len = body == null ? 0 : body.Count;
+	  if (this.body == null)
+	    this.body = new MExpression[len];
+	  for (int i = 0; i < len; i++, body = body.next)
+	    {
+	      domain.Translate (body);
+	      this.body[i] = new MExpression (body.key, body.val, domain);
+	    }
+	}
+
+	public void Set (XmlNode node, Domain domain)
+	{
+	  XmlNodeList body = node.ChildNodes;
+	  int idx = 0;
+
+	  if (body[0].Name == "args")
+	    {
+	      XmlNodeList args = body[0].ChildNodes;
+	      if (this.args == null)
+		this.args = new MSymbol[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 MSymbol[0];
+	  if (this.body == null)
+	    this.body = new MExpression[body.Count - idx];
+	  for (int i = 0; idx < body.Count; i++, idx++)
+	    this.body[i] = new MExpression (body[idx], domain);
 	}
       }
 
       public readonly MSymbol Name;
-      private readonly Evaluator eval;
-      public readonly int min_arg, max_arg;
-      private readonly Lambda lambda;
-      private readonly bool specialp = false;
+      public Builtin builtin;
+      public int min_arg, max_arg;
+      internal Lambda lambda;
+      public bool specialp = false;
 
       internal static Function ignore, varref, block;
 
-      public Function (MSymbol name, Evaluator eval,
+      public Function (MSymbol name, Builtin builtin,
 		       int min_arg, int max_arg, bool specialp)
       {
 	Name = name;
-	this.eval = eval;
+	this.builtin = builtin;
 	this.min_arg = min_arg;
 	this.max_arg = max_arg;
 	this.specialp = specialp;
       }
 
-      internal Function (MSymbol name, MPlist args, MPlist body, Domain domain)
+      internal Function (MSymbol name, MPlist args, MPlist body,
+			 Domain domain)
       {
 	Name = name;
 	lambda = new Lambda (args, body, domain);
 	this.min_arg = this.max_arg = lambda.args.Length;
       }
 
+      internal Function (MSymbol name, XmlNode node, Domain domain)
+      {
+	Name = name;
+	lambda = new Lambda (node, domain);
+	this.min_arg = this.max_arg = lambda.args.Length;
+      }
+
       private Function ()
       {
 	Name = MSymbol.nil;
@@ -192,8 +329,8 @@ namespace M17N.Core
       static Function ()
       {
 	ignore = new Function ();
-	varref = new Function (Mvarref, new Evaluator (get_value), 1, 1, true);
-	block = new Function (Mprogn, new Evaluator (progn), 0, -1, true);
+	varref = new Function (Mvarref, get_value, 1, 1, true);
+	block = new Function (Mprogn, progn, 0, -1, true);
       }
 
       private static object get_value (MExpression[] args, Domain domain)
@@ -203,12 +340,12 @@ namespace M17N.Core
 
       public object Call (MExpression[] args, Domain domain)
       {
-	if (eval != null)
+	if (builtin != null)
 	  {
 	    if (! specialp)
 	      foreach (MExpression e in args)
 		e.Eval (domain);
-	    return eval (args, domain);
+	    return builtin (args, domain);
 	  }
 	if (lambda == null)
 	  return null;
@@ -233,36 +370,37 @@ namespace M17N.Core
     {
       basic = new Domain ();
 
-      basic.Defun ("set", new Evaluator (set_value), 2, 2, true);
-      basic.Defun ("=", new Evaluator (set_value), 2, 2, true);
-      basic.Defun ("+", new Evaluator (plus), 2, -1, false);
-      basic.Defun ("*", new Evaluator (multi), 2, -1, false);
-      basic.Defun ("-", new Evaluator (minus), 1, -1, false);
-      basic.Defun ("/", new Evaluator (divide), 2, -1, false);
-      basic.Defun ("%", new Evaluator (percent), 2, -1, false);
-      basic.Defun ("|", new Evaluator (logior), 2, -1, false);
-      basic.Defun ("&", new Evaluator (logand), 2, -1, false);
-      basic.Defun ("+=", new Evaluator (pluseq), 2, -1, true);
-      basic.Defun ("*=", new Evaluator (multieq), 2, -1, true);
-      basic.Defun ("-=", new Evaluator (minuseq), 2, -1, true);
-      basic.Defun ("/=", new Evaluator (divideeq), 2, -1, true);
-      basic.Defun ("%=", new Evaluator (percenteq), 2, -1, true);
-      basic.Defun ("|=", new Evaluator (logioreq), 2, -1, true);
-      basic.Defun ("&=", new Evaluator (logandeq), 2, -1, true);
-      basic.Defun ("<<", new Evaluator (lshift), 2, 2, false);
-      basic.Defun (">>", new Evaluator (rshift), 2, 2, false);
-      basic.Defun ("<<=", new Evaluator (lshifteq), 2, 2, true);
-      basic.Defun (">>=", new Evaluator (rshifteq), 2, 2, true);
-      basic.Defun ("==", new Evaluator (eq), 2, -1, false);
-      basic.Defun ("!=", new Evaluator (noteq), 2, 2, false);
-      basic.Defun ("<", new Evaluator (less), 2, -1, false);
-      basic.Defun ("<=", new Evaluator (lesseq), 2, -1, false);
-      basic.Defun (">", new Evaluator (more), 2, -1, false);
-      basic.Defun (">=", new Evaluator (moreeq), 2, -1, false);
-      basic.Defun ("progn", new Evaluator (progn), 0, -1, true);
-      basic.Defun ("if", new Evaluator (ifclause), 2, -1, true);
-      basic.Defun ("when", new Evaluator (whenclause), 2, -1, true);
-      basic.Defun ("while", new Evaluator (whileclause), 1, -1, true);
+      basic.Defun ("set", set_value, 2, 2, true);
+      basic.Defun ("=", set_value, 2, 2, true);
+      basic.Defun ("!", not, 1, 1, false);
+      basic.Defun ("+", plus, 2, -1, false);
+      basic.Defun ("*", multi, 2, -1, false);
+      basic.Defun ("-", minus, 1, -1, false);
+      basic.Defun ("/", divide, 2, -1, false);
+      basic.Defun ("%", percent, 2, -1, false);
+      basic.Defun ("|", logior, 2, -1, false);
+      basic.Defun ("&", logand, 2, -1, false);
+      basic.Defun ("+=", pluseq, 2, -1, true);
+      basic.Defun ("*=", multieq, 2, -1, true);
+      basic.Defun ("-=", minuseq, 2, -1, true);
+      basic.Defun ("/=", divideeq, 2, -1, true);
+      basic.Defun ("%=", percenteq, 2, -1, true);
+      basic.Defun ("|=", logioreq, 2, -1, true);
+      basic.Defun ("&=", logandeq, 2, -1, true);
+      basic.Defun ("<<", lshift, 2, 2, false);
+      basic.Defun (">>", rshift, 2, 2, false);
+      basic.Defun ("<<=", lshifteq, 2, 2, true);
+      basic.Defun (">>=", rshifteq, 2, 2, true);
+      basic.Defun ("==", eq, 2, -1, false);
+      basic.Defun ("!=", noteq, 2, 2, false);
+      basic.Defun ("<", less, 2, -1, false);
+      basic.Defun ("<=", lesseq, 2, -1, false);
+      basic.Defun (">", more, 2, -1, false);
+      basic.Defun (">=", moreeq, 2, -1, false);
+      basic.Defun ("progn", progn, 0, -1, true);
+      basic.Defun ("if", ifclause, 2, -1, true);
+      basic.Defun ("when", whenclause, 1, -1, true);
+      basic.Defun ("while", whileclause, 1, -1, true);
 
       basic.AddTranslator (new Translator (translate_cond));
     }
@@ -273,6 +411,15 @@ namespace M17N.Core
 			      args[1].Eval (domain));
     }
 
+    private static object not (MExpression[] args, Domain domain)
+    {
+      if (args[0].val is int)
+	return (int) args[0].val == 0;
+      if (args[0].val is bool)
+	return ! ((bool) args[0].val);
+      return true;
+    }
+
     private static object plus (MExpression[] args, Domain domain)
     {
       if (args[0].val is int)
@@ -569,7 +716,7 @@ namespace M17N.Core
       }
 
     // (cond (COND1 ...) (COND2 ...) ...)
-    //   => (progn (when COND1 ...) (when COND2 ...) ...)
+    //   => (cond (when COND1 ...) (when COND2 ...) ...)
     private static void translate_cond (MPlist plist, Domain domain)
     {
       if (plist.IsPlist)
@@ -592,6 +739,9 @@ namespace M17N.Core
     private MExpression[] args;
     private object val;
 
+    public MExpression[] Args { get { return args; } }
+    public object Val { get { return val; } }
+
     private MExpression (object val)
     {
       this.val = val;
@@ -646,7 +796,10 @@ namespace M17N.Core
 					 + sym + " " + nargs);
 		  args = new MExpression[nargs];
 		  for (int i = 0; i < nargs; i++, p = p.next)
-		    args[i] = new MExpression (p.key, p.val, domain);
+		    {
+		      domain.Translate (p);
+		      args[i] = new MExpression (p.key, p.val, domain);
+		    }
 		}
 	    }
 	  else
@@ -663,12 +816,33 @@ namespace M17N.Core
     {
       function = Function.block;
       args = new MExpression[plist.Count];
-      domain.Translate (plist);
       for (int i = 0; ! plist.IsEmpty; i++, plist = plist.next)
-	args[i] = new MExpression (plist.key, plist.val, domain);
+	{
+	  domain.Translate (plist);
+	  args[i] = new MExpression (plist.key, plist.val, domain);
+	}
     }
 
-    public object Val { get { return val; } }
+    public MExpression (XmlNode node, Domain domain)
+    {
+      MSymbol sym = node.Name;
+
+      function = domain.GetFunc (sym);
+
+      XmlAttributeCollection attrs = node.Attributes;
+
+      int nargs = attrs.Count + node.ChildNodes.Count;
+      if (nargs < function.min_arg
+	  || (function.max_arg >= 0 && nargs > function.max_arg))
+	throw new Exception ("Invalid number of arguments: " + node.InnerXml);
+      args = new MExpression[nargs];
+      int i;
+      for (i = 0; i < attrs.Count; i++)
+	{
+	  string str = sttrs[i].Value;
+
+	}
+    }
 
     public object Eval (Domain domain)
     {
@@ -695,7 +869,12 @@ namespace M17N.Core
 	  str += ")";
 	}
       else if (val != null)
-	str = val.ToString ();
+	{
+	  if (val is MText)
+	    str = "\"" + (string) ((MText) val) + "\"";
+	  else
+	    str = val.ToString ();
+	}
       else
 	str = "()";
       return str;