fml/fml.c

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