fml/fml.c

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