fml/fml.c

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