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