*** empty log message ***
authorhanda <handa>
Sun, 9 Aug 2009 23:37:36 +0000 (23:37 +0000)
committerhanda <handa>
Sun, 9 Aug 2009 23:37:36 +0000 (23:37 +0000)
MExpression.cs

index 78a5239..fb1bfd8 100644 (file)
@@ -9,6 +9,7 @@ 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");
@@ -16,13 +17,22 @@ namespace M17N.Core
 
     public class Domain
     {
-      internal MPlist functions = new MPlist ();
-      internal MPlist bindings = new MPlist ();
-      internal object context;
+      internal MPlist functions;
+      internal MPlist bindings;
       internal Translator translator;
+      public object context;
+
+      internal Domain ()
+      {
+       functions = new MPlist ();
+       bindings = new MPlist ();
+      }
 
       public Domain (object context)
       {
+       functions = basic.functions;
+       bindings = basic.bindings;
+       translator = basic.translator;
        this.context = context;
       }
 
@@ -48,17 +58,24 @@ namespace M17N.Core
       }
 
       public void Defun (string name, Evaluator evaluator,
+                        int min_arg, int max_arg)
+      {
+       Defun (name, evaluator, min_arg, max_arg, false);
+      }
+
+      public void Defun (string name, Evaluator evaluator,
                         int min_arg, int max_arg, bool special)
       {
        MSymbol sym = MSymbol.Of (name);
-       Function func = new Function (evaluator, min_arg, max_arg, special);
+       Function func = new Function (sym, evaluator,
+                                     min_arg, max_arg, special);
 
        functions = functions.Cons (sym, func);
       }
 
       internal void Defun (MSymbol sym, MPlist args, MPlist body)
       {
-       Function func = new Function (args, body, this);
+       Function func = new Function (sym, args, body, this);
 
        functions = functions.Cons (sym, func);
       }
@@ -86,18 +103,35 @@ namespace M17N.Core
        MPlist slot = bindings.Find (name);
 
        if (slot == null)
-         bindings = bindings.Cons (MSymbol.nil, null);
+         bindings = bindings.Cons (name, val);
        else
          slot.val = val;
        return val;
       }
 
+      public bool IsBound (MSymbol name)
+      {
+       return (bindings.Find (name) != null);
+      }
+
       public void Translate (MPlist plist)
       {
        if (translator != null)
          for (MPlist p = plist; ! p.IsEmpty; p = p.next)
            translator (p, this);
       }
+
+      public override string ToString ()
+      {
+       string str = "<(functions";
+       foreach (MPlist p in functions)
+         str += " " + p.key;
+       str += ") (bindings " + bindings + ")";
+       if (context != null)
+         str += " (" + context + ")";
+       str += ">";
+       return str;
+      }
     }
 
     public delegate object Evaluator (MExpression[] args, Domain domain);
@@ -125,32 +159,46 @@ namespace M17N.Core
        }
       }
 
+      public readonly MSymbol Name;
       internal readonly Evaluator eval;
       internal readonly int min_arg, max_arg;
       private readonly Lambda lambda;
       private bool specialp = false;
 
-      internal static Function ignore, block;
+      internal static Function ignore, varref, block;
 
-      public Function (Evaluator eval, int min_arg, int max_arg, bool specialp)
+      public Function (MSymbol name, Evaluator eval,
+                      int min_arg, int max_arg, bool specialp)
       {
+       Name = name;
        this.eval = eval;
        this.min_arg = min_arg;
        this.max_arg = max_arg;
        this.specialp = specialp;
       }
 
-      public Function (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;
       }
 
-      private Function () {}
+      private Function ()
+      {
+       Name = MSymbol.nil;
+      }
 
       static Function ()
       {
        ignore = new Function ();
-       block = new Function (new Evaluator (progn), 0, -1, true);
+       varref = new Function (Mvarref, new Evaluator (get_value), 1, 1, true);
+       block = new Function (Mprogn, new Evaluator (progn), 0, -1, true);
+      }
+
+      private static object get_value (MExpression[] args, Domain domain)
+      {
+       return domain.GetValue ((MSymbol) args[0].val);
       }
 
       public object Call (MExpression[] args, Domain domain)
