fml/fml.c

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