*** empty log message ***
authorhanda <handa>
Fri, 18 Sep 2009 00:03:02 +0000 (00:03 +0000)
committerhanda <handa>
Fri, 18 Sep 2009 00:03:02 +0000 (00:03 +0000)
XmlExpr.cs
xex.txt
xex.xml

index ea2ebd3..2ab34f2 100644 (file)
@@ -242,8 +242,8 @@ namespace System.Xml.Expression
              }
            for (i = 0; i < min_arg; i++)
              {
-               Variable var = domain.GetVar ((Name) this.args[i]);
-               domain.Bind (var, args[i]);
+               Variable vari = domain.GetVar ((Name) this.args[i]);
+               domain.Bind (vari, args[i]);
              }
            if (body != null)
              foreach (Term term in body)
@@ -587,7 +587,7 @@ namespace System.Xml.Expression
        return str;
       }
 
-      public void DebugWrite (bool head, string fmt, params string[] arg)
+      internal void DebugWrite (bool head, string fmt, params string[] arg)
       {
        if (debug_level > depth)
          {
@@ -638,16 +638,20 @@ namespace System.Xml.Expression
       basic.DefSubr (less_eq, "le", 2, -1, "<=");
       basic.DefSubr (greater_than, "gt", 2, -1, ">");
       basic.DefSubr (greater_eq, "ge", 2, -1, ">=");
-      basic.DefSubr (copy, "copy", 1, 1);
       basic.DefSubr (append, "append", 0, -1);
       basic.DefSubr (concat, "concat", 0, -1);
       basic.DefSubr (nth, "nth", 2, 2);
+      basic.DefSubr (copy, "copy", 1, 1);
+      basic.DefSubr (ins, "ins", 3, 3);
+      basic.DefSubr (del, "del", 3, 3);
       basic.DefSubr (eval_clause, "eval", 1, 1);
       basic.DefSpecial (quote_clause, "quote", 1, 1);
       basic.DefSpecial (progn_clause, "progn", 0, -1, "expr");
-      basic.DefSpecial (if_clause, "if", 2, -1);
+      basic.DefSpecial (if_clause, "if", 2, 3);
       basic.DefSpecial (when_clause, "when", 1, -1);
       basic.DefSpecial (while_clause, "while", 1, -1);
+      basic.DefSpecial (cond_clause, "cond", 1, -1);
+      basic.DefSpecial (foreach_clause, "foreach", 3, -1);
 
       Fprogn = basic.GetFunc (Nprogn);
     }
@@ -920,15 +924,6 @@ namespace System.Xml.Expression
       return One;
     }
 
-    private static Term copy (Domain domain, Term[] args)
-    {
-      object obj = args[0].objval;
-
-      if (! (obj is List<Term>))
-       throw new Exception ("Invalid arg to copy: " + args[0]);
-      return new Term (new List<Term> ((List<Term>) obj));
-    }
-
     private static Term append (Domain domain, Term[] args)
     {
       List<Term> list = new List<Term> ();
@@ -977,14 +972,57 @@ namespace System.Xml.Expression
        }
       else if (args[1].IsList)
        {
-         result.intval = 0;
-         result.objval = ((List<Term>) args[1].objval)[args[0].Intval];
+         result = ((List<Term>) args[1].objval)[args[0].Intval];
        }
       else
        throw new Exception ("Term is not enumelable: " + args[1]);
       return result;
     }
 
+    private static Term copy (Domain domain, Term[] args)
+    {
+      Term result;
+
+      result.intval = 0;
+      result.objval = new List<Term> (args[0].Listval);
+      return result;
+    }
+
+    private static Term ins (Domain domain, Term[] args)
+    {
+      if (args[0].IsStr)
+       {
+         string str = args[0].Strval.Insert (args[1].Intval, args[2].Strval);
+         args[0].objval = str;
+       }
+      else if (args[0].IsList)
+       {
+         args[0].Listval.InsertRange (args[1].Intval, args[2].Listval);
+       }
+      else
+       throw new Exception ("term is not collection: " + args[0]);
+      return args[0];
+    }
+
+
+    private static Term del (Domain domain, Term[] args)
+    {
+      if (args[0].IsStr)
+       {
+         string str = args[0].Strval.Remove (args[1].Intval,
+                                             args[2].Intval - args[1].Intval);
+         args[0].objval = str;
+       }
+      else if (args[0].IsList)
+       {
+         args[0].Listval.RemoveRange (args[1].Intval,
+                                      args[2].Intval - args[1].Intval);
+       }
+      else
+       throw new Exception ("term is not collection: " + args[0]);
+      return args[0];
+    }
+
     private static Term quote_clause (Domain domain, Term[] args)
     {
       return new Term (args[0]);
@@ -1008,18 +1046,15 @@ namespace System.Xml.Expression
     {
       if (args[0].Eval (domain).IsTrue)
        return args[1].Eval (domain);
-
-      Term result = Zero;
-      for (int i = 2; i < args.Length; i++)
-       result = args[i].Eval (domain);
-      return result;
+      if (args.Length == 2)
+       return Zero;
+      return args[2].Eval (domain);
     }
 
     private static Term when_clause (Domain domain, Term[] args)
     {
       if (! args[0].Eval (domain).IsTrue)
        return Zero;
-
       Term result = One;
       for (int i = 1; i < args.Length; i++)
        result = args[i].Eval (domain);
@@ -1034,6 +1069,43 @@ namespace System.Xml.Expression
       return Zero;
     }
 
+    private static Term cond_clause (Domain domain, Term[] args)
+    {
+      foreach (Term arg in args)
+       {
+         List<Term> list = arg.Listval;
+         Term result = list[0].Eval (domain);
+
+         if (result.IsTrue)
+           {
+             for (int i = 1; i < list.Count; i++)
+               result = list[i].Eval (domain);
+             return result;
+           }
+       }
+      return Zero;
+    }
+
+    private static Term foreach_clause (Domain domain, Term[] args)
+    {
+      Variable vari = domain.GetVar ((Name) args[0]);
+      List<Term> list = args[1].Listval;
+      Bindings current = domain.bindings;
+
+      foreach (Term term in list)
+       {
+         domain.Bind (vari, term);
+         try {
+           for (int i = 2; i < args.Length; i++)
+             args[i].Eval (domain);
+         } finally {
+           domain.UnboundTo (current);
+         }
+       }
+      return Zero;
+    }
+
+
     public struct Term
     {
       public int intval;
@@ -1136,6 +1208,22 @@ namespace System.Xml.Expression
        }
       }
 