@@ -183,7 +231,7 @@ namespace M17N.Core
 
     static MExpression ()
     {
-      basic = new Domain (null);
+      basic = new Domain ();
 
       basic.Defun ("set", new Evaluator (set_value), 2, 2, true);
       basic.Defun ("=", new Evaluator (set_value), 2, 2, true);
@@ -194,17 +242,17 @@ namespace M17N.Core
       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, false);
-      basic.Defun ("*=", new Evaluator (multieq), 2, -1, false);
-      basic.Defun ("-=", new Evaluator (minuseq), 2, -1, false);
-      basic.Defun ("/=", new Evaluator (divideeq), 2, -1, false);
-      basic.Defun ("%=", new Evaluator (percenteq), 2, -1, false);
-      basic.Defun ("|=", new Evaluator (logioreq), 2, -1, false);
-      basic.Defun ("&=", new Evaluator (logandeq), 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, false);
-      basic.Defun (">>=", new Evaluator (rshifteq), 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);
@@ -213,6 +261,7 @@ namespace M17N.Core
       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.AddTranslator (new Translator (translate_cond));
@@ -220,7 +269,8 @@ namespace M17N.Core
 
     private static object set_value (MExpression[] args, Domain domain)
     {
-      return domain.SetValue ((MSymbol) args[0].val, args[1].Eval (domain));
+      return domain.SetValue ((MSymbol) args[0].args[0].val,
+                             args[1].Eval (domain));
     }
 
     private static object plus (MExpression[] args, Domain domain)
@@ -294,7 +344,7 @@ namespace M17N.Core
 
       private static object pluseq (MExpression[] args, Domain domain)
       {
-       MSymbol sym = (MSymbol) args[0].val;
+       MSymbol sym = (MSymbol) args[0].args[0].val;
        object val = domain.GetValue (sym);
 
        if (val is int)
@@ -311,12 +361,13 @@ namespace M17N.Core
              mt.Cat ((MText) args[i].Eval (domain));
            val = mt;
          }
