fml/fml.c

   1 /*
   2  * Copyright (c) 1995, the EUROPAGATE consortium (see below).
   3  *
   4  * The EUROPAGATE consortium members are:
   5  *
   6  *    University College Dublin
   7  *    Danmarks Teknologiske Videnscenter
   8  *    An Chomhairle Leabharlanna
   9  *    Consejo Superior de Investigaciones Cientificas
  10  *
  11  * Permission to use, copy, modify, distribute, and sell this software and
  12  * its documentation, in whole or in part, for any purpose, is hereby granted,
  13  * provided that:
  14  *
  15  * 1. This copyright and permission notice appear in all copies of the
  16  * software and its documentation. Notices of copyright or attribution
  17  * which appear at the beginning of any file must remain unchanged.
  18  *
  19  * 2. The names of EUROPAGATE or the project partners may not be used to
  20  * endorse or promote products derived from this software without specific
  21  * prior written permission.
  22  *
  23  * 3. Users of this software (implementors and gateway operators) agree to
  24  * inform the EUROPAGATE consortium of their use of the software. This
  25  * information will be used to evaluate the EUROPAGATE project and the
  26  * software, and to plan further developments. The consortium may use
  27  * the information in later publications.
  28  *
  29  * 4. Users of this software agree to make their best efforts, when
  30  * documenting their use of the software, to acknowledge the EUROPAGATE
  31  * consortium, and the role played by the software in their work.
  32  *
  33  * THIS SOFTWARE IS PROVIDED "AS IS" AND WITHOUT WARRANTY OF ANY KIND,
  34  * EXPRESS, IMPLIED, OR OTHERWISE, INCLUDING WITHOUT LIMITATION, ANY
  35  * WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE.
  36  * IN NO EVENT SHALL THE EUROPAGATE CONSORTIUM OR ITS MEMBERS BE LIABLE
  37  * FOR ANY SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL DAMAGES OF
  38  * ANY KIND, OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA
  39  * OR PROFITS, WHETHER OR NOT ADVISED OF THE POSSIBILITY OF DAMAGE, AND
  40  * ON ANY THEORY OF LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE
  41  * USE OR PERFORMANCE OF THIS SOFTWARE.
  42  *
  43  */
  44 /*
  45  * FML interpreter. Europagate, 1995
  46  *
  47  * $Log: fml.c,v $
  48  * Revision 1.16  1995/05/16 09:39:32  adam
  49  * LICENSE.
  50  *
  51  * Revision 1.15  1995/02/27  09:01:20  adam
  52  * Regular expression support. Argument passing by name option. New FML
  53  * function strlen.
  54  *
  55  * Revision 1.14  1995/02/23  08:32:04  adam
  56  * Changed header.
  57  *
  58  * Revision 1.12  1995/02/22  15:20:13  adam
  59  * Bug fix in fml_exec_space.
  60  *
  61  * Revision 1.11  1995/02/22  08:50:49  adam
  62  * Definition of CPP changed. Output function can be customized.
  63  *
  64  * Revision 1.10  1995/02/21  17:46:08  adam
  65  * Bug fix in fml_sub0.
  66  *
  67  * Revision 1.9  1995/02/21  14:00:03  adam
  68  * Minor changes.
  69  *
  70  * Revision 1.8  1995/02/10  18:15:52  adam
  71  * FML function 'strcmp' implemented. This function can be used to
  72  * test for existence of MARC fields.
  73  *
  74  * Revision 1.7  1995/02/10  15:50:54  adam
  75  * MARC interface implemented. Minor bugs fixed. fmltest can
  76  * be used to format single MARC records. New function '\list'
  77  * implemented.
  78  *
  79  * Revision 1.6  1995/02/09  16:06:06  adam
  80  * FML can be called from the outside multiple times by the functions:
  81  * fml_exec_call and fml_exec_call_str.
  82  * An interactive parameter (-i) to fmltest starts a shell-like
  83  * interface to FML by using the fml_exec_call_str function.
  84  *
  85  * Revision 1.5  1995/02/09  14:33:36  adam
  86  * Split source fml.c and define relevant build-in functions in separate
  87  * files. New operators mult, div, not, llen implemented.
  88  *
  89  * Revision 1.4  1995/02/09  13:07:14  adam
  90  * Nodes are freed now. Many bugs fixed.
  91  *
  92  * Revision 1.3  1995/02/07  16:09:23  adam
  93  * The \ character is no longer INCLUDED when terminating a token.
  94  * Major changes in tokenization routines. Bug fixes in expressions
  95  * with lists (fml_sub0).
  96  *
  97  * Revision 1.2  1995/02/06  15:23:25  adam
  98  * Added some more relational operators (le,ne,ge). Added increment
  99  * and decrement operators. Function index changed, so that first
 100  * element is 1 - not 0. Function fml_atom_val edited.
 101  *
 102  * Revision 1.1.1.1  1995/02/06  13:48:10  adam
 103  * First version of the FML interpreter. It's slow and memory isn't
 104  * freed properly. In particular, the FML nodes aren't released yet.
 105  *
 106  */
 107 #include <assert.h>
 108 #include <stdlib.h>
 109 #include <stdio.h>
 110
 111 #include "fmlp.h"
 112
 113 static int default_read_func (void)
 114 {
 115     return getchar ();
 116 }
 117
 118 static void default_write_func (int c)
 119 {
 120     putchar (c);
 121 }
 122
 123 static void default_err_handle (int no)
 124 {
 125     fprintf (stderr, "Error: %d\n", no);
 126 }
 127
 128 static struct fml_node *fml_sub0 (Fml fml, struct fml_node *list);
 129 static struct fml_node *fml_sub1 (Fml fml, struct fml_node **lp,
 130                                   struct token *tp);
 131 static struct fml_node *fml_sub2 (Fml fml, struct fml_node **lp,
 132                                   struct token *tp);
 133 static struct fml_node *fml_exec_space (Fml fml, struct fml_node **lp,
 134                                         struct token *tp);
 135 static struct fml_node *fml_exec_nl (Fml fml, struct fml_node **lp,
 136                                      struct token *tp);
 137
 138 static int indent = 0;
 139
 140 static void pr_indent (int n)
 141 {
 142     assert (indent >= 0);
 143     if (n >= 0)
 144     {
 145         int i = indent;
 146         while (--i >= 0)
 147             putchar(' ');
 148     }
 149     if (n > 0)
 150     {
 151         printf ("[");
 152         ++indent;
 153     }
 154     else if (n < 0)
 155     {
 156         printf ("]\n");
 157         --indent;
 158     }
 159 }
 160
 161 Fml fml_open (void)
 162 {
 163     struct fml_sym_info *sym_info;
 164
 165     Fml fml = malloc (sizeof(*fml));
 166
 167     if (!fml)
 168         return NULL;
 169
 170     fml->escape_char = '\\';
 171     fml->comment_char = '#';
 172     fml->eof_mark = EOF;
 173     fml->white_chars = " \t\f\r\n";
 174     fml->read_func = default_read_func;
 175     fml->err_handle = default_err_handle;
 176     fml->write_func = default_write_func;
 177
 178     fml->list = NULL;
 179     fml->sym_tab = fml_sym_open ();
 180     fml->atom_free_list = NULL;
 181     fml->node_free_list = NULL;
 182     fml->debug = 0;
 183
 184     sym_info = fml_sym_add (fml->sym_tab, "func");
 185     sym_info->kind = FML_FUNC;
 186     sym_info = fml_sym_add (fml->sym_tab, "bin");
 187     sym_info->kind = FML_BIN;
 188     sym_info = fml_sym_add (fml->sym_tab, "if");
 189     sym_info->kind = FML_IF;
 190     sym_info = fml_sym_add (fml->sym_tab, "else");
 191     sym_info->kind = FML_ELSE;
 192     sym_info = fml_sym_add (fml->sym_tab, "foreach");
 193     sym_info->kind = FML_FOREACH;
 194     sym_info = fml_sym_add (fml->sym_tab, "set");
 195     sym_info->kind = FML_SET;
 196     sym_info = fml_sym_add (fml->sym_tab, "while");
 197     sym_info->kind = FML_WHILE;
 198     sym_info = fml_sym_add (fml->sym_tab, "return");
 199     sym_info->kind = FML_RETURN;
 200
 201     fml_list_init (fml);
 202     fml_arit_init (fml);
 203     fml_rel_init (fml);
 204     fml_str_init (fml);
 205
 206     sym_info = fml_sym_add (fml->sym_tab, "s");
 207     sym_info->kind = FML_CPREFIX;
 208     sym_info->prefix = fml_exec_space;
 209     sym_info = fml_sym_add (fml->sym_tab, " ");
 210     sym_info->kind = FML_CPREFIX;
 211     sym_info->prefix = fml_exec_space;
 212     sym_info = fml_sym_add (fml->sym_tab, "n");
 213     sym_info->kind = FML_CPREFIX;
 214     sym_info->prefix = fml_exec_nl;
 215
 216     return fml;
 217 }
 218
 219 static Fml fml_pop_handler = NULL;
 220 static void pop_handler (struct fml_sym_info *info)
 221 {
 222     assert (fml_pop_handler);
 223     switch (info->kind)
 224     {
 225     case FML_VAR:
 226         fml_node_delete (fml_pop_handler, info->body);
 227         break;
 228     }
 229 }
 230 static void fml_do_pop (Fml fml)
 231 {
 232     fml_pop_handler = fml;
 233     fml_sym_pop (fml->sym_tab, pop_handler);
 234 }
 235
 236 int fml_preprocess (Fml fml)
 237 {
 238     fml->list = fml_tokenize (fml);
 239     return 0;
 240 }
 241
 242
 243 void fml_init_token (struct token *tp, Fml fml)
 244 {
 245     tp->maxbuf = FML_ATOM_BUF*2;
 246     tp->offset = 0;
 247     tp->atombuf = tp->sbuf;
 248     tp->tokenbuf = tp->sbuf + tp->maxbuf;
 249     tp->escape_char = fml->escape_char;
 250 }
 251
 252 void fml_del_token (struct token *tp, Fml fml)
 253 {
 254     if (tp->maxbuf != FML_ATOM_BUF*2)
 255         free (tp->atombuf);
 256 }
 257
 258 void fml_cmd_lex (struct fml_node **np, struct token *tp)
 259 {
 260     fml_cmd_lex_s (np, tp, 1);
 261 }
 262
 263 void fml_cmd_lex_s (struct fml_node **np, struct token *tp, int esc_stop)
 264 {
 265     char *cp;
 266     char *dst;
 267     if (!*np)
 268     {
 269         tp->kind = '\0';
 270         return;
 271     }
 272     if (tp->offset == 0)
 273     {
 274         tp->separate = 1;
 275         if ((*np)->is_atom)
 276         {
 277             tp->atom = (*np)->p[0];
 278             if (!tp->atom->next)
 279                 fml_atom_str (tp->atom, tp->atombuf);
 280             else
 281             {
 282                 int l = fml_atom_str (tp->atom, NULL);
 283                 if (l >= tp->maxbuf-1)
 284                 {
 285                     if (tp->maxbuf != FML_ATOM_BUF*2)
 286                         free (tp->atombuf);
 287                     tp->maxbuf = l + 40;
 288                     tp->atombuf = malloc (tp->maxbuf*2);
 289                     tp->tokenbuf = tp->atombuf + tp->maxbuf;
 290                 }
 291                 fml_atom_str (tp->atom, tp->atombuf);
 292             }
 293         }
 294         else
 295         {
 296             tp->sub = (*np)->p[0];
 297             tp->kind = 'g';
 298             *np = (*np)->p[1];
 299             return ;
 300         }
 301     }
 302     else
 303         tp->separate = 0;
 304     cp = tp->atombuf + tp->offset;
 305     dst = tp->tokenbuf;
 306     if (*cp == tp->escape_char)
 307     {
 308         tp->kind = 'e';
 309         cp++;
 310         if (*cp == '\0')
 311         {
 312             strcpy (dst, " ");
 313             tp->offset = 0;
 314             *np = (*np)->p[1];
 315             return ;
 316         }
 317     }
 318     else
 319     {
 320         tp->kind = 't';
 321     }
 322     while (*cp)
 323     {
 324         if (*cp == tp->escape_char && esc_stop)
 325         {
 326             *dst = '\0';
 327             tp->offset = cp - tp->atombuf;
 328             return ;
 329         }
 330         *dst++ = *cp++;
 331     }
 332     *dst = '\0';
 333     tp->offset = 0;
 334     *np = (*np)->p[1];
 335 }
 336
 337 struct fml_node *fml_expr_term (Fml fml, struct fml_node **lp,
 338                                 struct token *tp)
 339 {
 340     struct fml_node *fn;
 341     if (tp->kind == 'g')
 342     {
 343         fn = fml_sub0 (fml, tp->sub);
 344         fml_cmd_lex (lp, tp);
 345     }
 346     else
 347         fn = fml_sub2 (fml, lp, tp);
 348     return fn;
 349 }
 350
 351 void fml_lr_values (Fml fml, struct fml_node *l, int *left_val,
 352                            struct fml_node *r, int *right_val)
 353 {
 354     if (l && l->is_atom)
 355         *left_val = fml_atom_val (l->p[0]);
 356     else
 357         *left_val = 0;
 358     if (r && r->is_atom)
 359         *right_val = fml_atom_val (r->p[0]);
 360     else
 361         *right_val = 0;
 362     fml_node_delete (fml, l);
 363     fml_node_delete (fml, r);
 364 }
 365
 366 static struct fml_node *fml_exec_space (Fml fml, struct fml_node **lp,
 367                                         struct token *tp)
 368 {
 369     fml_cmd_lex (lp, tp);
 370     if (fml->debug & 1)
 371         (*fml->write_func) ('_');
 372     else
 373         (*fml->write_func) (' ');
 374     return NULL;
 375 }
 376
 377 static struct fml_node *fml_exec_nl (Fml fml, struct fml_node **lp,
 378                                      struct token *tp)
 379 {
 380     fml_cmd_lex (lp, tp);
 381     (*fml->write_func) ('\n');
 382     return NULL;
 383 }
 384
 385 static struct fml_node *fml_exec_prefix (struct fml_sym_info *info, Fml fml,
 386                                          struct fml_node **lp,
 387                                          struct token *tp)
 388 {
 389     struct fml_node *fn;
 390     struct fml_sym_info *arg_info;
 391     struct fml_node *return_value;
 392     static char arg_name[128];
 393
 394     if (fml->debug & 1)
 395     {
 396         pr_indent (1);
 397         printf ("exec_prefix ");
 398     }
 399     fml_sym_push (fml->sym_tab);
 400     fml_cmd_lex (lp, tp);
 401     for (fn = info->args; fn; fn = fn->p[1])
 402     {
 403         assert (fn->is_atom);
 404         fml_atom_strx (fn->p[0], arg_name, 127);
 405         if (fml->debug & 1)
 406         {
 407             pr_indent (1);
 408             printf ("%s=", arg_name);
 409         }
 410         if (*arg_name == fml->escape_char)
 411         {
 412             arg_info = fml_sym_add_local (fml->sym_tab, 1+arg_name);
 413             arg_info->kind = FML_CODE;
 414
 415             if (tp->kind == 'g')
 416                 arg_info->body = tp->sub;
 417             else
 418                 arg_info->body = NULL;
 419             if (fml->debug & 1)
 420             {
 421                 fml_pr_list (arg_info->body);
 422                 pr_indent (-1);
 423             }
 424             fml_cmd_lex (lp, tp);
 425         }
 426         else
 427         {
 428             arg_info = fml_sym_add_local (fml->sym_tab, arg_name);
 429             arg_info->kind = FML_VAR;
 430
 431             if (tp->kind == 'g')
 432             {
 433                 arg_info->body = fml_sub0 (fml, tp->sub);
 434                 fml_cmd_lex (lp, tp);
 435             }
 436             else
 437                 arg_info->body = fml_sub2 (fml, lp, tp);
 438             if (fml->debug & 1)
 439             {
 440                 fml_pr_list (arg_info->body);
 441                 pr_indent (-1);
 442             }
 443         }
 444     }
 445     return_value = fml_exec_group (info->body, fml);
 446     if (fml->debug & 1)
 447     {
 448         pr_indent(0);
 449         pr_indent (-1);
 450     }
 451     fml_do_pop (fml);
 452     return return_value;
 453 }
 454
 455
 456 static void fml_emit (Fml fml, struct fml_node *list)
 457 {
 458     int s = 0;
 459     while (list)
 460     {
 461         if (list->is_atom)
 462         {
 463             struct fml_atom *a;
 464             if (s)
 465                 (*fml->write_func) (' ');
 466             s++;
 467             for (a = list->p[0]; a; a=a->next)
 468             {
 469                 int i = 0;
 470                 while (i < FML_ATOM_BUF && a->buf[i])
 471                     (*fml->write_func) (a->buf[i++]);
 472             }
 473         }
 474         else
 475             fml_emit (fml, list->p[0]);
 476         list = list->p[1];
 477     }
 478 }
 479
 480
 481 static struct fml_node *fml_sub2 (Fml fml, struct fml_node **lp,
 482                                   struct token *tp)
 483 {
 484     struct fml_node *fn;
 485     struct fml_sym_info *info;
 486     if (tp->kind == 'e')
 487     {
 488         info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
 489         if (!info)
 490         {
 491             printf ("<<unknown %s in expression>>", tp->tokenbuf);
 492             getchar ();
 493             return NULL;
 494         }
 495         switch (info->kind)
 496         {
 497         case FML_VAR:
 498             fn = fml_node_copy (fml, info->body);
 499             fml_cmd_lex (lp, tp);
 500             break;
 501         case FML_CODE:
 502             fn = fml_node_copy (fml, info->body);
 503             fml_cmd_lex (lp, tp);
 504             break;
 505         case FML_PREFIX:
 506             fn = fml_exec_prefix (info, fml, lp, tp);
 507             break;
 508         case FML_CPREFIX:
 509             fn = (*info->prefix) (fml, lp, tp);
 510             break;
 511         default:
 512             fml_cmd_lex (lp, tp);
 513             fn = NULL;
 514         }
 515     }
 516     else if (tp->kind == 'g')
 517     {
 518         if (tp->sub)
 519             fn = fml_sub0 (fml, tp->sub);
 520         else
 521             fn = NULL;
 522         fml_cmd_lex (lp, tp);
 523     }
 524     else if (tp->kind == 't')
 525     {
 526         fn = fml_node_alloc (fml);
 527         fn->is_atom = 1;
 528         fn->p[0] = fml_atom_alloc (fml, tp->tokenbuf);
 529         fml_cmd_lex (lp, tp);
 530     }
 531     else
 532         fn = NULL;
 533     return fn;
 534 }
 535
 536 static struct fml_node *fml_sub1 (Fml fml, struct fml_node **lp,
 537                                   struct token *tp)
 538 {
 539     struct fml_node *f1, *f2, *fn;
 540     struct fml_sym_info *info;
 541
 542     f1 = fml_sub2 (fml, lp, tp);
 543     while (tp->kind == 'e')
 544     {
 545         info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
 546         if (!info)
 547         {
 548             fprintf (stderr, "cannot locate `%s'", tp->tokenbuf);
 549             exit (1);
 550         }
 551         if (info->kind == FML_CBINARY)
 552         {
 553             fml_cmd_lex (lp, tp);
 554             f2 = fml_sub2 (fml, lp, tp);
 555             fn = (*info->binary) (fml, f1, f2);
 556             f1 = fn;
 557             continue;
 558         }
 559         else if (info->kind == FML_BINARY)
 560         {
 561             struct fml_sym_info *arg_info;
 562             char arg[127];
 563
 564             if (fml->debug & 1)
 565             {
 566                 pr_indent (1);
 567                 printf ("exec binary %s", tp->tokenbuf);
 568             }
 569             fml_cmd_lex (lp, tp);
 570             f2 = fml_sub2 (fml, lp, tp);
 571             fml_sym_push (fml->sym_tab);
 572
 573             fml_atom_strx (info->args->p[0], arg, 127);
 574             arg_info = fml_sym_add_local (fml->sym_tab, arg);
 575             arg_info->kind = FML_VAR;
 576             arg_info->body = f1;
 577             if (fml->debug & 1)
 578             {
 579                 printf (" left=");
 580                 fml_pr_list (f1);
 581             }
 582             fml_atom_strx ( ((struct fml_node *) info->args->p[1])->p[0],
 583                            arg, 127);
 584             arg_info = fml_sym_add_local (fml->sym_tab, arg);
 585             arg_info->kind = FML_VAR;
 586             arg_info->body = f2;
 587             if (fml->debug & 1)
 588             {
 589                 printf (" right=");
 590                 fml_pr_list (f2);
 591                 putchar ('\n');
 592             }
 593             f1 = fml_exec_group (info->body, fml);
 594             fml_do_pop (fml);
 595             if (fml->debug & 1)
 596             {
 597                 pr_indent (0);
 598                 pr_indent (-1);
 599             }
 600         }
 601         else
 602             break;
 603     }
 604     return f1;
 605 }
 606
 607 #if 0
 608 static struct fml_node *fml_sub0 (Fml fml, struct fml_node *list)
 609 {
 610     struct token token;
 611     struct fml_node *fn, *fn1;
 612
 613     fml_init_token (&token, fml);
 614     assert (list);
 615     fml_cmd_lex (&list, &token);
 616     fn = fml_sub1 (fml, &list, &token);
 617     if (token.kind == '\0')
 618     {
 619         fml_del_token (&token, fml);
 620         return fn;
 621     }
 622     fn1 = fml_node_alloc (fml);
 623     fn1->p[0] = fn;
 624     fn = fn1;
 625     while (token.kind != '\0')
 626     {
 627         fn1 = fn1->p[1] = fml_node_alloc (fml);
 628         fn1->p[0] = fml_sub1 (fml, &list, &token);
 629     }
 630     fml_del_token (&token, fml);
 631     return fn;
 632 }
 633 #else
 634 static struct fml_node *fml_sub0 (Fml fml, struct fml_node *list)
 635 {
 636     struct token token;
 637     struct fml_node *fn, *fn0, *fn1;
 638
 639     if (!list)
 640         return NULL;
 641     fml_init_token (&token, fml);
 642     fml_cmd_lex (&list, &token);
 643     fn1 = fn = fml_sub1 (fml, &list, &token);
 644     if (!fn)
 645     {
 646         fml_del_token (&token, fml);
 647         return fn;
 648     }
 649     if (fn->p[1] && token.kind != '\0')
 650     {
 651         fn1 = fml_node_alloc (fml);
 652         fn1->p[0] = fn;
 653     }
 654     fn0 = fn1;
 655     while (token.kind != '\0')
 656     {
 657         fn = fml_sub1 (fml, &list, &token);
 658         if (fn->p[1])
 659         {
 660             fn1 = fn1->p[1] = fml_node_alloc (fml);
 661             fn1->p[0] = fn;
 662         }
 663         else
 664         {
 665             fn1 = fn1->p[1] = fn;
 666         }
 667     }
 668     fml_del_token (&token, fml);
 669     return fn0;
 670 }
 671 #endif
 672
 673 static struct fml_node *fml_exec_foreach (struct fml_sym_info *info, Fml fml,
 674                                           struct fml_node **lp,
 675                                           struct token *tp)
 676 {
 677     struct fml_sym_info *info_var;
 678     struct fml_node *fn, *body;
 679     struct fml_node *return_value = NULL, *rv;
 680
 681     fml_cmd_lex (lp, tp);
 682     assert (tp->kind == 't');
 683
 684     info_var = fml_sym_lookup_local (fml->sym_tab, tp->tokenbuf);
 685     if (!info_var)
 686     {
 687         info_var = fml_sym_add_local (fml->sym_tab, tp->tokenbuf);
 688         info_var->body = NULL;
 689         info_var->kind = FML_VAR;
 690     }
 691     else
 692     {
 693         if (info_var->kind == FML_VAR)
 694             fml_node_delete (fml, info_var->body);
 695         info_var->body = NULL;
 696     }
 697     if (fml->debug & 1)
 698     {
 699         pr_indent (1);
 700         printf ("[foreach %s ", tp->tokenbuf);
 701     }
 702     fml_cmd_lex (lp, tp);
 703     assert (tp->kind == 'g');
 704     fn = fml_sub0 (fml, tp->sub);
 705
 706     fml_cmd_lex (lp, tp);
 707     assert (tp->kind == 'g');
 708     body = tp->sub;
 709
 710     while (fn)
 711     {
 712         struct fml_node *fn1;
 713
 714         fn1 = fn->p[1];
 715         fn->p[1] = NULL;
 716         if (fn->is_atom)
 717             info_var->body = fn;
 718         else
 719             info_var->body = fn->p[0];
 720         if (fml->debug & 1)
 721         {
 722             pr_indent (1);
 723             printf ("[foreach loop var=");
 724             fml_pr_list (info_var->body);
 725             pr_indent (-1);
 726         }
 727         rv = fml_exec_group (body, fml);
 728         if (rv)
 729             return_value = rv;
 730         fml_node_delete (fml, fn);
 731         fn = fn1;
 732     }
 733     info_var->body = NULL;
 734     if (fml->debug & 1)
 735         pr_indent (-1);
 736     return return_value;
 737 }
 738
 739 static struct fml_node *fml_exec_if (struct fml_sym_info *info, Fml fml,
 740                                      struct fml_node **lp, struct token *tp)
 741 {
 742     struct fml_node *fn, *body;
 743     struct fml_node *rv, *return_value = NULL;
 744
 745     fml_cmd_lex (lp, tp);
 746     assert (tp->kind == 'g');
 747     fn = fml_sub0 (fml, tp->sub);
 748     fml_cmd_lex (lp, tp);
 749     assert (tp->kind == 'g');
 750     if (fn)
 751     {
 752         rv = fml_exec_group (tp->sub, fml);
 753         if (rv)
 754             return_value = rv;
 755     }
 756     fml_cmd_lex (lp, tp);
 757     if (tp->kind == 'e')
 758     {
 759         info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
 760         if (info->kind == FML_ELSE)
 761         {
 762             fml_cmd_lex (lp, tp);
 763             assert (tp->kind == 'g');
 764             body = tp->sub;
 765             if (!fn)
 766             {
 767                 rv = fml_exec_group (body, fml);
 768                 if (rv)
 769                     return_value = rv;
 770             }
 771             fml_cmd_lex (lp, tp);
 772         }
 773     }
 774     fml_node_delete (fml, fn);
 775     return return_value;
 776 }
 777
 778 static struct fml_node *fml_exec_while (struct fml_sym_info *info, Fml fml,
 779                                         struct fml_node **lp, struct token *tp)
 780 {
 781     struct fml_node *fn, *body;
 782     struct fml_node *return_value = NULL;
 783
 784     fml_cmd_lex (lp, tp);
 785     assert (tp->kind == 'g');
 786     fn = tp->sub;
 787
 788     fml_cmd_lex (lp, tp);
 789     assert (tp->kind == 'g');
 790     body = tp->sub;
 791     assert (tp->sub);
 792     while (1)
 793     {
 794         struct fml_node *fn_expr;
 795         struct fml_node *rv;
 796         if (!fn)
 797             break;
 798         fn_expr = fml_sub0 (fml, fn);
 799         if (!fn_expr)
 800             break;
 801         fml_node_delete (fml, fn_expr);
 802         rv = fml_exec_group (body, fml);
 803         if (rv)
 804             return_value = rv;
 805     }
 806     return return_value;
 807 }
 808
 809 static void fml_exec_set (struct fml_sym_info *info, Fml fml,
 810                     struct fml_node **lp, struct token *tp)
 811 {
 812     struct fml_node *fn;
 813     struct fml_sym_info *info_var;
 814
 815     fml_cmd_lex (lp, tp);
 816     info_var = fml_sym_lookup_local (fml->sym_tab, tp->tokenbuf);
 817     if (!info_var)
 818     {
 819         info_var = fml_sym_add_local (fml->sym_tab, tp->tokenbuf);
 820         info_var->body = NULL;
 821     }
 822     if (fml->debug & 1)
 823     {
 824         pr_indent (1);
 825         printf ("set %s ", tp->tokenbuf);
 826     }
 827     info_var->kind = FML_VAR;
 828     fml_cmd_lex (lp, tp);
 829
 830     if (tp->kind == 'g')
 831     {
 832         fn = fml_sub0 (fml, tp->sub);
 833         fml_cmd_lex (lp, tp);
 834     }
 835     else
 836         fn = fml_sub2 (fml, lp, tp);
 837     fml_node_delete (fml, info_var->body);
 838     info_var->body = fn;
 839     if (fml->debug & 1)
 840     {
 841         fml_pr_list (info_var->body);
 842         pr_indent (-1);
 843     }
 844 }
 845
 846 static void fml_emit_expr (Fml fml, struct fml_node **lp, struct token *tp)
 847 {
 848     struct fml_node *fn;
 849
 850     fn = fml_sub1 (fml, lp, tp);
 851     fml_emit (fml, fn);
 852     fml_node_delete (fml, fn);
 853 }
 854
 855 struct fml_node *fml_exec_group (struct fml_node *list, Fml fml)
 856 {
 857     struct token token;
 858     struct fml_sym_info *info;
 859     int first = 1;
 860     struct fml_node *return_value = NULL, *rv;
 861
 862     if (!list)
 863         return NULL;
 864     fml_init_token (&token, fml);
 865     fml_cmd_lex (&list, &token);
 866     while (token.kind)
 867     {
 868         switch (token.kind)
 869         {
 870         case 'g':
 871             rv = fml_exec_group (token.sub, fml);
 872             if (rv)
 873                 return_value = rv;
 874             break;
 875         case 'e':
 876             info = fml_sym_lookup (fml->sym_tab, token.tokenbuf);
 877             if (info)
 878             {
 879                 struct fml_node *fn;
 880
 881                 switch (info->kind)
 882                 {
 883                 case FML_FUNC:
 884                     fml_cmd_lex (&list, &token);
 885                     assert (token.kind == 't');
 886                     info = fml_sym_lookup (fml->sym_tab, token.tokenbuf);
 887                     if (!info)
 888                         info = fml_sym_add (fml->sym_tab, token.tokenbuf);
 889                     info->kind = FML_PREFIX;
 890                     info->args = NULL;
 891                     while (1)
 892                     {
 893                         fml_cmd_lex (&list, &token);
 894                         if (token.kind != 't' && token.kind != 'e')
 895                             break;
 896                         if (!info->args)
 897                         {
 898                             info->args = fn = fml_node_alloc (fml);
 899                         }
 900                         else
 901                         {
 902                             for (fn = info->args; fn->p[1]; fn=fn->p[1])
 903                                 ;
 904                             fn = fn->p[1] = fml_node_alloc (fml);
 905                         }
 906                         fn->p[0] = token.atom;
 907                         fn->is_atom = 1;
 908                     }
 909                     assert (token.kind == 'g');
 910                     info->body = token.sub;
 911                     break;
 912                 case FML_BIN:
 913                     fml_cmd_lex (&list, &token);
 914                     assert (token.kind == 't');
 915                     info = fml_sym_lookup (fml->sym_tab, token.tokenbuf);
 916                     if (!info)
 917                         info = fml_sym_add (fml->sym_tab, token.tokenbuf);
 918                     info->kind = FML_BINARY;
 919
 920                     fml_cmd_lex (&list, &token);
 921                     assert (token.kind == 't');
 922                     info->args = fn = fml_node_alloc (fml);
 923                     fn->p[0] = token.atom;
 924                     fn->is_atom = 1;
 925
 926                     fml_cmd_lex (&list, &token);
 927                     assert (token.kind == 't');
 928                     fn = fn->p[1] = fml_node_alloc (fml);
 929                     fn->p[0] = token.atom;
 930                     fn->is_atom = 1;
 931
 932                     fml_cmd_lex (&list, &token);
 933                     assert (token.kind == 'g');
 934                     info->body = token.sub;
 935                     break;
 936                 case FML_VAR:
 937                 case FML_PREFIX:
 938                 case FML_CPREFIX:
 939                     if (token.separate && !first)
 940                         (*fml->write_func) (' ');
 941                     first = 1;
 942                     fml_emit_expr (fml, &list, &token);
 943                     fml_node_stat (fml);
 944                     continue;
 945                 case FML_FOREACH:
 946                     rv = fml_exec_foreach (info, fml, &list, &token);
 947                     if (rv)
 948                         return_value = rv;
 949                     break;
 950                 case FML_IF:
 951                     rv = fml_exec_if (info, fml, &list, &token);
 952                     if (rv)
 953                         return_value = rv;
 954                     continue;
 955                 case FML_SET:
 956                     fml_exec_set (info, fml, &list, &token);
 957                     fml_node_stat (fml);
 958                     continue;
 959                 case FML_WHILE:
 960                     rv = fml_exec_while (info, fml, &list, &token);
 961                     if (rv)
 962                         return_value = rv;
 963                     break;
 964                 case FML_RETURN:
 965                     fml_cmd_lex (&list, &token);
 966
 967                     if (token.kind == 'g')
 968                     {
 969                         return_value = fml_sub0 (fml, token.sub);
 970                         fml_cmd_lex (&list, &token);
 971                     }
 972                     else
 973                         return_value = fml_sub2 (fml, &list, &token);
 974                     if (fml->debug & 1)
 975                     {
 976                         pr_indent (1);
 977                         printf ("return of:");
 978                         fml_pr_list (return_value);
 979                         pr_indent (-1);
 980                     }
 981                     continue;
 982                 case FML_CODE:
 983                     fml_exec_group (info->body, fml);
 984                     break;
 985                 default:
 986                     printf ("<unknown token: `%s'>", token.tokenbuf);
 987                     fml_cmd_lex (&list, &token);
 988                 }
 989             }
 990             else
 991             {
 992                 printf ("<unknown %s>", token.tokenbuf);
 993             }
 994             break;
 995         case 't':
 996             if (token.separate && !first)
 997                 (*fml->write_func) (' ');
 998             first = 0;
 999             fml_emit_expr (fml, &list, &token);
1000             fml_node_stat (fml);
1001             continue;
1002         }
1003         fml_cmd_lex (&list, &token);
1004     }
1005     fml_del_token (&token, fml);
1006     return return_value;
1007 }
1008
1009 void fml_exec (Fml fml)
1010 {
1011     fml_node_stat (fml);
1012     fml_exec_group (fml->list, fml);
1013     if (fml->debug & 1)
1014         putchar ('\n');
1015 }