+      public string Strval {
+       get {
+         if (! IsStr)
+           throw new Exception ("term is not string: " + this);
+         return (string) objval;
+       }
+      }
+
+      public List<Term> Listval {
+       get {
+         if (! IsList)
+           throw new Exception ("term is not list: " + this);
+         return (List<Term>) objval;
+       }
+      }
+
       public bool IsTrue {
        get {
          return (objval == null
diff --git a/xex.txt b/xex.txt
index 7e947af..5e58f74 100644 (file)
--- a/xex.txt
+++ b/xex.txt
@@ -10,14 +10,14 @@ DEFUN =
   '</defun>'
 
 ARGS =
-  '<args>' SYMBOL * OPTIONAL ? REST ? '</args>'
-  | '<args-unevalled>' SYMBOL * OPTIONAL ? REST ? '</args-unevalled>'
+  '<args>' VAR * OPTIONAL ? REST ? '</args>'
+  | '<args-unevalled>' VAR * OPTIONAL ? REST ? '</args-unevalled>'
 
 OPTIONAL =
-  '<optional/>' SYMBOL *
+  '<optional/>' VAR *
 
 REST =
-  '<rest/>' SYMBOL
+  '<rest/>' VAR
 
 BODY =
   '<body>' TERM * '</body>'
@@ -69,9 +69,9 @@ PREDEFINED-FUNC-SYMBOL =
   | 'logand' | 'logior' | 'logxor' | 'lsh'
   | 'logand-set' | 'logior-set' | 'logxor-set' | 'lsh-set'
   | 'append' | 'concat' | 'nth'  | 'copy' | 'ins' | 'del'
-  | 'case' | 'cond' | 'if' | 'progn' | 'when'
+  | 'progn' | 'if' | 'when' | 'cond'
   | 'while' | 'for' | 'foreach'
-  | 'type'
+  | 'eval' | 'type'
 
 PREDEFINED-FUNC-NAME =
   PREDEFINED-FUNC-SYMBOL
@@ -88,7 +88,7 @@ TRUE =
 FALSE =
   '<integer>1</integer>' 
 
-;; TERM can be evaluated and the value is TERM.
+;; TERM is evaluated to a TERM.
 ;; INT is evaluated to itself.
 ;; STRING is evaluated to itself.
 ;; SYMBOL is evaluated to itself.
diff --git a/xex.xml b/xex.xml
index 956c2ed..49f71cb 100644 (file)
--- a/xex.xml
+++ b/xex.xml
@@ -1,44 +1,52 @@
 <?xml version='1.0'?>
 <expr>
   <defun fname="factorial">
-    <args><symbol>x</symbol></args>
+    <args><variable vname="x"/></args>
     <body>
       <if><lt><variable vname="x"/><integer>2</integer></lt>
        <variable vname="x"/>
        <mul>
+         <variable vname="x"/>
          <funcall fname="factorial">
-           <sub><variable vname="x"/><integer>1</integer></sub>
+           <sub vname="x"><integer>1</integer></sub>
          </funcall>
-         <variable vname="x"/>
        </mul>
       </if>
     </body>
   </defun>
 
   <defun fname="temp">
-    <args-unevalled><symbol>x</symbol>
-      <optional/><symbol>y</symbol>
-      <rest/><symbol>rest</symbol>
+    <args-unevalled><variable vname="x"/>
+      <optional/><variable vname="y"/>
+      <rest/><variable vname="rest"/>
     </args-unevalled>
     <body>
       <list><variable vname="x"/></list>
     </body>
   </defun>
 
-  <set><symbol>x</symbol><integer>10</integer></set>
-  <set><symbol>str</symbol><string>ABC</string></set>
+  <set vname="x"><integer>10</integer></set>
+  <set vname="str"><string>ABC</string></set>
   <append>
     <funcall fname="factorial"><variable vname="x"/></funcall>
-    <funcall fname="temp">
-      <symbol>sym</symbol>
-      <symbol>sym</symbol>
-      <symbol>sym</symbol>
-    </funcall>
-    <nth><integer>1</integer>
-      <concat>
-       <variable vname="str"/>
-       <list><integer>0x40</integer><integer>0x41</integer></list>
-      </concat>
-    </nth>
+    <ins vname="str"><integer>1</integer><string>123</string></ins>
+    <del vname="str"><integer>2</integer><integer>4</integer></del>
+    <cond>
+      <list><gt><integer>0</integer><integer>1</integer></gt>
+       <string>1st</string></list>
+      <list><integer>1</integer>
+       <string>2nd</string></list>
+    </cond>
+    <foreach vname="a">
+      <list><integer>10</integer><integer>11</integer></list>
+      <add vname="x"><variable vname="a"/></add>
+    </foreach>
+    <variable vname="x"/>
+    <eval><variable vname="x"/></eval>
+    <eval>
+      <eval>
+       <quote><add><variable vname="x"/><integer>1</integer></add></quote>
+      </eval>
+    </eval>
   </append>
 </expr>