2 using System.Collections;
3 using System.Collections.Generic;
12 public class MExpression
14 private static MSymbol Mvarref = "symbol-value";
15 private static MSymbol Mdefun = "defun";
16 private static MSymbol Mcond = "cond";
17 private static MSymbol Mprogn = "progn";
18 private static MSymbol Mwhen = "when";
22 private Domain parent;
23 internal MPlist functions = new MPlist ();
24 internal MPlist bindings = new MPlist ();
25 private Stack<MPlist> boundaries = new Stack<MPlist> ();
26 internal Translator translator;
27 public object context;
31 boundaries.Push (bindings);
34 public Domain (object context) : this (basic, context) { }
36 public Domain (Domain parent, object context)
39 this.context = context;
40 boundaries.Push (bindings);
43 public void AddTranslator (Translator translator)
45 if (this.translator == null)
46 this.translator = translator;
48 this.translator += translator;
51 public void Bind (MSymbol sym, object value)
53 bindings = bindings.Cons (sym, value);
56 public MPlist SetBoundary ()
58 boundaries.Push (bindings);
62 public void UnboundTo (MPlist boundary)
64 while (boundary != boundaries.Pop ());
65 while (bindings != boundary)
66 bindings = bindings.next;
69 public void Defun (string name, Builtin builtin, int min_arg, int max_arg)
71 Defun (name, builtin, min_arg, max_arg, false);
74 public void Defun (string name, Builtin builtin, int min_arg, int max_arg,
78 Function func = (Function) functions.Get (sym);
82 if (func.min_arg < min_arg || func.max_arg > max_arg)
83 throw new Exception ("Incompatible argument numbers to override: "
85 func.builtin = builtin;
87 func.min_arg = min_arg;
88 func.max_arg = max_arg;
89 func.specialp = specialp;
93 func = new Function (sym, builtin, min_arg, max_arg, specialp);
94 functions = functions.Cons (sym, func);
98 public void Defun (MSymbol sym, MPlist args, MPlist body)
100 Function func = (Function) functions.Get (sym);
104 int nargs = args == null ? 0 : args.Count;
106 if (func.min_arg < nargs || func.max_arg > nargs)
107 throw new Exception ("Incompatible argument numbers to override: "
109 func.lambda.SetArgs (args);
110 func.lambda.SetBody (body, this);
115 func = new Function (sym, args, body, this);
116 functions = functions.Cons (sym, func);
120 public void Defun (XmlNode node)
122 MSymbol sym = node.Attributes["id"].Value;
123 Function func = (Function) functions.Get (sym);
127 XmlNode args = node.FirstChild;
128 int nargs = args.Name == "args" ? args.ChildNodes.Count : 0;
130 if (func.min_arg < nargs || func.max_arg > nargs)
131 throw new Exception ("Incompatible argument numbers to override: "
133 func.lambda.Set (node, this);
138 func = new Function (sym, node, this);
139 functions = functions.Cons (sym, func);
143 internal Function GetFunc (MSymbol name)
145 Function func = (Function) functions.Get (name);
150 return parent.GetFunc (name);
151 throw new Exception ("Unknown function: " + name);
156 public bool CopyFunc (Domain domain, MSymbol name)
158 Function func = (Function) functions.Get (name);
161 domain.functions = domain.functions.Cons (name, func);
165 public void CopyFunc (Domain domain)
167 foreach (MPlist p in functions)
168 domain.functions = domain.functions.Cons (p.key, p.val);
171 public object GetValue (MSymbol name)
173 MPlist slot = bindings.Find (name);
178 return parent.GetValue (name);
179 throw new Exception ("Unbound variable: " + name);
184 public object SetValue (MSymbol name, object val)
186 MPlist boundary = boundaries.Peek ();
188 for (MPlist plist = bindings; plist != boundary; plist = plist.next)
189 if (plist.key == name)
194 bindings = bindings.Cons (name, val);
198 public bool IsBound (MSymbol name)
200 return (bindings.Find (name) != null);
203 public void Translate (MPlist plist)
206 parent.Translate (plist);
207 if (translator != null)
208 for (MPlist p = plist; ! p.IsEmpty; p = p.next)
209 translator (p, this);
212 public override string ToString ()
214 string str = "<(functions";
215 foreach (MPlist p in functions)
217 str += ") (bindings " + bindings + ")";
219 str += " (" + context + ")";
225 public delegate object Builtin (MExpression[] args, Domain domain);
226 public delegate void Translator (MPlist plist, Domain domain);
228 internal class Function
230 internal class Lambda
232 internal MSymbol[] args;
233 internal MExpression[] body;
235 public Lambda (MPlist args, MPlist body, Domain domain)
238 SetBody (body, domain);
241 public Lambda (XmlNode node, Domain domain)
246 public void SetArgs (MPlist args)
248 int len = args == null ? 0 : args.Count;
250 if (this.args == null)
251 this.args = new MSymbol[len];
252 for (int i = 0; i < len; i++, args = args.next)
253 this.args[i] = args.Symbol;
256 public void SetBody (MPlist body, Domain domain)
258 int len = body == null ? 0 : body.Count;
259 if (this.body == null)
260 this.body = new MExpression[len];
261 for (int i = 0; i < len; i++, body = body.next)
263 domain.Translate (body);
264 this.body[i] = new MExpression (body.key, body.val, domain);
268 public void Set (XmlNode node, Domain domain)
270 XmlNodeList body = node.ChildNodes;
273 if (body[0].Name == "args")
275 XmlNodeList args = body[0].ChildNodes;
276 if (this.args == null)
277 this.args = new MSymbol[args.Count];
278 for (int i = 0; i < args.Count; i++)
279 this.args[i] = args[i].InnerText;
282 else if (this.args == null)
283 this.args = new MSymbol[0];
284 if (this.body == null)
285 this.body = new MExpression[body.Count - idx];
286 for (int i = 0; idx < body.Count; i++, idx++)
287 this.body[i] = new MExpression (body[idx], domain);
291 public readonly MSymbol Name;
292 public Builtin builtin;
293 public int min_arg, max_arg;
294 internal Lambda lambda;
295 public bool specialp = false;
297 internal static Function ignore, varref, block;
299 public Function (MSymbol name, Builtin builtin,
300 int min_arg, int max_arg, bool specialp)
303 this.builtin = builtin;
304 this.min_arg = min_arg;
305 this.max_arg = max_arg;
306 this.specialp = specialp;
309 internal Function (MSymbol name, MPlist args, MPlist body,
313 lambda = new Lambda (args, body, domain);
314 this.min_arg = this.max_arg = lambda.args.Length;
317 internal Function (MSymbol name, XmlNode node, Domain domain)
320 lambda = new Lambda (node, domain);
321 this.min_arg = this.max_arg = lambda.args.Length;
331 ignore = new Function ();
332 varref = new Function (Mvarref, get_value, 1, 1, true);
333 block = new Function (Mprogn, progn, 0, -1, true);
336 private static object get_value (MExpression[] args, Domain domain)
338 return domain.GetValue ((MSymbol) args[0].val);
341 public object Call (MExpression[] args, Domain domain)
346 foreach (MExpression e in args)
348 return builtin (args, domain);
352 MPlist orig_bindings = domain.bindings;
353 object result = false;
356 foreach (MSymbol arg in lambda.args)
357 domain.Bind (arg, args[i++].Eval (domain));
358 foreach (MExpression e in lambda.body)
359 result = e.Eval (domain);
361 domain.bindings = orig_bindings;
367 private static Domain basic;
369 static MExpression ()
371 basic = new Domain ();
373 basic.Defun ("set", set_value, 2, 2, true);
374 basic.Defun ("=", set_value, 2, 2, true);
375 basic.Defun ("!", not, 1, 1, false);
376 basic.Defun ("+", plus, 2, -1, false);
377 basic.Defun ("*", multi, 2, -1, false);
378 basic.Defun ("-", minus, 1, -1, false);
379 basic.Defun ("/", divide, 2, -1, false);
380 basic.Defun ("%", percent, 2, -1, false);
381 basic.Defun ("|", logior, 2, -1, false);
382 basic.Defun ("&", logand, 2, -1, false);
383 basic.Defun ("+=", pluseq, 2, -1, true);
384 basic.Defun ("*=", multieq, 2, -1, true);
385 basic.Defun ("-=", minuseq, 2, -1, true);
386 basic.Defun ("/=", divideeq, 2, -1, true);
387 basic.Defun ("%=", percenteq, 2, -1, true);
388 basic.Defun ("|=", logioreq, 2, -1, true);
389 basic.Defun ("&=", logandeq, 2, -1, true);
390 basic.Defun ("<<", lshift, 2, 2, false);
391 basic.Defun (">>", rshift, 2, 2, false);
392 basic.Defun ("<<=", lshifteq, 2, 2, true);
393 basic.Defun (">>=", rshifteq, 2, 2, true);
394 basic.Defun ("==", eq, 2, -1, false);
395 basic.Defun ("!=", noteq, 2, 2, false);
396 basic.Defun ("<", less, 2, -1, false);
397 basic.Defun ("<=", lesseq, 2, -1, false);
398 basic.Defun (">", more, 2, -1, false);
399 basic.Defun (">=", moreeq, 2, -1, false);
400 basic.Defun ("progn", progn, 0, -1, true);
401 basic.Defun ("if", ifclause, 2, -1, true);
402 basic.Defun ("when", whenclause, 1, -1, true);
403 basic.Defun ("while", whileclause, 1, -1, true);
405 basic.AddTranslator (new Translator (translate_cond));
408 private static object set_value (MExpression[] args, Domain domain)
410 return domain.SetValue ((MSymbol) args[0].args[0].val,
411 args[1].Eval (domain));
414 private static object not (MExpression[] args, Domain domain)
416 if (args[0].val is int)
417 return (int) args[0].val == 0;
418 if (args[0].val is bool)
419 return ! ((bool) args[0].val);
423 private static object plus (MExpression[] args, Domain domain)
425 if (args[0].val is int)
428 foreach (MExpression e in args)
432 else if (args[0].val is MText)
434 MText mt = new MText ();
435 foreach (MExpression e in args)
439 throw new Exception ("Not an integer nor MText: " + args[0].val);
442 private static object multi (MExpression[] args, Domain domain)
445 foreach (MExpression e in args)
450 private static object minus (MExpression[] args, Domain domain)
452 int n = (int) args[0].val;
453 if (args.Length == 1)
455 for (int i = 1; i < args.Length; i++)
456 n -= (int) args[i].val;
460 private static object divide (MExpression[] args, Domain domain)
462 int n = (int) args[0].val;
463 for (int i = 1; i < args.Length; i++)
464 n /= (int) args[i].val;
468 private static object percent (MExpression[] args, Domain domain)
470 int n = (int) args[0].val;
471 for (int i = 1; i < args.Length; i++)
472 n %= (int) args[i].val;
476 private static object logior (MExpression[] args, Domain domain)
479 foreach (MExpression e in args)
484 private static object logand (MExpression[] args, Domain domain)
487 foreach (MExpression e in args)
492 private static object pluseq (MExpression[] args, Domain domain)
494 MSymbol sym = (MSymbol) args[0].args[0].val;
495 object val = domain.GetValue (sym);
500 for (int i = 1; i < args.Length; i++)
501 n += (int) args[i].Eval (domain);
504 else if (val is MText)
506 MText mt = (MText) val;
507 for (int i = 1; i < args.Length; i++)
508 mt.Cat ((MText) args[i].Eval (domain));
511 domain.SetValue (sym, val);
515 private static object multieq (MExpression[] args, Domain domain)
517 MSymbol sym = (MSymbol) args[0].args[0].val;
518 int n = (int) domain.GetValue (sym);
520 for (int i = 1; i < args.Length; i++)
521 n *= (int) args[i].Eval (domain);
522 return domain.SetValue (sym, (object) n);
525 private static object minuseq (MExpression[] args, Domain domain)
527 MSymbol sym = (MSymbol) args[0].args[0].val;
528 int n = (int) domain.GetValue (sym);
530 for (int i = 1; i < args.Length; i++)
531 n -= (int) args[i].Eval (domain);
532 return domain.SetValue (sym, (object) n);
535 private static object divideeq (MExpression[] args, Domain domain)
537 MSymbol sym = (MSymbol) args[0].args[0].val;
538 int n = (int) domain.GetValue (sym);
540 for (int i = 1; i < args.Length; i++)
541 n /= (int) args[i].Eval (domain);
542 return domain.SetValue (sym, (object) n);
545 private static object percenteq (MExpression[] args, Domain domain)
547 MSymbol sym = (MSymbol) args[0].args[0].val;
548 int n = (int) domain.GetValue (sym);
550 for (int i = 1; i < args.Length; i++)
551 n %= (int) args[i].Eval (domain);
552 return domain.SetValue (sym, (object) n);
555 private static object logioreq (MExpression[] args, Domain domain)
557 MSymbol sym = (MSymbol) args[0].args[0].val;
558 int n = (int) domain.GetValue (sym);
560 for (int i = 1; i < args.Length; i++)
561 n |= (int) args[i].Eval (domain);
562 return domain.SetValue (sym, (object) n);
565 private static object logandeq (MExpression[] args, Domain domain)
567 MSymbol sym = (MSymbol) args[0].args[0].val;
568 int n = (int) domain.GetValue (sym);
570 for (int i = 1; i < args.Length; i++)
571 n &= (int) args[i].Eval (domain);
572 return domain.SetValue (sym, (object) n);
575 private static object lshift (MExpression[] args, Domain domain)
577 return (int) args[0].val << (int) args[1].val;
580 private static object lshifteq (MExpression[] args, Domain domain)
582 MSymbol sym = (MSymbol) args[0].args[0].val;
583 int n = (int) domain.GetValue (sym);
585 n <<= (int) args[1].Eval (domain);
586 return domain.SetValue (sym, (object) n);
589 private static object rshift (MExpression[] args, Domain domain)
591 return (int) args[0].val >> (int) args[1].val;
594 private static object rshifteq (MExpression[] args, Domain domain)
596 MSymbol sym = (MSymbol) args[0].args[0].val;
597 int n = (int) domain.GetValue (sym);
599 n >>= (int) args[1].Eval (domain);
600 return domain.SetValue (sym, (object) n);
603 private static object eq (MExpression[] args, Domain domain)
605 int n = (int) args[0].val;
607 for (int i = 1; i < args.Length; i++)
608 if (n != (int) args[i].val)
613 private static object noteq (MExpression[] args, Domain domain)
615 return ((int) args[0].val != (int) args[1].val);
618 private static object less (MExpression[] args, Domain domain)
620 int n = (int) args[0].val;
622 for (int i = 1; i < args.Length; i++)
624 int n1 = (int) args[i].val;
632 private static object lesseq (MExpression[] args, Domain domain)
634 int n = (int) args[0].val;
635 for (int i = 1; i < args.Length; i++)
637 int n1 = (int) args[i].val;
645 private static object more (MExpression[] args, Domain domain)
647 int n = (int) args[0].val;
648 for (int i = 1; i < args.Length; i++)
650 int n1 = (int) args[i].val;
658 private static object moreeq (MExpression[] args, Domain domain)
660 int n = (int) args[0].val;
661 for (int i = 1; i < args.Length; i++)
663 int n1 = (int) args[i].val;
671 private static object progn (MExpression[] args, Domain domain)
673 object result = false;
675 foreach (MExpression e in args)
676 result = e.Eval (domain);
680 private static bool check_condition (MExpression condition, Domain domain)
682 object result = condition.Eval (domain);
683 return (result is bool ? (bool) result
684 : result is int ? ((int) result) != 0
688 private static object ifclause (MExpression[] args, Domain domain)
690 object result = false;
692 if (check_condition (args[0], domain))
693 result = args[1].Eval (domain);
695 for (int i = 2; i < args.Length; i++)
696 result = args[i].Eval (domain);
700 private static object whenclause (MExpression[] args, Domain domain)
702 object result = false;
704 if (check_condition (args[0], domain))
705 for (int i = 1; i < args.Length; i++)
706 result = args[i].Eval (domain);
710 private static object whileclause (MExpression[] args, Domain domain)
712 while (check_condition (args[0], domain))
713 for (int i = 1; i < args.Length; i++)
714 args[i].Eval (domain);
718 // (cond (COND1 ...) (COND2 ...) ...)
719 // => (cond (when COND1 ...) (when COND2 ...) ...)
720 private static void translate_cond (MPlist plist, Domain domain)
725 if (plist.IsSymbol && plist.Symbol == Mcond)
728 for (plist = plist.next; ! plist.IsEmpty; plist = plist.next)
731 throw new Exception ("Invalid cond form: " + plist);
732 plist.Plist.Push (MSymbol.symbol, Mwhen);
738 private Function function;
739 private MExpression[] args;
742 public MExpression[] Args { get { return args; } }
743 public object Val { get { return val; } }
745 private MExpression (object val)
750 // EXPR = SYMBOL | MTEXT | INTEGER | FUNCALL | PROGN
751 // FUNCALL = '(' SYMBOL EXPR* ')'
752 // PROGN = '(' EXPR * ')'
753 private MExpression (MSymbol key, object val, Domain domain)
755 if (key == MSymbol.symbol)
757 function = Function.varref;
758 args = new MExpression[1];
759 args[0] = new MExpression (val);
761 else if (key == MSymbol.integer
762 || key == MSymbol.mtext)
766 else if (key == MSymbol.plist)
768 MPlist p = (MPlist) val;
772 MSymbol sym = p.Symbol;
778 throw new Exception ("Invalid function argument: "
783 throw new Exception ("Invalid function argument: "
785 domain.Defun (sym, p.Plist, p.next);
786 // This Mexpression is just a dummy.
790 function = domain.GetFunc (sym);
793 if (nargs < function.min_arg
794 || (function.max_arg >= 0 && nargs > function.max_arg))
795 throw new Exception ("Invalid number of arguments to: "
796 + sym + " " + nargs);
797 args = new MExpression[nargs];
798 for (int i = 0; i < nargs; i++, p = p.next)
800 domain.Translate (p);
801 args[i] = new MExpression (p.key, p.val, domain);
807 args = new MExpression[1];
808 args[0] = new MExpression (p, domain);
812 throw new Exception ("Invalid expression: " + key + ":" + val);
815 public MExpression (MPlist plist, Domain domain)
817 function = Function.block;
818 args = new MExpression[plist.Count];
819 for (int i = 0; ! plist.IsEmpty; i++, plist = plist.next)
821 domain.Translate (plist);
822 args[i] = new MExpression (plist.key, plist.val, domain);
826 public MExpression (XmlNode node, Domain domain)
828 MSymbol sym = node.Name;
830 function = domain.GetFunc (sym);
832 XmlAttributeCollection attrs = node.Attributes;
834 int nargs = attrs.Count + node.ChildNodes.Count;
835 if (nargs < function.min_arg
836 || (function.max_arg >= 0 && nargs > function.max_arg))
837 throw new Exception ("Invalid number of arguments: " + node.InnerXml);
838 args = new MExpression[nargs];
840 for (i = 0; i < attrs.Count; i++)
842 string str = sttrs[i].Value;
847 public object Eval (Domain domain)
849 if (function == null)
852 val = domain.GetValue ((MSymbol) val);
855 val = function.Call (args, domain);
859 public override string ToString ()
863 if (function != null)
865 str = "(" + function.Name.Name;
867 foreach (MExpression e in args)
868 str += " " + e.ToString ();
871 else if (val != null)
874 str = "\"" + (string) ((MText) val) + "\"";
876 str = val.ToString ();