X-Git-Url: http://git.indexdata.com/?a=blobdiff_plain;f=fml%2Ffml.c;h=b08aa4ddf98e11b41d0c95e2434cfbcc0f3399b8;hb=e1ec9d39463f431383547891f38e30f2ff17842c;hp=9a2c6ca939d8ca0597f4af8e77164943120f1388;hpb=332f815feae8b1614c42b0a436f2ab0276d817d8;p=egate.git

diff --git a/fml/fml.c b/fml/fml.c
index 9a2c6ca..b08aa4d 100644
--- a/fml/fml.c
+++ b/fml/fml.c
@@ -1,8 +1,92 @@
 /*
+ * Copyright (c) 1995, the EUROPAGATE consortium (see below).
+ *
+ * The EUROPAGATE consortium members are:
+ *
+ *    University College Dublin
+ *    Danmarks Teknologiske Videnscenter
+ *    An Chomhairle Leabharlanna
+ *    Consejo Superior de Investigaciones Cientificas
+ *
+ * Permission to use, copy, modify, distribute, and sell this software and
+ * its documentation, in whole or in part, for any purpose, is hereby granted,
+ * provided that:
+ *
+ * 1. This copyright and permission notice appear in all copies of the
+ * software and its documentation. Notices of copyright or attribution
+ * which appear at the beginning of any file must remain unchanged.
+ *
+ * 2. The names of EUROPAGATE or the project partners may not be used to
+ * endorse or promote products derived from this software without specific
+ * prior written permission.
+ *
+ * 3. Users of this software (implementors and gateway operators) agree to
+ * inform the EUROPAGATE consortium of their use of the software. This
+ * information will be used to evaluate the EUROPAGATE project and the
+ * software, and to plan further developments. The consortium may use
+ * the information in later publications.
+ * 
+ * 4. Users of this software agree to make their best efforts, when
+ * documenting their use of the software, to acknowledge the EUROPAGATE
+ * consortium, and the role played by the software in their work.
+ *
+ * THIS SOFTWARE IS PROVIDED "AS IS" AND WITHOUT WARRANTY OF ANY KIND,
+ * EXPRESS, IMPLIED, OR OTHERWISE, INCLUDING WITHOUT LIMITATION, ANY
+ * WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE.
+ * IN NO EVENT SHALL THE EUROPAGATE CONSORTIUM OR ITS MEMBERS BE LIABLE
+ * FOR ANY SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL DAMAGES OF
+ * ANY KIND, OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA
+ * OR PROFITS, WHETHER OR NOT ADVISED OF THE POSSIBILITY OF DAMAGE, AND
+ * ON ANY THEORY OF LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE
+ * USE OR PERFORMANCE OF THIS SOFTWARE.
+ *
+ */
+/*
  * FML interpreter. Europagate, 1995
  *
  * $Log: fml.c,v $
- * Revision 1.4  1995/02/09 13:07:14  adam
+ * Revision 1.16  1995/05/16 09:39:32  adam
+ * LICENSE.
+ *
+ * Revision 1.15  1995/02/27  09:01:20  adam
+ * Regular expression support. Argument passing by name option. New FML
+ * function strlen.
+ *
+ * Revision 1.14  1995/02/23  08:32:04  adam
+ * Changed header.
+ *
+ * Revision 1.12  1995/02/22  15:20:13  adam
+ * Bug fix in fml_exec_space.
+ *
+ * Revision 1.11  1995/02/22  08:50:49  adam
+ * Definition of CPP changed. Output function can be customized.
+ *
+ * Revision 1.10  1995/02/21  17:46:08  adam
+ * Bug fix in fml_sub0.
+ *
+ * Revision 1.9  1995/02/21  14:00:03  adam
+ * Minor changes.
+ *
+ * Revision 1.8  1995/02/10  18:15:52  adam
+ * FML function 'strcmp' implemented. This function can be used to
+ * test for existence of MARC fields.
+ *
+ * Revision 1.7  1995/02/10  15:50:54  adam
+ * MARC interface implemented. Minor bugs fixed. fmltest can
+ * be used to format single MARC records. New function '\list'
+ * implemented.
+ *
+ * Revision 1.6  1995/02/09  16:06:06  adam
+ * FML can be called from the outside multiple times by the functions:
+ * fml_exec_call and fml_exec_call_str.
+ * An interactive parameter (-i) to fmltest starts a shell-like
+ * interface to FML by using the fml_exec_call_str function.
+ *
+ * Revision 1.5  1995/02/09  14:33:36  adam
+ * Split source fml.c and define relevant build-in functions in separate
+ * files. New operators mult, div, not, llen implemented.
+ *
+ * Revision 1.4  1995/02/09  13:07:14  adam
  * Nodes are freed now. Many bugs fixed.
  *
  * Revision 1.3  1995/02/07  16:09:23  adam
@@ -31,6 +115,11 @@ static int default_read_func (void)
     return getchar ();
 }
 
+static void default_write_func (int c)
+{
+    putchar (c);
+}
+
 static void default_err_handle (int no)
 {
     fprintf (stderr, "Error: %d\n", no);
@@ -41,38 +130,10 @@ static struct fml_node *fml_sub1 (Fml fml, struct fml_node **lp,
                                   struct token *tp);
 static struct fml_node *fml_sub2 (Fml fml, struct fml_node **lp,
                                   struct token *tp);
-
 static struct fml_node *fml_exec_space (Fml fml, struct fml_node **lp, 
                                         struct token *tp);
 static struct fml_node *fml_exec_nl (Fml fml, struct fml_node **lp, 
                                      struct token *tp);
-static struct fml_node *fml_exec_incr (Fml fml, struct fml_node **lp, 
-                                       struct token *tp);
-static struct fml_node *fml_exec_decr (Fml fml, struct fml_node **lp, 
-                                       struct token *tp);
-
-static struct fml_node *fml_exec_plus (Fml fml, struct fml_node *l,
-                                       struct fml_node *r);
-static struct fml_node *fml_exec_minus (Fml fml, struct fml_node *l,
-                                        struct fml_node *r);
-static struct fml_node *fml_exec_gt (Fml fml, struct fml_node *l,
-                                     struct fml_node *r);
-static struct fml_node *fml_exec_lt (Fml fml, struct fml_node *l,
-                                     struct fml_node *r);
-static struct fml_node *fml_exec_eq (Fml fml, struct fml_node *l,
-                                     struct fml_node *r);
-static struct fml_node *fml_exec_ge (Fml fml, struct fml_node *l,
-                                     struct fml_node *r);
-static struct fml_node *fml_exec_le (Fml fml, struct fml_node *l,
-                                     struct fml_node *r);
-static struct fml_node *fml_exec_ne (Fml fml, struct fml_node *l,
-                                     struct fml_node *r);
-static struct fml_node *fml_exec_and (Fml fml, struct fml_node *l,
-                                      struct fml_node *r);
-static struct fml_node *fml_exec_or (Fml fml, struct fml_node *l,
-                                     struct fml_node *r);
-static struct fml_node *fml_exec_indx (Fml fml, struct fml_node *l,
-                                     struct fml_node *r);
                                   
 static int indent = 0;
 
@@ -112,6 +173,7 @@ Fml fml_open (void)
     fml->white_chars = " \t\f\r\n";
     fml->read_func = default_read_func;
     fml->err_handle = default_err_handle;
+    fml->write_func = default_write_func;
 
     fml->list = NULL;
     fml->sym_tab = fml_sym_open ();
@@ -136,50 +198,10 @@ Fml fml_open (void)
     sym_info = fml_sym_add (fml->sym_tab, "return");
     sym_info->kind = FML_RETURN;
 
-
-    sym_info = fml_sym_add (fml->sym_tab, "and");
-    sym_info->kind = FML_CBINARY;
-    sym_info->binary = fml_exec_and;
-    sym_info = fml_sym_add (fml->sym_tab, "or");
-    sym_info->kind = FML_CBINARY;
-    sym_info->binary = fml_exec_or;
-    sym_info = fml_sym_add (fml->sym_tab, "index");
-    sym_info->kind = FML_CBINARY;
-    sym_info->binary = fml_exec_indx;
-
-    sym_info = fml_sym_add (fml->sym_tab, "plus");
-    sym_info->kind = FML_CBINARY;
-    sym_info->binary = fml_exec_plus;
-    sym_info = fml_sym_add (fml->sym_tab, "minus");
-    sym_info->kind = FML_CBINARY;
-    sym_info->binary = fml_exec_minus;
-
-    sym_info = fml_sym_add (fml->sym_tab, "gt");
-    sym_info->kind = FML_CBINARY;
-    sym_info->binary = fml_exec_gt;
-    sym_info = fml_sym_add (fml->sym_tab, "lt");
-    sym_info->kind = FML_CBINARY;
-    sym_info->binary = fml_exec_lt;
-    sym_info = fml_sym_add (fml->sym_tab, "eq");
-    sym_info->kind = FML_CBINARY;
-    sym_info->binary = fml_exec_eq;
-
-    sym_info = fml_sym_add (fml->sym_tab, "ge");
-    sym_info->kind = FML_CBINARY;
-    sym_info->binary = fml_exec_ge;
-    sym_info = fml_sym_add (fml->sym_tab, "le");
-    sym_info->kind = FML_CBINARY;
-    sym_info->binary = fml_exec_le;
-    sym_info = fml_sym_add (fml->sym_tab, "ne");
-    sym_info->kind = FML_CBINARY;
-    sym_info->binary = fml_exec_ne;
-
-    sym_info = fml_sym_add (fml->sym_tab, "incr");
-    sym_info->kind = FML_CPREFIX;
-    sym_info->prefix = fml_exec_incr;
-    sym_info = fml_sym_add (fml->sym_tab, "decr");
-    sym_info->kind = FML_CPREFIX;
-    sym_info->prefix = fml_exec_decr;
+    fml_list_init (fml);
+    fml_arit_init (fml);
+    fml_rel_init (fml);
+    fml_str_init (fml);
 
     sym_info = fml_sym_add (fml->sym_tab, "s");
     sym_info->kind = FML_CPREFIX;
@@ -218,7 +240,7 @@ int fml_preprocess (Fml fml)
 }
 
 
-static void fml_init_token (struct token *tp, Fml fml)
+void fml_init_token (struct token *tp, Fml fml)
 {
     tp->maxbuf = FML_ATOM_BUF*2;
     tp->offset = 0;
@@ -227,13 +249,18 @@ static void fml_init_token (struct token *tp, Fml fml)
     tp->escape_char = fml->escape_char;
 }
 
-static void fml_del_token (struct token *tp, Fml fml)
+void fml_del_token (struct token *tp, Fml fml)
 {
     if (tp->maxbuf != FML_ATOM_BUF*2)
         free (tp->atombuf);
 }
 
-static void fml_cmd_lex (struct fml_node **np, struct token *tp)
+void fml_cmd_lex (struct fml_node **np, struct token *tp)
+{
+    fml_cmd_lex_s (np, tp, 1);
+}
+
+void fml_cmd_lex_s (struct fml_node **np, struct token *tp, int esc_stop)
 {
     char *cp;
     char *dst;
@@ -294,7 +321,7 @@ static void fml_cmd_lex (struct fml_node **np, struct token *tp)
     }
     while (*cp)
     {
-        if (*cp == tp->escape_char)
+        if (*cp == tp->escape_char && esc_stop)
         {
             *dst = '\0';
             tp->offset = cp - tp->atombuf;
@@ -307,9 +334,21 @@ static void fml_cmd_lex (struct fml_node **np, struct token *tp)
     *np = (*np)->p[1];
 }
 
-static struct fml_node *fml_exec_group (struct fml_node *list, Fml fml);
+struct fml_node *fml_expr_term (Fml fml, struct fml_node **lp, 
+                                struct token *tp)
+{
+    struct fml_node *fn;
+    if (tp->kind == 'g')
+    {
+        fn = fml_sub0 (fml, tp->sub);
+        fml_cmd_lex (lp, tp);
+    }
+    else
+        fn = fml_sub2 (fml, lp, tp);
+    return fn;
+}
 
-static void fml_lr_values (Fml fml, struct fml_node *l, int *left_val,
+void fml_lr_values (Fml fml, struct fml_node *l, int *left_val,
                            struct fml_node *r, int *right_val)
 {
     if (l && l->is_atom)
@@ -324,263 +363,22 @@ static void fml_lr_values (Fml fml, struct fml_node *l, int *left_val,
     fml_node_delete (fml, r);
 }
 
-static struct fml_node *fml_exec_and (Fml fml, struct fml_node *l,
-                                      struct fml_node *r)
-{
-    if (l && r)
-    {
-        fml_node_delete (fml, l);
-        return r;
-    }
-    fml_node_delete (fml, l);
-    fml_node_delete (fml, r);
-    return NULL;
-}
-
-static struct fml_node *fml_exec_or (Fml fml, struct fml_node *l,
-                                      struct fml_node *r)
-{
-    if (r)
-    {
-        fml_node_delete (fml, l);
-        return r;
-    }
-    return l;
-}
-
-static struct fml_node *fml_exec_indx (Fml fml, struct fml_node *l,
-                                       struct fml_node *r)
-{
-    struct fml_node *list = l;
-    struct fml_node *fn;
-    int indx;
-
-    if (!l || !r || !r->is_atom)
-    {
-        fml_node_delete (fml, l);
-        fml_node_delete (fml, r);
-        return NULL;
-    }
-    indx = fml_atom_val (r->p[0]);
-    fml_node_delete (fml, r);
-    while (--indx >= 1 && list)
-        list = list->p[1];
-    if (!list)
-        fn = NULL;
-    else if (list->is_atom)
-    {
-        fn = fml_node_alloc (fml);
-        fn->is_atom = 1;
-        fn->p[0] = list->p[0];
-        list->is_atom = 0;
-        list->p[0] = NULL;
-    }
-    else
-    {
-        fn = list->p[0];
-        list->p[0] = NULL;
-    }
-    fml_node_delete (fml, l);
-    return fn;
-}
-
-static struct fml_node *fml_exec_plus (Fml fml, struct fml_node *l,
-                                       struct fml_node *r)
-{
-    int left_val, right_val;
-    char arg[20];
-    struct fml_node *fn;
-
-    fml_lr_values (fml, l, &left_val, r, &right_val);
-    sprintf (arg, "%d", left_val + right_val);
-    fn = fml_node_alloc (fml);
-    fn->is_atom = 1;
-    fn->p[0] = fml_atom_alloc (fml, arg);
-    return fn;
-}
-
-static struct fml_node *fml_exec_minus (Fml fml, struct fml_node *l,
-                                       struct fml_node *r)
-{
-    int left_val, right_val;
-    char arg[20];
-    struct fml_node *fn;
-
-    fml_lr_values (fml, l, &left_val, r, &right_val);
-    sprintf (arg, "%d", left_val - right_val);
-    fn = fml_node_alloc (fml);
-    fn->is_atom = 1;
-    fn->p[0] = fml_atom_alloc (fml, arg);
-    return fn;
-}
-
-
-static struct fml_node *fml_exec_gt (Fml fml, struct fml_node *l,
-                                     struct fml_node *r)
-{
-    int left_val, right_val;
-    struct fml_node *fn;
-    fml_lr_values (fml, l, &left_val, r, &right_val);
-    if (left_val > right_val)
-    {
-        fn = fml_node_alloc (fml);
-        fn->is_atom = 1;
-        fn->p[0] = fml_atom_alloc (fml, "1");
-    }
-    else
-        fn = NULL;
-    return fn;
-}
-
-
-static struct fml_node *fml_exec_lt (Fml fml, struct fml_node *l,
-                                     struct fml_node *r)
-{
-    int left_val, right_val;
-    struct fml_node *fn;
-    fml_lr_values (fml, l, &left_val, r, &right_val);
-    if (left_val < right_val)
-    {
-        fn = fml_node_alloc (fml);
-        fn->is_atom = 1;
-        fn->p[0] = fml_atom_alloc (fml, "1");
-    }
-    else
-        fn = NULL;
-    return fn;
-}
-
-static struct fml_node *fml_exec_eq (Fml fml, struct fml_node *l,
-                                     struct fml_node *r)
-{
-    int left_val, right_val;
-    struct fml_node *fn;
-    fml_lr_values (fml, l, &left_val, r, &right_val);
-    if (left_val == right_val)
-    {
-        fn = fml_node_alloc (fml);
-        fn->is_atom = 1;
-        fn->p[0] = fml_atom_alloc (fml, "1");
-    }
-    else
-        fn = NULL;
-    return fn;
-}
-
-static struct fml_node *fml_exec_ne (Fml fml, struct fml_node *l,
-                                     struct fml_node *r)
-{
-    int left_val, right_val;
-    struct fml_node *fn;
-    fml_lr_values (fml, l, &left_val, r, &right_val);
-    if (left_val != right_val)
-    {
-        fn = fml_node_alloc (fml);
-        fn->is_atom = 1;
-        fn->p[0] = fml_atom_alloc (fml, "1");
-    }
-    else
-        fn = NULL;
-    return fn;
-}
-
-static struct fml_node *fml_exec_le (Fml fml, struct fml_node *l,
-                                     struct fml_node *r)
-{
-    int left_val, right_val;
-    struct fml_node *fn;
-    fml_lr_values (fml, l, &left_val, r, &right_val);
-    if (left_val <= right_val)
-    {
-        fn = fml_node_alloc (fml);
-        fn->is_atom = 1;
-        fn->p[0] = fml_atom_alloc (fml, "1");
-    }
-    else
-        fn = NULL;
-    return fn;
-}
-
-static struct fml_node *fml_exec_ge (Fml fml, struct fml_node *l,
-                                     struct fml_node *r)
-{
-    int left_val, right_val;
-    struct fml_node *fn;
-    fml_lr_values (fml, l, &left_val, r, &right_val);
-    if (left_val >= right_val)
-    {
-        fn = fml_node_alloc (fml);
-        fn->is_atom = 1;
-        fn->p[0] = fml_atom_alloc (fml, "1");
-    }
-    else
-        fn = NULL;
-    return fn;
-}
-
-
 static struct fml_node *fml_exec_space (Fml fml, struct fml_node **lp, 
                                         struct token *tp)
 {
-    putchar ('_');
+    fml_cmd_lex (lp, tp);
+    if (fml->debug & 1) 
+        (*fml->write_func) ('_');
+    else
+        (*fml->write_func) (' ');
     return NULL;
 }
 
 static struct fml_node *fml_exec_nl (Fml fml, struct fml_node **lp, 
                                      struct token *tp)
 {
-    putchar ('\n');
-    return NULL;
-}
-
-static struct fml_node *fml_exec_incr (Fml fml, struct fml_node **lp, 
-                                       struct token *tp)
-{
-    struct fml_node *fn = NULL;
-    struct fml_sym_info *info;
-    fml_cmd_lex (lp, tp);
-    if (tp->kind == 'e')
-    {
-        info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
-        assert (info);
-        if (info->kind == FML_VAR && info->body && info->body->is_atom)
-        {
-            char arg[128];
-            int val;
-            
-            val = fml_atom_val (info->body->p[0]);
-            fml_node_delete (fml, info->body);
-            sprintf (arg, "%d", val+1);
-            info->body = fn = fml_node_alloc (fml);
-            fn->is_atom = 1;
-            fn->p[0] = fml_atom_alloc (fml, arg);
-        }
-    }
-    return NULL;
-}
-
-static struct fml_node *fml_exec_decr (Fml fml, struct fml_node **lp, 
-                                       struct token *tp)
-{
-    struct fml_node *fn = NULL;
-    struct fml_sym_info *info;
     fml_cmd_lex (lp, tp);
-    if (tp->kind == 'e')
-    {
-        info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
-        assert (info);
-        if (info->kind == FML_VAR && info->body && info->body->is_atom)
-        {
-            char arg[128];
-            int val;
-            
-            val = fml_atom_val (info->body->p[0]);
-            sprintf (arg, "%d", val-1);
-            info->body = fn = fml_node_alloc (fml);
-            fn->is_atom = 1;
-            fn->p[0] = fml_atom_alloc (fml, arg);
-        }
-    }
+    (*fml->write_func) ('\n');
     return NULL;
 }
 
@@ -591,7 +389,7 @@ static struct fml_node *fml_exec_prefix (struct fml_sym_info *info, Fml fml,
     struct fml_node *fn;
     struct fml_sym_info *arg_info;
     struct fml_node *return_value;
-    static char arg[128];
+    static char arg_name[128];
 
     if (fml->debug & 1)
     {
@@ -602,28 +400,46 @@ static struct fml_node *fml_exec_prefix (struct fml_sym_info *info, Fml fml,
     fml_cmd_lex (lp, tp);
     for (fn = info->args; fn; fn = fn->p[1])
     {
-
         assert (fn->is_atom);
-        fml_atom_strx (fn->p[0], arg, 127);
+        fml_atom_strx (fn->p[0], arg_name, 127);
         if (fml->debug & 1)
         {
             pr_indent (1);
-            printf ("%s=", arg);
+            printf ("%s=", arg_name);
         }
-        arg_info = fml_sym_add_local (fml->sym_tab, arg);
-        arg_info->kind = FML_VAR;
-
-        if (tp->kind == 'g')
+        if (*arg_name == fml->escape_char)
         {
-            arg_info->body = fml_sub0 (fml, tp->sub);
+            arg_info = fml_sym_add_local (fml->sym_tab, 1+arg_name);
+            arg_info->kind = FML_CODE;
+
+            if (tp->kind == 'g')
+                arg_info->body = tp->sub;
+            else
+                arg_info->body = NULL;
+            if (fml->debug & 1)
+            {
+                fml_pr_list (arg_info->body);
+                pr_indent (-1);
+            }
             fml_cmd_lex (lp, tp);
         }
         else
-            arg_info->body = fml_sub2 (fml, lp, tp);
-        if (fml->debug & 1)
         {
-            fml_pr_list (arg_info->body);
-            pr_indent (-1);
+            arg_info = fml_sym_add_local (fml->sym_tab, arg_name);
+            arg_info->kind = FML_VAR;
+
+            if (tp->kind == 'g')
+            {
+                arg_info->body = fml_sub0 (fml, tp->sub);
+                fml_cmd_lex (lp, tp);
+            }
+            else
+                arg_info->body = fml_sub2 (fml, lp, tp);
+            if (fml->debug & 1)
+            {
+                fml_pr_list (arg_info->body);
+                pr_indent (-1);
+            }
         }
     }
     return_value = fml_exec_group (info->body, fml);
@@ -637,7 +453,7 @@ static struct fml_node *fml_exec_prefix (struct fml_sym_info *info, Fml fml,
 }
 
 
-static void fml_emit (struct fml_node *list)
+static void fml_emit (Fml fml, struct fml_node *list)
 {
     int s = 0;
     while (list)
@@ -646,13 +462,17 @@ static void fml_emit (struct fml_node *list)
         {
             struct fml_atom *a;
             if (s)
-                printf (" ");
+                (*fml->write_func) (' ');
             s++;
             for (a = list->p[0]; a; a=a->next)
-                printf ("%s", a->buf);
+            {
+                int i = 0;
+                while (i < FML_ATOM_BUF && a->buf[i])
+                    (*fml->write_func) (a->buf[i++]);
+            }
         }
         else
-            fml_emit (list->p[0]);
+            fml_emit (fml, list->p[0]);
         list = list->p[1];
     }
 }
@@ -666,19 +486,27 @@ static struct fml_node *fml_sub2 (Fml fml, struct fml_node **lp,
     if (tp->kind == 'e')
     {
         info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
-        assert (info);
+	if (!info)
+        {
+	    printf ("<<unknown %s in expression>>", tp->tokenbuf);
+	    getchar ();
+	    return NULL;
+        }
         switch (info->kind)
         {
         case FML_VAR:
             fn = fml_node_copy (fml, info->body);           
             fml_cmd_lex (lp, tp);
             break;
+        case FML_CODE:
+            fn = fml_node_copy (fml, info->body);           
+            fml_cmd_lex (lp, tp);
+            break;
         case FML_PREFIX:
             fn = fml_exec_prefix (info, fml, lp, tp);
             break;
         case FML_CPREFIX:
             fn = (*info->prefix) (fml, lp, tp);
-            fml_cmd_lex (lp, tp);
             break;
         default:
             fml_cmd_lex (lp, tp);
@@ -811,9 +639,13 @@ static struct fml_node *fml_sub0 (Fml fml, struct fml_node *list)
     if (!list)
         return NULL;
     fml_init_token (&token, fml);
-    assert (list);
     fml_cmd_lex (&list, &token);
     fn1 = fn = fml_sub1 (fml, &list, &token);
+    if (!fn)
+    {
+        fml_del_token (&token, fml);
+        return fn;
+    }
     if (fn->p[1] && token.kind != '\0')
     {
         fn1 = fml_node_alloc (fml);
@@ -858,8 +690,9 @@ static struct fml_node *fml_exec_foreach (struct fml_sym_info *info, Fml fml,
     }
     else
     {
-        fml_node_delete (fml, info->body);
-        info->body = NULL;
+        if (info_var->kind == FML_VAR)
+            fml_node_delete (fml, info_var->body);
+        info_var->body = NULL;
     }
     if (fml->debug & 1)
     {
@@ -1015,11 +848,11 @@ static void fml_emit_expr (Fml fml, struct fml_node **lp, struct token *tp)
     struct fml_node *fn;
 
     fn = fml_sub1 (fml, lp, tp);
-    fml_emit (fn);
+    fml_emit (fml, fn);
     fml_node_delete (fml, fn);
 }
 
-static struct fml_node *fml_exec_group (struct fml_node *list, Fml fml)
+struct fml_node *fml_exec_group (struct fml_node *list, Fml fml)
 {
     struct token token;
     struct fml_sym_info *info;
@@ -1058,7 +891,7 @@ static struct fml_node *fml_exec_group (struct fml_node *list, Fml fml)
                     while (1)
                     {
                         fml_cmd_lex (&list, &token);
-                        if (token.kind != 't')
+                        if (token.kind != 't' && token.kind != 'e')
                             break;
                         if (!info->args)
                         {
@@ -1104,7 +937,7 @@ static struct fml_node *fml_exec_group (struct fml_node *list, Fml fml)
                 case FML_PREFIX:
                 case FML_CPREFIX:
                     if (token.separate && !first)
-                        putchar (' ');
+                        (*fml->write_func) (' ');
                     first = 1;
                     fml_emit_expr (fml, &list, &token);
                     fml_node_stat (fml);
@@ -1146,22 +979,22 @@ static struct fml_node *fml_exec_group (struct fml_node *list, Fml fml)
                         pr_indent (-1);
                     }
                     continue;
+                case FML_CODE:
+                    fml_exec_group (info->body, fml);
+                    break;
                 default:
-                    printf ("unknown token: `%s'", token.tokenbuf);
+                    printf ("<unknown token: `%s'>", token.tokenbuf);
                     fml_cmd_lex (&list, &token);
                 }
             }
             else
             {
-                printf ("<unknown>");
+                printf ("<unknown %s>", token.tokenbuf);
             }
             break;
         case 't':
-#if 0
-            printf ("<token.tokenbuf=%s>", token.tokenbuf);
-#endif
             if (token.separate && !first)
-                putchar (' ');
+                (*fml->write_func) (' ');
             first = 0;
             fml_emit_expr (fml, &list, &token);
             fml_node_stat (fml);
@@ -1178,7 +1011,5 @@ void fml_exec (Fml fml)
     fml_node_stat (fml);
     fml_exec_group (fml->list, fml);
     if (fml->debug & 1)
-        printf ("\n");
+        putchar ('\n');
 }
-
-