fml/fml.c

   1 /*
   2  * FML interpreter. Europagate, 1995
   3  *
   4  * $Log: fml.c,v $
   5  * Revision 1.4  1995/02/09 13:07:14  adam
   6  * Nodes are freed now. Many bugs fixed.
   7  *
   8  * Revision 1.3  1995/02/07  16:09:23  adam
   9  * The \ character is no longer INCLUDED when terminating a token.
  10  * Major changes in tokenization routines. Bug fixes in expressions
  11  * with lists (fml_sub0).
  12  *
  13  * Revision 1.2  1995/02/06  15:23:25  adam
  14  * Added some more relational operators (le,ne,ge). Added increment
  15  * and decrement operators. Function index changed, so that first
  16  * element is 1 - not 0. Function fml_atom_val edited.
  17  *
  18  * Revision 1.1.1.1  1995/02/06  13:48:10  adam
  19  * First version of the FML interpreter. It's slow and memory isn't
  20  * freed properly. In particular, the FML nodes aren't released yet.
  21  *
  22  */
  23 #include <assert.h>
  24 #include <stdlib.h>
  25 #include <stdio.h>
  26
  27 #include "fmlp.h"
  28
  29 static int default_read_func (void)
  30 {
  31     return getchar ();
  32 }
  33
  34 static void default_err_handle (int no)
  35 {
  36     fprintf (stderr, "Error: %d\n", no);
  37 }
  38
  39 static struct fml_node *fml_sub0 (Fml fml, struct fml_node *list);
  40 static struct fml_node *fml_sub1 (Fml fml, struct fml_node **lp,
  41                                   struct token *tp);
  42 static struct fml_node *fml_sub2 (Fml fml, struct fml_node **lp,
  43                                   struct token *tp);
  44
  45 static struct fml_node *fml_exec_space (Fml fml, struct fml_node **lp,
  46                                         struct token *tp);
  47 static struct fml_node *fml_exec_nl (Fml fml, struct fml_node **lp,
  48                                      struct token *tp);
  49 static struct fml_node *fml_exec_incr (Fml fml, struct fml_node **lp,
  50                                        struct token *tp);
  51 static struct fml_node *fml_exec_decr (Fml fml, struct fml_node **lp,
  52                                        struct token *tp);
  53
  54 static struct fml_node *fml_exec_plus (Fml fml, struct fml_node *l,
  55                                        struct fml_node *r);
  56 static struct fml_node *fml_exec_minus (Fml fml, struct fml_node *l,
  57                                         struct fml_node *r);
  58 static struct fml_node *fml_exec_gt (Fml fml, struct fml_node *l,
  59                                      struct fml_node *r);
  60 static struct fml_node *fml_exec_lt (Fml fml, struct fml_node *l,
  61                                      struct fml_node *r);
  62 static struct fml_node *fml_exec_eq (Fml fml, struct fml_node *l,
  63                                      struct fml_node *r);
  64 static struct fml_node *fml_exec_ge (Fml fml, struct fml_node *l,
  65                                      struct fml_node *r);
  66 static struct fml_node *fml_exec_le (Fml fml, struct fml_node *l,
  67                                      struct fml_node *r);
  68 static struct fml_node *fml_exec_ne (Fml fml, struct fml_node *l,
  69                                      struct fml_node *r);
  70 static struct fml_node *fml_exec_and (Fml fml, struct fml_node *l,
  71                                       struct fml_node *r);
  72 static struct fml_node *fml_exec_or (Fml fml, struct fml_node *l,
  73                                      struct fml_node *r);
  74 static struct fml_node *fml_exec_indx (Fml fml, struct fml_node *l,
  75                                      struct fml_node *r);
  76
  77 static int indent = 0;
  78
  79 static void pr_indent (int n)
  80 {
  81     assert (indent >= 0);
  82     if (n >= 0)
  83     {
  84         int i = indent;
  85         while (--i >= 0)
  86             putchar(' ');
  87     }
  88     if (n > 0)
  89     {
  90         printf ("[");
  91         ++indent;
  92     }
  93     else if (n < 0)
  94     {
  95         printf ("]\n");
  96         --indent;
  97     }
  98 }
  99
 100 Fml fml_open (void)
 101 {
 102     struct fml_sym_info *sym_info;
 103
 104     Fml fml = malloc (sizeof(*fml));
 105
 106     if (!fml)
 107         return NULL;
 108
 109     fml->escape_char = '\\';
 110     fml->comment_char = '#';
 111     fml->eof_mark = EOF;
 112     fml->white_chars = " \t\f\r\n";
 113     fml->read_func = default_read_func;
 114     fml->err_handle = default_err_handle;
 115
 116     fml->list = NULL;
 117     fml->sym_tab = fml_sym_open ();
 118     fml->atom_free_list = NULL;
 119     fml->node_free_list = NULL;
 120     fml->debug = 0;
 121
 122     sym_info = fml_sym_add (fml->sym_tab, "func");
 123     sym_info->kind = FML_FUNC;
 124     sym_info = fml_sym_add (fml->sym_tab, "bin");
 125     sym_info->kind = FML_BIN;
 126     sym_info = fml_sym_add (fml->sym_tab, "if");
 127     sym_info->kind = FML_IF;
 128     sym_info = fml_sym_add (fml->sym_tab, "else");
 129     sym_info->kind = FML_ELSE;
 130     sym_info = fml_sym_add (fml->sym_tab, "foreach");
 131     sym_info->kind = FML_FOREACH;
 132     sym_info = fml_sym_add (fml->sym_tab, "set");
 133     sym_info->kind = FML_SET;
 134     sym_info = fml_sym_add (fml->sym_tab, "while");
 135     sym_info->kind = FML_WHILE;
 136     sym_info = fml_sym_add (fml->sym_tab, "return");
 137     sym_info->kind = FML_RETURN;
 138
 139
 140     sym_info = fml_sym_add (fml->sym_tab, "and");
 141     sym_info->kind = FML_CBINARY;
 142     sym_info->binary = fml_exec_and;
 143     sym_info = fml_sym_add (fml->sym_tab, "or");
 144     sym_info->kind = FML_CBINARY;
 145     sym_info->binary = fml_exec_or;
 146     sym_info = fml_sym_add (fml->sym_tab, "index");
 147     sym_info->kind = FML_CBINARY;
 148     sym_info->binary = fml_exec_indx;
 149
 150     sym_info = fml_sym_add (fml->sym_tab, "plus");
 151     sym_info->kind = FML_CBINARY;
 152     sym_info->binary = fml_exec_plus;
 153     sym_info = fml_sym_add (fml->sym_tab, "minus");
 154     sym_info->kind = FML_CBINARY;
 155     sym_info->binary = fml_exec_minus;
 156
 157     sym_info = fml_sym_add (fml->sym_tab, "gt");
 158     sym_info->kind = FML_CBINARY;
 159     sym_info->binary = fml_exec_gt;
 160     sym_info = fml_sym_add (fml->sym_tab, "lt");
 161     sym_info->kind = FML_CBINARY;
 162     sym_info->binary = fml_exec_lt;
 163     sym_info = fml_sym_add (fml->sym_tab, "eq");
 164     sym_info->kind = FML_CBINARY;
 165     sym_info->binary = fml_exec_eq;
 166
 167     sym_info = fml_sym_add (fml->sym_tab, "ge");
 168     sym_info->kind = FML_CBINARY;
 169     sym_info->binary = fml_exec_ge;
 170     sym_info = fml_sym_add (fml->sym_tab, "le");
 171     sym_info->kind = FML_CBINARY;
 172     sym_info->binary = fml_exec_le;
 173     sym_info = fml_sym_add (fml->sym_tab, "ne");
 174     sym_info->kind = FML_CBINARY;
 175     sym_info->binary = fml_exec_ne;
 176
 177     sym_info = fml_sym_add (fml->sym_tab, "incr");
 178     sym_info->kind = FML_CPREFIX;
 179     sym_info->prefix = fml_exec_incr;
 180     sym_info = fml_sym_add (fml->sym_tab, "decr");
 181     sym_info->kind = FML_CPREFIX;
 182     sym_info->prefix = fml_exec_decr;
 183
 184     sym_info = fml_sym_add (fml->sym_tab, "s");
 185     sym_info->kind = FML_CPREFIX;
 186     sym_info->prefix = fml_exec_space;
 187     sym_info = fml_sym_add (fml->sym_tab, " ");
 188     sym_info->kind = FML_CPREFIX;
 189     sym_info->prefix = fml_exec_space;
 190     sym_info = fml_sym_add (fml->sym_tab, "n");
 191     sym_info->kind = FML_CPREFIX;
 192     sym_info->prefix = fml_exec_nl;
 193
 194     return fml;
 195 }
 196
 197 static Fml fml_pop_handler = NULL;
 198 static void pop_handler (struct fml_sym_info *info)
 199 {
 200     assert (fml_pop_handler);
 201     switch (info->kind)
 202     {
 203     case FML_VAR:
 204         fml_node_delete (fml_pop_handler, info->body);
 205         break;
 206     }
 207 }
 208 static void fml_do_pop (Fml fml)
 209 {
 210     fml_pop_handler = fml;
 211     fml_sym_pop (fml->sym_tab, pop_handler);
 212 }
 213
 214 int fml_preprocess (Fml fml)
 215 {
 216     fml->list = fml_tokenize (fml);
 217     return 0;
 218 }
 219
 220
 221 static void fml_init_token (struct token *tp, Fml fml)
 222 {
 223     tp->maxbuf = FML_ATOM_BUF*2;
 224     tp->offset = 0;
 225     tp->atombuf = tp->sbuf;
 226     tp->tokenbuf = tp->sbuf + tp->maxbuf;
 227     tp->escape_char = fml->escape_char;
 228 }
 229
 230 static void fml_del_token (struct token *tp, Fml fml)
 231 {
 232     if (tp->maxbuf != FML_ATOM_BUF*2)
 233         free (tp->atombuf);
 234 }
 235
 236 static void fml_cmd_lex (struct fml_node **np, struct token *tp)
 237 {
 238     char *cp;
 239     char *dst;
 240     if (!*np)
 241     {
 242         tp->kind = '\0';
 243         return;
 244     }
 245     if (tp->offset == 0)
 246     {
 247         tp->separate = 1;
 248         if ((*np)->is_atom)
 249         {
 250             tp->atom = (*np)->p[0];
 251             if (!tp->atom->next)
 252                 fml_atom_str (tp->atom, tp->atombuf);
 253             else
 254             {
 255                 int l = fml_atom_str (tp->atom, NULL);
 256                 if (l >= tp->maxbuf-1)
 257                 {
 258                     if (tp->maxbuf != FML_ATOM_BUF*2)
 259                         free (tp->atombuf);
 260                     tp->maxbuf = l + 40;
 261                     tp->atombuf = malloc (tp->maxbuf*2);
 262                     tp->tokenbuf = tp->atombuf + tp->maxbuf;
 263                 }
 264                 fml_atom_str (tp->atom, tp->atombuf);
 265             }
 266         }
 267         else
 268         {
 269             tp->sub = (*np)->p[0];
 270             tp->kind = 'g';
 271             *np = (*np)->p[1];
 272             return ;
 273         }
 274     }
 275     else
 276         tp->separate = 0;
 277     cp = tp->atombuf + tp->offset;
 278     dst = tp->tokenbuf;
 279     if (*cp == tp->escape_char)
 280     {
 281         tp->kind = 'e';
 282         cp++;
 283         if (*cp == '\0')
 284         {
 285             strcpy (dst, " ");
 286             tp->offset = 0;
 287             *np = (*np)->p[1];
 288             return ;
 289         }
 290     }
 291     else
 292     {
 293         tp->kind = 't';
 294     }
 295     while (*cp)
 296     {
 297         if (*cp == tp->escape_char)
 298         {
 299             *dst = '\0';
 300             tp->offset = cp - tp->atombuf;
 301             return ;
 302         }
 303         *dst++ = *cp++;
 304     }
 305     *dst = '\0';
 306     tp->offset = 0;
 307     *np = (*np)->p[1];
 308 }
 309
 310 static struct fml_node *fml_exec_group (struct fml_node *list, Fml fml);
 311
 312 static void fml_lr_values (Fml fml, struct fml_node *l, int *left_val,
 313                            struct fml_node *r, int *right_val)
 314 {
 315     if (l && l->is_atom)
 316         *left_val = fml_atom_val (l->p[0]);
 317     else
 318         *left_val = 0;
 319     if (r && r->is_atom)
 320         *right_val = fml_atom_val (r->p[0]);
 321     else
 322         *right_val = 0;
 323     fml_node_delete (fml, l);
 324     fml_node_delete (fml, r);
 325 }
 326
 327 static struct fml_node *fml_exec_and (Fml fml, struct fml_node *l,
 328                                       struct fml_node *r)
 329 {
 330     if (l && r)
 331     {
 332         fml_node_delete (fml, l);
 333         return r;
 334     }
 335     fml_node_delete (fml, l);
 336     fml_node_delete (fml, r);
 337     return NULL;
 338 }
 339
 340 static struct fml_node *fml_exec_or (Fml fml, struct fml_node *l,
 341                                       struct fml_node *r)
 342 {
 343     if (r)
 344     {
 345         fml_node_delete (fml, l);
 346         return r;
 347     }
 348     return l;
 349 }
 350
 351 static struct fml_node *fml_exec_indx (Fml fml, struct fml_node *l,
 352                                        struct fml_node *r)
 353 {
 354     struct fml_node *list = l;
 355     struct fml_node *fn;
 356     int indx;
 357
 358     if (!l || !r || !r->is_atom)
 359     {
 360         fml_node_delete (fml, l);
 361         fml_node_delete (fml, r);
 362         return NULL;
 363     }
 364     indx = fml_atom_val (r->p[0]);
 365     fml_node_delete (fml, r);
 366     while (--indx >= 1 && list)
 367         list = list->p[1];
 368     if (!list)
 369         fn = NULL;
 370     else if (list->is_atom)
 371     {
 372         fn = fml_node_alloc (fml);
 373         fn->is_atom = 1;
 374         fn->p[0] = list->p[0];
 375         list->is_atom = 0;
 376         list->p[0] = NULL;
 377     }
 378     else
 379     {
 380         fn = list->p[0];
 381         list->p[0] = NULL;
 382     }
 383     fml_node_delete (fml, l);
 384     return fn;
 385 }
 386
 387 static struct fml_node *fml_exec_plus (Fml fml, struct fml_node *l,
 388                                        struct fml_node *r)
 389 {
 390     int left_val, right_val;
 391     char arg[20];
 392     struct fml_node *fn;
 393
 394     fml_lr_values (fml, l, &left_val, r, &right_val);
 395     sprintf (arg, "%d", left_val + right_val);
 396     fn = fml_node_alloc (fml);
 397     fn->is_atom = 1;
 398     fn->p[0] = fml_atom_alloc (fml, arg);
 399     return fn;
 400 }
 401
 402 static struct fml_node *fml_exec_minus (Fml fml, struct fml_node *l,
 403                                        struct fml_node *r)
 404 {
 405     int left_val, right_val;
 406     char arg[20];
 407     struct fml_node *fn;
 408
 409     fml_lr_values (fml, l, &left_val, r, &right_val);
 410     sprintf (arg, "%d", left_val - right_val);
 411     fn = fml_node_alloc (fml);
 412     fn->is_atom = 1;
 413     fn->p[0] = fml_atom_alloc (fml, arg);
 414     return fn;
 415 }
 416
 417
 418 static struct fml_node *fml_exec_gt (Fml fml, struct fml_node *l,
 419                                      struct fml_node *r)
 420 {
 421     int left_val, right_val;
 422     struct fml_node *fn;
 423     fml_lr_values (fml, l, &left_val, r, &right_val);
 424     if (left_val > right_val)
 425     {
 426         fn = fml_node_alloc (fml);
 427         fn->is_atom = 1;
 428         fn->p[0] = fml_atom_alloc (fml, "1");
 429     }
 430     else
 431         fn = NULL;
 432     return fn;
 433 }
 434
 435
 436 static struct fml_node *fml_exec_lt (Fml fml, struct fml_node *l,
 437                                      struct fml_node *r)
 438 {
 439     int left_val, right_val;
 440     struct fml_node *fn;
 441     fml_lr_values (fml, l, &left_val, r, &right_val);
 442     if (left_val < right_val)
 443     {
 444         fn = fml_node_alloc (fml);
 445         fn->is_atom = 1;
 446         fn->p[0] = fml_atom_alloc (fml, "1");
 447     }
 448     else
 449         fn = NULL;
 450     return fn;
 451 }
 452
 453 static struct fml_node *fml_exec_eq (Fml fml, struct fml_node *l,
 454                                      struct fml_node *r)
 455 {
 456     int left_val, right_val;
 457     struct fml_node *fn;
 458     fml_lr_values (fml, l, &left_val, r, &right_val);
 459     if (left_val == right_val)
 460     {
 461         fn = fml_node_alloc (fml);
 462         fn->is_atom = 1;
 463         fn->p[0] = fml_atom_alloc (fml, "1");
 464     }
 465     else
 466         fn = NULL;
 467     return fn;
 468 }
 469
 470 static struct fml_node *fml_exec_ne (Fml fml, struct fml_node *l,
 471                                      struct fml_node *r)
 472 {
 473     int left_val, right_val;
 474     struct fml_node *fn;
 475     fml_lr_values (fml, l, &left_val, r, &right_val);
 476     if (left_val != right_val)
 477     {
 478         fn = fml_node_alloc (fml);
 479         fn->is_atom = 1;
 480         fn->p[0] = fml_atom_alloc (fml, "1");
 481     }
 482     else
 483         fn = NULL;
 484     return fn;
 485 }
 486
 487 static struct fml_node *fml_exec_le (Fml fml, struct fml_node *l,
 488                                      struct fml_node *r)
 489 {
 490     int left_val, right_val;
 491     struct fml_node *fn;
 492     fml_lr_values (fml, l, &left_val, r, &right_val);
 493     if (left_val <= right_val)
 494     {
 495         fn = fml_node_alloc (fml);
 496         fn->is_atom = 1;
 497         fn->p[0] = fml_atom_alloc (fml, "1");
 498     }
 499     else
 500         fn = NULL;
 501     return fn;
 502 }
 503
 504 static struct fml_node *fml_exec_ge (Fml fml, struct fml_node *l,
 505                                      struct fml_node *r)
 506 {
 507     int left_val, right_val;
 508     struct fml_node *fn;
 509     fml_lr_values (fml, l, &left_val, r, &right_val);
 510     if (left_val >= right_val)
 511     {
 512         fn = fml_node_alloc (fml);
 513         fn->is_atom = 1;
 514         fn->p[0] = fml_atom_alloc (fml, "1");
 515     }
 516     else
 517         fn = NULL;
 518     return fn;
 519 }
 520
 521
 522 static struct fml_node *fml_exec_space (Fml fml, struct fml_node **lp,
 523                                         struct token *tp)
 524 {
 525     putchar ('_');
 526     return NULL;
 527 }
 528
 529 static struct fml_node *fml_exec_nl (Fml fml, struct fml_node **lp,
 530                                      struct token *tp)
 531 {
 532     putchar ('\n');
 533     return NULL;
 534 }
 535
 536 static struct fml_node *fml_exec_incr (Fml fml, struct fml_node **lp,
 537                                        struct token *tp)
 538 {
 539     struct fml_node *fn = NULL;
 540     struct fml_sym_info *info;
 541     fml_cmd_lex (lp, tp);
 542     if (tp->kind == 'e')
 543     {
 544         info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
 545         assert (info);
 546         if (info->kind == FML_VAR && info->body && info->body->is_atom)
 547         {
 548             char arg[128];
 549             int val;
 550
 551             val = fml_atom_val (info->body->p[0]);
 552             fml_node_delete (fml, info->body);
 553             sprintf (arg, "%d", val+1);
 554             info->body = fn = fml_node_alloc (fml);
 555             fn->is_atom = 1;
 556             fn->p[0] = fml_atom_alloc (fml, arg);
 557         }
 558     }
 559     return NULL;
 560 }
 561
 562 static struct fml_node *fml_exec_decr (Fml fml, struct fml_node **lp,
 563                                        struct token *tp)
 564 {
 565     struct fml_node *fn = NULL;
 566     struct fml_sym_info *info;
 567     fml_cmd_lex (lp, tp);
 568     if (tp->kind == 'e')
 569     {
 570         info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
 571         assert (info);
 572         if (info->kind == FML_VAR && info->body && info->body->is_atom)
 573         {
 574             char arg[128];
 575             int val;
 576
 577             val = fml_atom_val (info->body->p[0]);
 578             sprintf (arg, "%d", val-1);
 579             info->body = fn = fml_node_alloc (fml);
 580             fn->is_atom = 1;
 581             fn->p[0] = fml_atom_alloc (fml, arg);
 582         }
 583     }
 584     return NULL;
 585 }
 586
 587 static struct fml_node *fml_exec_prefix (struct fml_sym_info *info, Fml fml,
 588                                          struct fml_node **lp,
 589                                          struct token *tp)
 590 {
 591     struct fml_node *fn;
 592     struct fml_sym_info *arg_info;
 593     struct fml_node *return_value;
 594     static char arg[128];
 595
 596     if (fml->debug & 1)
 597     {
 598         pr_indent (1);
 599         printf ("exec_prefix ");
 600     }
 601     fml_sym_push (fml->sym_tab);
 602     fml_cmd_lex (lp, tp);
 603     for (fn = info->args; fn; fn = fn->p[1])
 604     {
 605
 606         assert (fn->is_atom);
 607         fml_atom_strx (fn->p[0], arg, 127);
 608         if (fml->debug & 1)
 609         {
 610             pr_indent (1);
 611             printf ("%s=", arg);
 612         }
 613         arg_info = fml_sym_add_local (fml->sym_tab, arg);
 614         arg_info->kind = FML_VAR;
 615
 616         if (tp->kind == 'g')
 617         {
 618             arg_info->body = fml_sub0 (fml, tp->sub);
 619             fml_cmd_lex (lp, tp);
 620         }
 621         else
 622             arg_info->body = fml_sub2 (fml, lp, tp);
 623         if (fml->debug & 1)
 624         {
 625             fml_pr_list (arg_info->body);
 626             pr_indent (-1);
 627         }
 628     }
 629     return_value = fml_exec_group (info->body, fml);
 630     if (fml->debug & 1)
 631     {
 632         pr_indent(0);
 633         pr_indent (-1);
 634     }
 635     fml_do_pop (fml);
 636     return return_value;
 637 }
 638
 639
 640 static void fml_emit (struct fml_node *list)
 641 {
 642     int s = 0;
 643     while (list)
 644     {
 645         if (list->is_atom)
 646         {
 647             struct fml_atom *a;
 648             if (s)
 649                 printf (" ");
 650             s++;
 651             for (a = list->p[0]; a; a=a->next)
 652                 printf ("%s", a->buf);
 653         }
 654         else
 655             fml_emit (list->p[0]);
 656         list = list->p[1];
 657     }
 658 }
 659
 660
 661 static struct fml_node *fml_sub2 (Fml fml, struct fml_node **lp,
 662                                   struct token *tp)
 663 {
 664     struct fml_node *fn;
 665     struct fml_sym_info *info;
 666     if (tp->kind == 'e')
 667     {
 668         info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
 669         assert (info);
 670         switch (info->kind)
 671         {
 672         case FML_VAR:
 673             fn = fml_node_copy (fml, info->body);
 674             fml_cmd_lex (lp, tp);
 675             break;
 676         case FML_PREFIX:
 677             fn = fml_exec_prefix (info, fml, lp, tp);
 678             break;
 679         case FML_CPREFIX:
 680             fn = (*info->prefix) (fml, lp, tp);
 681             fml_cmd_lex (lp, tp);
 682             break;
 683         default:
 684             fml_cmd_lex (lp, tp);
 685             fn = NULL;
 686         }
 687     }
 688     else if (tp->kind == 'g')
 689     {
 690         if (tp->sub)
 691             fn = fml_sub0 (fml, tp->sub);
 692         else
 693             fn = NULL;
 694         fml_cmd_lex (lp, tp);
 695     }
 696     else if (tp->kind == 't')
 697     {
 698         fn = fml_node_alloc (fml);
 699         fn->is_atom = 1;
 700         fn->p[0] = fml_atom_alloc (fml, tp->tokenbuf);
 701         fml_cmd_lex (lp, tp);
 702     }
 703     else
 704         fn = NULL;
 705     return fn;
 706 }
 707
 708 static struct fml_node *fml_sub1 (Fml fml, struct fml_node **lp,
 709                                   struct token *tp)
 710 {
 711     struct fml_node *f1, *f2, *fn;
 712     struct fml_sym_info *info;
 713
 714     f1 = fml_sub2 (fml, lp, tp);
 715     while (tp->kind == 'e')
 716     {
 717         info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
 718         if (!info)
 719         {
 720             fprintf (stderr, "cannot locate `%s'", tp->tokenbuf);
 721             exit (1);
 722         }
 723         if (info->kind == FML_CBINARY)
 724         {
 725             fml_cmd_lex (lp, tp);
 726             f2 = fml_sub2 (fml, lp, tp);
 727             fn = (*info->binary) (fml, f1, f2);
 728             f1 = fn;
 729             continue;
 730         }
 731         else if (info->kind == FML_BINARY)
 732         {
 733             struct fml_sym_info *arg_info;
 734             char arg[127];
 735
 736             if (fml->debug & 1)
 737             {
 738                 pr_indent (1);
 739                 printf ("exec binary %s", tp->tokenbuf);
 740             }
 741             fml_cmd_lex (lp, tp);
 742             f2 = fml_sub2 (fml, lp, tp);
 743             fml_sym_push (fml->sym_tab);
 744
 745             fml_atom_strx (info->args->p[0], arg, 127);
 746             arg_info = fml_sym_add_local (fml->sym_tab, arg);
 747             arg_info->kind = FML_VAR;
 748             arg_info->body = f1;
 749             if (fml->debug & 1)
 750             {
 751                 printf (" left=");
 752                 fml_pr_list (f1);
 753             }
 754             fml_atom_strx ( ((struct fml_node *) info->args->p[1])->p[0],
 755                            arg, 127);
 756             arg_info = fml_sym_add_local (fml->sym_tab, arg);
 757             arg_info->kind = FML_VAR;
 758             arg_info->body = f2;
 759             if (fml->debug & 1)
 760             {
 761                 printf (" right=");
 762                 fml_pr_list (f2);
 763                 putchar ('\n');
 764             }
 765             f1 = fml_exec_group (info->body, fml);
 766             fml_do_pop (fml);
 767             if (fml->debug & 1)
 768             {
 769                 pr_indent (0);
 770                 pr_indent (-1);
 771             }
 772         }
 773         else
 774             break;
 775     }
 776     return f1;
 777 }
 778
 779 #if 0
 780 static struct fml_node *fml_sub0 (Fml fml, struct fml_node *list)
 781 {
 782     struct token token;
 783     struct fml_node *fn, *fn1;
 784
 785     fml_init_token (&token, fml);
 786     assert (list);
 787     fml_cmd_lex (&list, &token);
 788     fn = fml_sub1 (fml, &list, &token);
 789     if (token.kind == '\0')
 790     {
 791         fml_del_token (&token, fml);
 792         return fn;
 793     }
 794     fn1 = fml_node_alloc (fml);
 795     fn1->p[0] = fn;
 796     fn = fn1;
 797     while (token.kind != '\0')
 798     {
 799         fn1 = fn1->p[1] = fml_node_alloc (fml);
 800         fn1->p[0] = fml_sub1 (fml, &list, &token);
 801     }
 802     fml_del_token (&token, fml);
 803     return fn;
 804 }
 805 #else
 806 static struct fml_node *fml_sub0 (Fml fml, struct fml_node *list)
 807 {
 808     struct token token;
 809     struct fml_node *fn, *fn0, *fn1;
 810
 811     if (!list)
 812         return NULL;
 813     fml_init_token (&token, fml);
 814     assert (list);
 815     fml_cmd_lex (&list, &token);
 816     fn1 = fn = fml_sub1 (fml, &list, &token);
 817     if (fn->p[1] && token.kind != '\0')
 818     {
 819         fn1 = fml_node_alloc (fml);
 820         fn1->p[0] = fn;
 821     }
 822     fn0 = fn1;
 823     while (token.kind != '\0')
 824     {
 825         fn = fml_sub1 (fml, &list, &token);
 826         if (fn->p[1])
 827         {
 828             fn1 = fn1->p[1] = fml_node_alloc (fml);
 829             fn1->p[0] = fn;
 830         }
 831         else
 832         {
 833             fn1 = fn1->p[1] = fn;
 834         }
 835     }
 836     fml_del_token (&token, fml);
 837     return fn0;
 838 }
 839 #endif
 840
 841 static struct fml_node *fml_exec_foreach (struct fml_sym_info *info, Fml fml,
 842                                           struct fml_node **lp,
 843                                           struct token *tp)
 844 {
 845     struct fml_sym_info *info_var;
 846     struct fml_node *fn, *body;
 847     struct fml_node *return_value = NULL, *rv;
 848
 849     fml_cmd_lex (lp, tp);
 850     assert (tp->kind == 't');
 851
 852     info_var = fml_sym_lookup_local (fml->sym_tab, tp->tokenbuf);
 853     if (!info_var)
 854     {
 855         info_var = fml_sym_add_local (fml->sym_tab, tp->tokenbuf);
 856         info_var->body = NULL;
 857         info_var->kind = FML_VAR;
 858     }
 859     else
 860     {
 861         fml_node_delete (fml, info->body);
 862         info->body = NULL;
 863     }
 864     if (fml->debug & 1)
 865     {
 866         pr_indent (1);
 867         printf ("[foreach %s ", tp->tokenbuf);
 868     }
 869     fml_cmd_lex (lp, tp);
 870     assert (tp->kind == 'g');
 871     fn = fml_sub0 (fml, tp->sub);
 872
 873     fml_cmd_lex (lp, tp);
 874     assert (tp->kind == 'g');
 875     body = tp->sub;
 876
 877     while (fn)
 878     {
 879         struct fml_node *fn1;
 880
 881         fn1 = fn->p[1];
 882         fn->p[1] = NULL;
 883         if (fn->is_atom)
 884             info_var->body = fn;
 885         else
 886             info_var->body = fn->p[0];
 887         if (fml->debug & 1)
 888         {
 889             pr_indent (1);
 890             printf ("[foreach loop var=");
 891             fml_pr_list (info_var->body);
 892             pr_indent (-1);
 893         }
 894         rv = fml_exec_group (body, fml);
 895         if (rv)
 896             return_value = rv;
 897         fml_node_delete (fml, fn);
 898         fn = fn1;
 899     }
 900     info_var->body = NULL;
 901     if (fml->debug & 1)
 902         pr_indent (-1);
 903     return return_value;
 904 }
 905
 906 static struct fml_node *fml_exec_if (struct fml_sym_info *info, Fml fml,
 907                                      struct fml_node **lp, struct token *tp)
 908 {
 909     struct fml_node *fn, *body;
 910     struct fml_node *rv, *return_value = NULL;
 911
 912     fml_cmd_lex (lp, tp);
 913     assert (tp->kind == 'g');
 914     fn = fml_sub0 (fml, tp->sub);
 915     fml_cmd_lex (lp, tp);
 916     assert (tp->kind == 'g');
 917     if (fn)
 918     {
 919         rv = fml_exec_group (tp->sub, fml);
 920         if (rv)
 921             return_value = rv;
 922     }
 923     fml_cmd_lex (lp, tp);
 924     if (tp->kind == 'e')
 925     {
 926         info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
 927         if (info->kind == FML_ELSE)
 928         {
 929             fml_cmd_lex (lp, tp);
 930             assert (tp->kind == 'g');
 931             body = tp->sub;
 932             if (!fn)
 933             {
 934                 rv = fml_exec_group (body, fml);
 935                 if (rv)
 936                     return_value = rv;
 937             }
 938             fml_cmd_lex (lp, tp);
 939         }
 940     }
 941     fml_node_delete (fml, fn);
 942     return return_value;
 943 }
 944
 945 static struct fml_node *fml_exec_while (struct fml_sym_info *info, Fml fml,
 946                                         struct fml_node **lp, struct token *tp)
 947 {
 948     struct fml_node *fn, *body;
 949     struct fml_node *return_value = NULL;
 950
 951     fml_cmd_lex (lp, tp);
 952     assert (tp->kind == 'g');
 953     fn = tp->sub;
 954
 955     fml_cmd_lex (lp, tp);
 956     assert (tp->kind == 'g');
 957     body = tp->sub;
 958     assert (tp->sub);
 959     while (1)
 960     {
 961         struct fml_node *fn_expr;
 962         struct fml_node *rv;
 963         if (!fn)
 964             break;
 965         fn_expr = fml_sub0 (fml, fn);
 966         if (!fn_expr)
 967             break;
 968         fml_node_delete (fml, fn_expr);
 969         rv = fml_exec_group (body, fml);
 970         if (rv)
 971             return_value = rv;
 972     }
 973     return return_value;
 974 }
 975
 976 static void fml_exec_set (struct fml_sym_info *info, Fml fml,
 977                     struct fml_node **lp, struct token *tp)
 978 {
 979     struct fml_node *fn;
 980     struct fml_sym_info *info_var;
 981
 982     fml_cmd_lex (lp, tp);
 983     info_var = fml_sym_lookup_local (fml->sym_tab, tp->tokenbuf);
 984     if (!info_var)
 985     {
 986         info_var = fml_sym_add_local (fml->sym_tab, tp->tokenbuf);
 987         info_var->body = NULL;
 988     }
 989     if (fml->debug & 1)
 990     {
 991         pr_indent (1);
 992         printf ("set %s ", tp->tokenbuf);
 993     }
 994     info_var->kind = FML_VAR;
 995     fml_cmd_lex (lp, tp);
 996
 997     if (tp->kind == 'g')
 998     {
 999         fn = fml_sub0 (fml, tp->sub);
1000         fml_cmd_lex (lp, tp);
1001     }
1002     else
1003         fn = fml_sub2 (fml, lp, tp);
1004     fml_node_delete (fml, info_var->body);
1005     info_var->body = fn;
1006     if (fml->debug & 1)
1007     {
1008         fml_pr_list (info_var->body);
1009         pr_indent (-1);
1010     }
1011 }
1012
1013 static void fml_emit_expr (Fml fml, struct fml_node **lp, struct token *tp)
1014 {
1015     struct fml_node *fn;
1016
1017     fn = fml_sub1 (fml, lp, tp);
1018     fml_emit (fn);
1019     fml_node_delete (fml, fn);
1020 }
1021
1022 static struct fml_node *fml_exec_group (struct fml_node *list, Fml fml)
1023 {
1024     struct token token;
1025     struct fml_sym_info *info;
1026     int first = 1;
1027     struct fml_node *return_value = NULL, *rv;
1028
1029     if (!list)
1030         return NULL;
1031     fml_init_token (&token, fml);
1032     fml_cmd_lex (&list, &token);
1033     while (token.kind)
1034     {
1035         switch (token.kind)
1036         {
1037         case 'g':
1038             rv = fml_exec_group (token.sub, fml);
1039             if (rv)
1040                 return_value = rv;
1041             break;
1042         case 'e':
1043             info = fml_sym_lookup (fml->sym_tab, token.tokenbuf);
1044             if (info)
1045             {
1046                 struct fml_node *fn;
1047
1048                 switch (info->kind)
1049                 {
1050                 case FML_FUNC:
1051                     fml_cmd_lex (&list, &token);
1052                     assert (token.kind == 't');
1053                     info = fml_sym_lookup (fml->sym_tab, token.tokenbuf);
1054                     if (!info)
1055                         info = fml_sym_add (fml->sym_tab, token.tokenbuf);
1056                     info->kind = FML_PREFIX;
1057                     info->args = NULL;
1058                     while (1)
1059                     {
1060                         fml_cmd_lex (&list, &token);
1061                         if (token.kind != 't')
1062                             break;
1063                         if (!info->args)
1064                         {
1065                             info->args = fn = fml_node_alloc (fml);
1066                         }
1067                         else
1068                         {
1069                             for (fn = info->args; fn->p[1]; fn=fn->p[1])
1070                                 ;
1071                             fn = fn->p[1] = fml_node_alloc (fml);
1072                         }
1073                         fn->p[0] = token.atom;
1074                         fn->is_atom = 1;
1075                     }
1076                     assert (token.kind == 'g');
1077                     info->body = token.sub;
1078                     break;
1079                 case FML_BIN:
1080                     fml_cmd_lex (&list, &token);
1081                     assert (token.kind == 't');
1082                     info = fml_sym_lookup (fml->sym_tab, token.tokenbuf);
1083                     if (!info)
1084                         info = fml_sym_add (fml->sym_tab, token.tokenbuf);
1085                     info->kind = FML_BINARY;
1086
1087                     fml_cmd_lex (&list, &token);
1088                     assert (token.kind == 't');
1089                     info->args = fn = fml_node_alloc (fml);
1090                     fn->p[0] = token.atom;
1091                     fn->is_atom = 1;
1092
1093                     fml_cmd_lex (&list, &token);
1094                     assert (token.kind == 't');
1095                     fn = fn->p[1] = fml_node_alloc (fml);
1096                     fn->p[0] = token.atom;
1097                     fn->is_atom = 1;
1098
1099                     fml_cmd_lex (&list, &token);
1100                     assert (token.kind == 'g');
1101                     info->body = token.sub;
1102                     break;
1103                 case FML_VAR:
1104                 case FML_PREFIX:
1105                 case FML_CPREFIX:
1106                     if (token.separate && !first)
1107                         putchar (' ');
1108                     first = 1;
1109                     fml_emit_expr (fml, &list, &token);
1110                     fml_node_stat (fml);
1111                     continue;
1112                 case FML_FOREACH:
1113                     rv = fml_exec_foreach (info, fml, &list, &token);
1114                     if (rv)
1115                         return_value = rv;
1116                     break;
1117                 case FML_IF:
1118                     rv = fml_exec_if (info, fml, &list, &token);
1119                     if (rv)
1120                         return_value = rv;
1121                     continue;
1122                 case FML_SET:
1123                     fml_exec_set (info, fml, &list, &token);
1124                     fml_node_stat (fml);
1125                     continue;
1126                 case FML_WHILE:
1127                     rv = fml_exec_while (info, fml, &list, &token);
1128                     if (rv)
1129                         return_value = rv;
1130                     break;
1131                 case FML_RETURN:
1132                     fml_cmd_lex (&list, &token);
1133
1134                     if (token.kind == 'g')
1135                     {
1136                         return_value = fml_sub0 (fml, token.sub);
1137                         fml_cmd_lex (&list, &token);
1138                     }
1139                     else
1140                         return_value = fml_sub2 (fml, &list, &token);
1141                     if (fml->debug & 1)
1142                     {
1143                         pr_indent (1);
1144                         printf ("return of:");
1145                         fml_pr_list (return_value);
1146                         pr_indent (-1);
1147                     }
1148                     continue;
1149                 default:
1150                     printf ("unknown token: `%s'", token.tokenbuf);
1151                     fml_cmd_lex (&list, &token);
1152                 }
1153             }
1154             else
1155             {
1156                 printf ("<unknown>");
1157             }
1158             break;
1159         case 't':
1160 #if 0
1161             printf ("<token.tokenbuf=%s>", token.tokenbuf);
1162 #endif
1163             if (token.separate && !first)
1164                 putchar (' ');
1165             first = 0;
1166             fml_emit_expr (fml, &list, &token);
1167             fml_node_stat (fml);
1168             continue;
1169         }
1170         fml_cmd_lex (&list, &token);
1171     }
1172     fml_del_token (&token, fml);
1173     return return_value;
1174 }
1175
1176 void fml_exec (Fml fml)
1177 {
1178     fml_node_stat (fml);
1179     fml_exec_group (fml->list, fml);
1180     if (fml->debug & 1)
1181         printf ("\n");
1182 }
1183
1184