fml/fml.c

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