MExpression.cs

   1 using System;
   2 using System.Collections;
   3 using System.Collections.Generic;
   4 using System.IO;
   5 using M17N;
   6 using M17N.Core;
   7
   8 namespace M17N.Core
   9 {
  10   public class MExpression
  11   {
  12     private static MSymbol Mvarref = MSymbol.Of ("symbol-value");
  13     private static MSymbol Mdefun = MSymbol.Of ("defun");
  14     private static MSymbol Mcond = MSymbol.Of ("cond");
  15     private static MSymbol Mprogn = MSymbol.Of ("progn");
  16     private static MSymbol Mwhen = MSymbol.Of ("when");
  17
  18     public class Domain
  19     {
  20       internal MPlist functions;
  21       internal MPlist bindings;
  22       internal Translator translator;
  23       public object context;
  24
  25       internal Domain ()
  26       {
  27         functions = new MPlist ();
  28         bindings = new MPlist ();
  29       }
  30
  31       public Domain (object context)
  32       {
  33         functions = basic.functions;
  34         bindings = basic.bindings;
  35         translator = basic.translator;
  36         this.context = context;
  37       }
  38
  39       public Domain (Domain parent, object context)
  40       {
  41         functions = parent.functions;
  42         bindings = parent.bindings;
  43         translator = parent.translator;
  44         this.context = context;
  45       }
  46
  47       public void AddTranslator (Translator translator)
  48       {
  49         if (this.translator == null)
  50           this.translator = translator;
  51         else
  52           this.translator += translator;
  53       }
  54
  55       public void Bind (MSymbol sym, object value)
  56       {
  57         bindings = bindings.Cons (sym, value);
  58       }
  59
  60       public void Defun (string name, Evaluator evaluator,
  61                          int min_arg, int max_arg)
  62       {
  63         Defun (name, evaluator, min_arg, max_arg, false);
  64       }
  65
  66       public void Defun (string name, Evaluator evaluator,
  67                          int min_arg, int max_arg, bool special)
  68       {
  69         MSymbol sym = MSymbol.Of (name);
  70         Function func = new Function (sym, evaluator,
  71                                       min_arg, max_arg, special);
  72
  73         functions = functions.Cons (sym, func);
  74       }
  75
  76       public void Defun (MSymbol sym, MPlist args, MPlist body)
  77       {
  78         Function func = new Function (sym, args, body, this);
  79
  80         functions = functions.Cons (sym, func);
  81       }
  82
  83       internal Function GetFunc (MSymbol name)
  84       {
  85         Function func = (Function) functions.Get (name);
  86
  87         if (func == null)
  88           throw new Exception ("Unknown function: " + name);
  89         return func;
  90       }
  91
  92       public bool CopyFunc (MSymbol name, Domain domain)
  93       {
  94         Function func = (Function) functions.Get (name);
  95         if (func == null)
  96           return false;
  97         domain.functions = domain.functions.Cons (name, func);
  98         return true;
  99       }
 100
 101       public void CopyFunc (Domain domain)
 102       {
 103         foreach (MPlist p in functions)
 104           domain.functions = domain.functions.Cons (p.key, p.val);
 105       }
 106
 107       public object GetValue (MSymbol name)
 108       {
 109         MPlist slot = bindings.Find (name);
 110
 111         if (slot == null)
 112           throw new Exception ("Unbound variable: " + name);
 113         return slot.val;
 114       }
 115
 116       public object SetValue (MSymbol name, object val)
 117       {
 118         MPlist slot = bindings.Find (name);
 119
 120         if (slot == null)
 121           bindings = bindings.Cons (name, val);
 122         else
 123           slot.val = val;
 124         return val;
 125       }
 126
 127       public bool IsBound (MSymbol name)
 128       {
 129         return (bindings.Find (name) != null);
 130       }
 131
 132       public void Translate (MPlist plist)
 133       {
 134         if (translator != null)
 135           for (MPlist p = plist; ! p.IsEmpty; p = p.next)
 136             translator (p, this);
 137       }
 138
 139       public override string ToString ()
 140       {
 141         string str = "<(functions";
 142         foreach (MPlist p in functions)
 143           str += " " + p.key;
 144         str += ") (bindings " + bindings + ")";
 145         if (context != null)
 146           str += " (" + context + ")";
 147         str += ">";
 148         return str;
 149       }
 150     }
 151
 152     public delegate object Evaluator (MExpression[] args, Domain domain);
 153     public delegate void Translator (MPlist plist, Domain domain);
 154
 155     internal class Function
 156     {
 157       private class Lambda
 158       {
 159         internal readonly MSymbol[] args;
 160         internal readonly MExpression[] body;
 161
 162         public Lambda (MPlist args, MPlist body, Domain domain)
 163         {
 164           int len;
 165
 166           len = args.Count;
 167           this.args = new MSymbol[len];
 168           for (int i = 0; ! args.IsEmpty; i++, args = args.next)
 169             this.args[i] = args.Symbol;
 170           len = body.Count;
 171           this.body = new MExpression[len];
 172           for (int i = 0; ! body.IsEmpty; i++, body = body.next)
 173             {
 174               domain.Translate (body);
 175               this.body[i] = new MExpression (body.key, body.val, domain);
 176             }
 177         }
 178       }
 179
 180       public readonly MSymbol Name;
 181       private readonly Evaluator eval;
 182       public readonly int min_arg, max_arg;
 183       private readonly Lambda lambda;
 184       private readonly bool specialp = false;
 185
 186       internal static Function ignore, varref, block;
 187
 188       public Function (MSymbol name, Evaluator eval,
 189                        int min_arg, int max_arg, bool specialp)
 190       {
 191         Name = name;
 192         this.eval = eval;
 193         this.min_arg = min_arg;
 194         this.max_arg = max_arg;
 195         this.specialp = specialp;
 196       }
 197
 198       internal Function (MSymbol name, MPlist args, MPlist body, Domain domain)
 199       {
 200         Name = name;
 201         lambda = new Lambda (args, body, domain);
 202         this.min_arg = this.max_arg = lambda.args.Length;
 203       }
 204
 205       private Function ()
 206       {
 207         Name = MSymbol.nil;
 208       }
 209
 210       static Function ()
 211       {
 212         ignore = new Function ();
 213         varref = new Function (Mvarref, get_value, 1, 1, true);
 214         block = new Function (Mprogn, progn, 0, -1, true);
 215       }
 216
 217       private static object get_value (MExpression[] args, Domain domain)
 218       {
 219         return domain.GetValue ((MSymbol) args[0].val);
 220       }
 221
 222       public object Call (MExpression[] args, Domain domain)
 223       {
 224         if (eval != null)
 225           {
 226             if (! specialp)
 227               foreach (MExpression e in args)
 228                 e.Eval (domain);
 229             return eval (args, domain);
 230           }
 231         if (lambda == null)
 232           return null;
 233         MPlist orig_bindings = domain.bindings;
 234         object result = false;
 235         try {
 236           int i = 0;
 237           foreach (MSymbol arg in lambda.args)
 238             domain.Bind (arg, args[i++].Eval (domain));
 239           foreach (MExpression e in lambda.body)
 240             result = e.Eval (domain);
 241         } finally {
 242           domain.bindings = orig_bindings;
 243         }
 244         return result;
 245       }
 246     }
 247
 248     private static Domain basic;
 249
 250     static MExpression ()
 251     {
 252       basic = new Domain ();
 253
 254       basic.Defun ("set", set_value, 2, 2, true);
 255       basic.Defun ("=", set_value, 2, 2, true);
 256       basic.Defun ("+", plus, 2, -1, false);
 257       basic.Defun ("*", multi, 2, -1, false);
 258       basic.Defun ("-", minus, 1, -1, false);
 259       basic.Defun ("/", divide, 2, -1, false);
 260       basic.Defun ("%", percent, 2, -1, false);
 261       basic.Defun ("|", logior, 2, -1, false);
 262       basic.Defun ("&", logand, 2, -1, false);
 263       basic.Defun ("+=", pluseq, 2, -1, true);
 264       basic.Defun ("*=", multieq, 2, -1, true);
 265       basic.Defun ("-=", minuseq, 2, -1, true);
 266       basic.Defun ("/=", divideeq, 2, -1, true);
 267       basic.Defun ("%=", percenteq, 2, -1, true);
 268       basic.Defun ("|=", logioreq, 2, -1, true);
 269       basic.Defun ("&=", logandeq, 2, -1, true);
 270       basic.Defun ("<<", lshift, 2, 2, false);
 271       basic.Defun (">>", rshift, 2, 2, false);
 272       basic.Defun ("<<=", lshifteq, 2, 2, true);
 273       basic.Defun (">>=", rshifteq, 2, 2, true);
 274       basic.Defun ("==", eq, 2, -1, false);
 275       basic.Defun ("!=", noteq, 2, 2, false);
 276       basic.Defun ("<", less, 2, -1, false);
 277       basic.Defun ("<=", lesseq, 2, -1, false);
 278       basic.Defun (">", more, 2, -1, false);
 279       basic.Defun (">=", moreeq, 2, -1, false);
 280       basic.Defun ("progn", progn, 0, -1, true);
 281       basic.Defun ("if", ifclause, 2, -1, true);
 282       basic.Defun ("when", whenclause, 2, -1, true);
 283       basic.Defun ("while", whileclause, 1, -1, true);
 284
 285       basic.AddTranslator (new Translator (translate_cond));
 286     }
 287
 288     private static object set_value (MExpression[] args, Domain domain)
 289     {
 290       return domain.SetValue ((MSymbol) args[0].args[0].val,
 291                               args[1].Eval (domain));
 292     }
 293
 294     private static object plus (MExpression[] args, Domain domain)
 295     {
 296       if (args[0].val is int)
 297         {
 298           int n = 0;
 299           foreach (MExpression e in args)
 300             n += (int) e.val;
 301           return n;
 302         }
 303       else if (args[0].val is MText)
 304         {
 305           MText mt = new MText ();
 306           foreach (MExpression e in args)
 307             mt += (MText) e.val;
 308           return mt;
 309         }
 310       throw new Exception ("Not an integer nor MText: " + args[0].val);
 311     }
 312
 313       private static object multi (MExpression[] args, Domain domain)
 314       {
 315         int n = 1;
 316         foreach (MExpression e in args)
 317           n *= (int) e.val;
 318         return n;
 319       }
 320
 321       private static object minus (MExpression[] args, Domain domain)
 322       {
 323         int n = (int) args[0].val;
 324         if (args.Length == 1)
 325           return - n;
 326         for (int i = 1; i < args.Length; i++)
 327           n -= (int) args[i].val;
 328         return n;
 329       }
 330
 331       private static object divide (MExpression[] args, Domain domain)
 332       {
 333         int n = (int) args[0].val;
 334         for (int i = 1; i < args.Length; i++)
 335           n /= (int) args[i].val;
 336         return n;
 337       }
 338
 339       private static object percent (MExpression[] args, Domain domain)
 340       {
 341         int n = (int) args[0].val;
 342         for (int i = 1; i < args.Length; i++)
 343           n %= (int) args[i].val;
 344         return n;
 345       }
 346
 347       private static object logior (MExpression[] args, Domain domain)
 348       {
 349         int n = 0;
 350         foreach (MExpression e in args)
 351           n |= (int) e.val;
 352         return n;
 353       }
 354
 355       private static object logand (MExpression[] args, Domain domain)
 356       {
 357         int n = 0;
 358         foreach (MExpression e in args)
 359           n &= (int) e.val;
 360         return n;
 361       }
 362
 363       private static object pluseq (MExpression[] args, Domain domain)
 364       {
 365         MSymbol sym = (MSymbol) args[0].args[0].val;
 366         object val = domain.GetValue (sym);
 367
 368         if (val is int)
 369           {
 370             int n = (int) val;
 371             for (int i = 1; i < args.Length; i++)
 372               n += (int) args[i].Eval (domain);
 373             val = n;
 374           }
 375         else if (val is MText)
 376           {
 377             MText mt = (MText) val;
 378             for (int i = 1; i < args.Length; i++)
 379               mt.Cat ((MText) args[i].Eval (domain));
 380             val = mt;
 381           }
 382         domain.SetValue (sym, val);
 383         return val;
 384       }
 385
 386       private static object multieq (MExpression[] args, Domain domain)
 387       {
 388         MSymbol sym = (MSymbol) args[0].args[0].val;
 389         int n = (int) domain.GetValue (sym);
 390
 391         for (int i = 1; i < args.Length; i++)
 392           n *= (int) args[i].Eval (domain);
 393         return domain.SetValue (sym, (object) n);
 394       }
 395
 396       private static object minuseq (MExpression[] args, Domain domain)
 397       {
 398         MSymbol sym = (MSymbol) args[0].args[0].val;
 399         int n = (int) domain.GetValue (sym);
 400
 401         for (int i = 1; i < args.Length; i++)
 402           n -= (int) args[i].Eval (domain);
 403         return domain.SetValue (sym, (object) n);
 404       }
 405
 406       private static object divideeq (MExpression[] args, Domain domain)
 407       {
 408         MSymbol sym = (MSymbol) args[0].args[0].val;
 409         int n = (int) domain.GetValue (sym);
 410
 411         for (int i = 1; i < args.Length; i++)
 412           n /= (int) args[i].Eval (domain);
 413         return domain.SetValue (sym, (object) n);
 414       }
 415
 416       private static object percenteq (MExpression[] args, Domain domain)
 417       {
 418         MSymbol sym = (MSymbol) args[0].args[0].val;
 419         int n = (int) domain.GetValue (sym);
 420
 421         for (int i = 1; i < args.Length; i++)
 422           n %= (int) args[i].Eval (domain);
 423         return domain.SetValue (sym, (object) n);
 424       }
 425
 426       private static object logioreq (MExpression[] args, Domain domain)
 427       {
 428         MSymbol sym = (MSymbol) args[0].args[0].val;
 429         int n = (int) domain.GetValue (sym);
 430
 431         for (int i = 1; i < args.Length; i++)
 432           n |= (int) args[i].Eval (domain);
 433         return domain.SetValue (sym, (object) n);
 434       }
 435
 436       private static object logandeq (MExpression[] args, Domain domain)
 437       {
 438         MSymbol sym = (MSymbol) args[0].args[0].val;
 439         int n = (int) domain.GetValue (sym);
 440
 441         for (int i = 1; i < args.Length; i++)
 442           n &= (int) args[i].Eval (domain);
 443         return domain.SetValue (sym, (object) n);
 444       }
 445
 446       private static object lshift (MExpression[] args, Domain domain)
 447       {
 448         return (int) args[0].val << (int) args[1].val;
 449       }
 450
 451       private static object lshifteq (MExpression[] args, Domain domain)
 452       {
 453         MSymbol sym = (MSymbol) args[0].args[0].val;
 454         int n = (int) domain.GetValue (sym);
 455
 456         n <<= (int) args[1].Eval (domain);
 457         return domain.SetValue (sym, (object) n);
 458       }
 459
 460       private static object rshift (MExpression[] args, Domain domain)
 461       {
 462         return (int) args[0].val >> (int) args[1].val;
 463       }
 464
 465       private static object rshifteq (MExpression[] args, Domain domain)
 466       {
 467         MSymbol sym = (MSymbol) args[0].args[0].val;
 468         int n = (int) domain.GetValue (sym);
 469
 470         n >>= (int) args[1].Eval (domain);
 471         return domain.SetValue (sym, (object) n);
 472       }
 473
 474       private static object eq (MExpression[] args, Domain domain)
 475       {
 476         int n = (int) args[0].val;
 477
 478         for (int i = 1; i < args.Length; i++)
 479           if (n != (int) args[i].val)
 480             return false;
 481         return true;
 482       }
 483
 484       private static object noteq (MExpression[] args, Domain domain)
 485       {
 486         return ((int) args[0].val != (int) args[1].val);
 487       }
 488
 489       private static object less (MExpression[] args, Domain domain)
 490       {
 491         int n = (int) args[0].val;
 492
 493         for (int i = 1; i < args.Length; i++)
 494           {
 495             int n1 = (int) args[i].val;
 496             if (n >= n1)
 497               return false;
 498             n = n1;
 499           }
 500         return true;
 501       }
 502
 503       private static object lesseq (MExpression[] args, Domain domain)
 504       {
 505         int n = (int) args[0].val;
 506         for (int i = 1; i < args.Length; i++)
 507           {
 508             int n1 = (int) args[i].val;
 509             if (n > n1)
 510               return false;
 511             n = n1;
 512           }
 513         return true;
 514       }
 515
 516       private static object more (MExpression[] args, Domain domain)
 517       {
 518         int n = (int) args[0].val;
 519         for (int i = 1; i < args.Length; i++)
 520           {
 521             int n1 = (int) args[i].val;
 522             if (n <= n1)
 523               return false;
 524             n = n1;
 525           }
 526         return true;
 527       }
 528
 529       private static object moreeq (MExpression[] args, Domain domain)
 530       {
 531         int n = (int) args[0].val;
 532         for (int i = 1; i < args.Length; i++)
 533           {
 534             int n1 = (int) args[i].val;
 535             if (n < n1)
 536               return false;
 537             n = n1;
 538           }
 539         return true;
 540       }
 541
 542       private static object progn (MExpression[] args, Domain domain)
 543       {
 544         object result = false;
 545
 546         foreach (MExpression e in args)
 547           result = e.Eval (domain);
 548         return result;
 549       }
 550
 551       private static bool check_condition (MExpression condition, Domain domain)
 552       {
 553         object result = condition.Eval (domain);
 554         return (result is bool ? (bool) result
 555                 : result is int ? ((int) result) != 0
 556                 : true);
 557       }
 558
 559       private static object ifclause (MExpression[] args, Domain domain)
 560       {
 561         object result = false;
 562
 563         if (check_condition (args[0], domain))
 564           result = args[1].Eval (domain);
 565         else
 566           for (int i = 2; i < args.Length; i++)
 567             result = args[i].Eval (domain);
 568         return result;
 569       }
 570
 571       private static object whenclause (MExpression[] args, Domain domain)
 572       {
 573         object result = false;
 574
 575         if (check_condition (args[0], domain))
 576           for (int i = 1; i < args.Length; i++)
 577             result = args[i].Eval (domain);
 578         return result;
 579       }
 580
 581       private static object whileclause (MExpression[] args, Domain domain)
 582       {
 583         while (check_condition (args[0], domain))
 584           for (int i = 1; i < args.Length; i++)
 585             args[i].Eval (domain);
 586         return false;
 587       }
 588
 589     // (cond (COND1 ...) (COND2 ...) ...)
 590     //   => (progn (when COND1 ...) (when COND2 ...) ...)
 591     private static void translate_cond (MPlist plist, Domain domain)
 592     {
 593       if (plist.IsPlist)
 594         {
 595           plist = plist.Plist;
 596           if (plist.IsSymbol && plist.Symbol == Mcond)
 597             {
 598               plist.val = Mprogn;
 599               for (plist = plist.next; ! plist.IsEmpty; plist = plist.next)
 600                 {
 601                   if (! plist.IsPlist)
 602                     throw new Exception ("Invalid cond form: " + plist);
 603                   plist.Plist.Push (MSymbol.symbol, Mwhen);
 604                 }
 605             }
 606         }
 607     }
 608
 609     private Function function;
 610     private MExpression[] args;
 611     private object val;
 612
 613     public MExpression[] Args { get { return args; } }
 614     public object Val { get { return val; } }
 615
 616     private MExpression (object val)
 617     {
 618       this.val = val;
 619     }
 620
 621     // EXPR = SYMBOL | MTEXT | INTEGER | FUNCALL | PROGN
 622     // FUNCALL = '(' SYMBOL EXPR* ')'
 623     // PROGN = '(' EXPR * ')'
 624     private MExpression (MSymbol key, object val, Domain domain)
 625     {
 626       if (key == MSymbol.symbol)
 627         {
 628           function = Function.varref;
 629           args = new MExpression[1];
 630           args[0] = new MExpression (val);
 631         }
 632       else if (key == MSymbol.integer
 633                || key == MSymbol.mtext)
 634         {
 635           this.val = val;
 636         }
 637       else if (key == MSymbol.plist)
 638         {
 639           MPlist p = (MPlist) val;
 640
 641           if (p.IsSymbol)
 642             {
 643               MSymbol sym = p.Symbol;
 644
 645               if (sym == Mdefun)
 646                 {
 647                   p = p.next;
 648                   if (! p.IsSymbol)
 649                     throw new Exception ("Invalid function argument: "
 650                                          + p.val);
 651                   sym = p.Symbol;
 652                   p = p.next;
 653                   if (! p.IsPlist)
 654                     throw new Exception ("Invalid function argument: "
 655                                          + p.val);
 656                   domain.Defun (sym, p.Plist, p.next);
 657                   // This Mexpression is just a dummy.
 658                 }
 659               else
 660                 {
 661                   function = domain.GetFunc (sym);
 662                   p = p.next;
 663                   int nargs = p.Count;
 664                   if (nargs < function.min_arg
 665                       || (function.max_arg >= 0 && nargs > function.max_arg))
 666                     throw new Exception ("Invalid number of arguments to: "
 667                                          + sym + " " + nargs);
 668                   args = new MExpression[nargs];
 669                   for (int i = 0; i < nargs; i++, p = p.next)
 670                     {
 671                       domain.Translate (p);
 672                       args[i] = new MExpression (p.key, p.val, domain);
 673                     }
 674                 }
 675             }
 676           else
 677             {
 678               args = new MExpression[1];
 679               args[0] = new MExpression (p, domain);
 680             }
 681         }
 682       else
 683         throw new Exception ("Invalid expression: " + key + ":" + val);
 684     }
 685
 686     public MExpression (MPlist plist, Domain domain)
 687     {
 688       function = Function.block;
 689       args = new MExpression[plist.Count];
 690       for (int i = 0; ! plist.IsEmpty; i++, plist = plist.next)
 691         {
 692           domain.Translate (plist);
 693           args[i] = new MExpression (plist.key, plist.val, domain);
 694         }
 695     }
 696
 697     public object Eval (Domain domain)
 698     {
 699       if (function == null)
 700         {
 701           if (val is MSymbol)
 702             val = domain.GetValue ((MSymbol) val);
 703         }
 704       else
 705         val = function.Call (args, domain);
 706       return val;
 707     }
 708
 709     public override string ToString ()
 710     {
 711       string str;
 712
 713       if (function != null)
 714         {
 715           str = "(" + function.Name.Name;
 716           if (args != null)
 717             foreach (MExpression e in args)
 718               str += " " + e.ToString ();
 719           str += ")";
 720         }
 721       else if (val != null)
 722         str = val.ToString ();
 723       else
 724         str = "()";
 725       return str;
 726     }
 727   }
 728 }