-       return domain.SetValue (sym, val);
+       domain.SetValue (sym, val);
+       return val;
       }
 
       private static object multieq (MExpression[] args, Domain domain)
       {
-       MSymbol sym = (MSymbol) args[0].val;
+       MSymbol sym = (MSymbol) args[0].args[0].val;
        int n = (int) domain.GetValue (sym);
 
        for (int i = 1; i < args.Length; i++)
@@ -326,7 +377,7 @@ namespace M17N.Core
 
       private static object minuseq (MExpression[] args, Domain domain)
       {
-       MSymbol sym = (MSymbol) args[0].val;
+       MSymbol sym = (MSymbol) args[0].args[0].val;
        int n = (int) domain.GetValue (sym);
 
        for (int i = 1; i < args.Length; i++)
@@ -336,7 +387,7 @@ namespace M17N.Core
 
       private static object divideeq (MExpression[] args, Domain domain)
       {
-       MSymbol sym = (MSymbol) args[0].val;
+       MSymbol sym = (MSymbol) args[0].args[0].val;
        int n = (int) domain.GetValue (sym);
 
        for (int i = 1; i < args.Length; i++)
@@ -346,7 +397,7 @@ namespace M17N.Core
 
       private static object percenteq (MExpression[] args, Domain domain)
       {
-       MSymbol sym = (MSymbol) args[0].val;
+       MSymbol sym = (MSymbol) args[0].args[0].val;
        int n = (int) domain.GetValue (sym);
 
        for (int i = 1; i < args.Length; i++)
@@ -356,7 +407,7 @@ namespace M17N.Core
 
       private static object logioreq (MExpression[] args, Domain domain)
       {
-       MSymbol sym = (MSymbol) args[0].val;
+       MSymbol sym = (MSymbol) args[0].args[0].val;
        int n = (int) domain.GetValue (sym);
 
        for (int i = 1; i < args.Length; i++)
@@ -366,7 +417,7 @@ namespace M17N.Core
 
       private static object logandeq (MExpression[] args, Domain domain)
       {
-       MSymbol sym = (MSymbol) args[0].val;
+       MSymbol sym = (MSymbol) args[0].args[0].val;
        int n = (int) domain.GetValue (sym);
 
        for (int i = 1; i < args.Length; i++)
@@ -381,7 +432,7 @@ namespace M17N.Core
 
       private static object lshifteq (MExpression[] args, Domain domain)
       {
-       MSymbol sym = (MSymbol) args[0].val;
+       MSymbol sym = (MSymbol) args[0].args[0].val;
        int n = (int) domain.GetValue (sym);
 
        n <<= (int) args[1].Eval (domain);
@@ -395,7 +446,7 @@ namespace M17N.Core
 
       private static object rshifteq (MExpression[] args, Domain domain)
       {
-       MSymbol sym = (MSymbol) args[0].val;
+       MSymbol sym = (MSymbol) args[0].args[0].val;
        int n = (int) domain.GetValue (sym);
 
        n >>= (int) args[1].Eval (domain);
@@ -499,6 +550,16 @@ namespace M17N.Core
        return result;
       }
 
+      private static object whenclause (MExpression[] args, Domain domain)
+      {
+       object result = false;
+
+       if (check_condition (args[0], domain))
+         for (int i = 1; i < args.Length; i++)
+           result = args[i].Eval (domain);
+       return result;
+      }
+
       private static object whileclause (MExpression[] args, Domain domain)
       {
        while (check_condition (args[0], domain))
@@ -531,15 +592,26 @@ namespace M17N.Core
     private MExpression[] args;
     private object val;
 
+    private MExpression (object val)
+    {
+      this.val = val;
+    }
+
     // EXPR = SYMBOL | MTEXT | INTEGER | FUNCALL | PROGN
     // FUNCALL = '(' SYMBOL EXPR* ')'
     // PROGN = '(' EXPR * ')'
     private MExpression (MSymbol key, object val, Domain domain)
     {
-      if (key == MSymbol.symbol || key == MSymbol.integer
-         || key == MSymbol.mtext)
+      if (key == MSymbol.symbol)
        {
-         this.val = (MSymbol) val;
+         function = Function.varref;
+         args = new MExpression[1];
+         args[0] = new MExpression (val);
+       }
+      else if (key == MSymbol.integer
+              || key == MSymbol.mtext)
+       {
+         this.val = val;
        }
       else if (key == MSymbol.plist)
        {
@@ -552,6 +624,11 @@ namespace M17N.Core
              if (sym == Mdefun)
                {
                  p = p.next;
+                 if (! p.IsSymbol)
+                   throw new Exception ("Invalid function argument: "
+                                        + p.val);
+                 sym = p.Symbol;
+                 p = p.next;
                  if (! p.IsPlist)
                    throw new Exception ("Invalid function argument: "
                                         + p.val);
@@ -591,6 +668,8 @@ namespace M17N.Core
        args[i] = new MExpression (plist.key, plist.val, domain);
     }
 
+    public object Val { get { return val; } }
+
     public object Eval (Domain domain)
     {
       if (function == null)
@@ -605,6 +684,21 @@ namespace M17N.Core
 
     public override string ToString ()
     {
+      string str;
+
+      if (function != null)
+       {
+         str = "(" + function.Name.Name;
+         if (args != null)
+           foreach (MExpression e in args)
+             str += " " + e.ToString ();
+         str += ")";
+       }
+      else if (val != null)
+       str = val.ToString ();
+      else
+       str = "()";
+      return str;
     }
   }
 }