fml/fml.c

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