--- /dev/null
+/*
+ * FML interpreter. Europagate, 1995
+ *
+ * $Log: fml.c,v $
+ * Revision 1.1 1995/02/06 13:48:09 adam
+ * Initial revision
+ *
+ */
+#include <assert.h>
+#include <stdlib.h>
+#include <stdio.h>
+
+#include "fmlp.h"
+
+static int default_read_func (void)
+{
+ return getchar ();
+}
+
+static void default_err_handle (int no)
+{
+ fprintf (stderr, "Error: %d\n", no);
+}
+
+static struct fml_node *fml_exec_space (Fml fml, struct fml_node **lp,
+ struct token *tp);
+static struct fml_node *fml_exec_nl (Fml fml, struct fml_node **lp,
+ struct token *tp);
+#if 0
+static struct fml_node *fml_sub_bad (Fml fml, struct fml_node *list);
+#endif
+static struct fml_node *fml_sub0 (Fml fml, struct fml_node *list);
+
+static struct fml_node *fml_exec_plus (Fml fml, struct fml_node *l,
+ struct fml_node *r);
+static struct fml_node *fml_exec_minus (Fml fml, struct fml_node *l,
+ struct fml_node *r);
+static struct fml_node *fml_exec_gt (Fml fml, struct fml_node *l,
+ struct fml_node *r);
+static struct fml_node *fml_exec_lt (Fml fml, struct fml_node *l,
+ struct fml_node *r);
+static struct fml_node *fml_exec_eq (Fml fml, struct fml_node *l,
+ struct fml_node *r);
+static struct fml_node *fml_exec_and (Fml fml, struct fml_node *l,
+ struct fml_node *r);
+static struct fml_node *fml_exec_or (Fml fml, struct fml_node *l,
+ struct fml_node *r);
+static struct fml_node *fml_exec_indx (Fml fml, struct fml_node *l,
+ struct fml_node *r);
+
+static int indent = 0;
+
+static void pr_indent (int n)
+{
+ assert (indent >= 0);
+ if (n >= 0)
+ {
+ int i = indent;
+ while (--i >= 0)
+ putchar (' ');
+ }
+ if (n > 0)
+ {
+ printf ("[");
+ ++indent;
+ }
+ else if (n < 0)
+ {
+ printf ("]\n");
+ --indent;
+ }
+}
+
+Fml fml_open (void)
+{
+ struct fml_sym_info *sym_info;
+
+ Fml fml = malloc (sizeof(*fml));
+
+ if (!fml)
+ return NULL;
+
+ fml->escape_char = '\\';
+ fml->comment_char = '#';
+ fml->eof_mark = EOF;
+ fml->white_chars = " \t\f\r\n";
+ fml->read_func = default_read_func;
+ fml->err_handle = default_err_handle;
+
+ fml->list = NULL;
+ fml->sym_tab = fml_sym_open ();
+ fml->atom_free_list = NULL;
+ fml->node_free_list = NULL;
+ fml->debug = 0;
+
+ sym_info = fml_sym_add (fml->sym_tab, "func");
+ sym_info->kind = FML_FUNC;
+ sym_info = fml_sym_add (fml->sym_tab, "bin");
+ sym_info->kind = FML_BIN;
+ sym_info = fml_sym_add (fml->sym_tab, "if");
+ sym_info->kind = FML_IF;
+ sym_info = fml_sym_add (fml->sym_tab, "else");
+ sym_info->kind = FML_ELSE;
+ sym_info = fml_sym_add (fml->sym_tab, "foreach");
+ sym_info->kind = FML_FOREACH;
+ sym_info = fml_sym_add (fml->sym_tab, "set");
+ sym_info->kind = FML_SET;
+ sym_info = fml_sym_add (fml->sym_tab, "while");
+ sym_info->kind = FML_WHILE;
+ sym_info = fml_sym_add (fml->sym_tab, "return");
+ sym_info->kind = FML_RETURN;
+
+
+ sym_info = fml_sym_add (fml->sym_tab, "and");
+ sym_info->kind = FML_CBINARY;
+ sym_info->binary = fml_exec_and;
+ sym_info = fml_sym_add (fml->sym_tab, "or");
+ sym_info->kind = FML_CBINARY;
+ sym_info->binary = fml_exec_or;
+ sym_info = fml_sym_add (fml->sym_tab, "index");
+ sym_info->kind = FML_CBINARY;
+ sym_info->binary = fml_exec_indx;
+
+ sym_info = fml_sym_add (fml->sym_tab, "plus");
+ sym_info->kind = FML_CBINARY;
+ sym_info->binary = fml_exec_plus;
+ sym_info = fml_sym_add (fml->sym_tab, "minus");
+ sym_info->kind = FML_CBINARY;
+ sym_info->binary = fml_exec_minus;
+
+ sym_info = fml_sym_add (fml->sym_tab, "gt");
+ sym_info->kind = FML_CBINARY;
+ sym_info->binary = fml_exec_gt;
+ sym_info = fml_sym_add (fml->sym_tab, "lt");
+ sym_info->kind = FML_CBINARY;
+ sym_info->binary = fml_exec_lt;
+ sym_info = fml_sym_add (fml->sym_tab, "eq");
+ sym_info->kind = FML_CBINARY;
+ sym_info->binary = fml_exec_eq;
+
+ sym_info = fml_sym_add (fml->sym_tab, "s");
+ sym_info->kind = FML_CPREFIX;
+ sym_info->prefix = fml_exec_space;
+ sym_info = fml_sym_add (fml->sym_tab, " ");
+ sym_info->kind = FML_CPREFIX;
+ sym_info->prefix = fml_exec_space;
+ sym_info = fml_sym_add (fml->sym_tab, "n");
+ sym_info->kind = FML_CPREFIX;
+ sym_info->prefix = fml_exec_nl;
+
+ return fml;
+}
+
+static Fml fml_pop_handler = NULL;
+static void pop_handler (struct fml_sym_info *info)
+{
+ assert (fml_pop_handler);
+ switch (info->kind)
+ {
+ case FML_VAR:
+/* fml_node_delete (fml_pop_handler, info->body); */
+ break;
+ }
+}
+static void fml_do_pop (Fml fml)
+{
+ fml_pop_handler = fml;
+ fml_sym_pop (fml->sym_tab, pop_handler);
+}
+
+int fml_preprocess (Fml fml)
+{
+ fml->list = fml_tokenize (fml);
+ return 0;
+}
+
+
+static void fml_init_token (struct token *tp, Fml fml)
+{
+ tp->maxbuf = FML_ATOM_BUF*2;
+ tp->offset = 0;
+ tp->atombuf = tp->sbuf;
+ tp->tokenbuf = tp->sbuf + tp->maxbuf;
+ tp->escape_char = fml->escape_char;
+}
+
+static void fml_del_token (struct token *tp, Fml fml)
+{
+ if (tp->maxbuf != FML_ATOM_BUF*2)
+ free (tp->atombuf);
+}
+
+static void fml_cmd_lex (struct fml_node **np, struct token *tp)
+{
+ char *cp;
+ char *dst;
+ if (!*np)
+ {
+ tp->kind = '\0';
+ return;
+ }
+ if (tp->offset == 0)
+ {
+ if ((*np)->is_atom)
+ {
+ tp->atom = (*np)->p[0];
+ if (!tp->atom->next)
+ fml_atom_str (tp->atom, tp->atombuf);
+ else
+ {
+ int l = fml_atom_str (tp->atom, NULL);
+ if (l >= tp->maxbuf-1)
+ {
+ if (tp->maxbuf != FML_ATOM_BUF*2)
+ free (tp->atombuf);
+ tp->maxbuf = l + 40;
+ tp->atombuf = malloc (tp->maxbuf*2);
+ tp->tokenbuf = tp->atombuf + tp->maxbuf;
+ }
+ fml_atom_str (tp->atom, tp->atombuf);
+ }
+ }
+ else
+ {
+ tp->sub = (*np)->p[0];
+ tp->kind = 'g';
+ *np = (*np)->p[1];
+ return ;
+ }
+ }
+ cp = tp->atombuf + tp->offset;
+ dst = tp->tokenbuf;
+ if (*cp == tp->escape_char)
+ {
+ tp->kind = 'e';
+ tp->after_char = '\0';
+ cp++;
+ if (*cp == '\0')
+ {
+ strcpy (dst, " ");
+ tp->offset = 0;
+ *np = (*np)->p[1];
+ return ;
+ }
+ }
+ else
+ {
+ tp->kind = 't';
+ tp->after_char = ' ';
+ }
+ while (*cp)
+ {
+ if (*cp == tp->escape_char)
+ {
+ *dst = '\0';
+#if 0
+ if (cp[1] == '\0')
+ {
+ tp->after_char = ' ';
+ break;
+ }
+#endif
+ if (tp->kind == 'e')
+ {
+ cp++;
+ if (! *cp)
+ break;
+ }
+ tp->offset = cp - tp->atombuf;
+ tp->after_char = '\0';
+ return ;
+ }
+ *dst++ = *cp++;
+ }
+ *dst = '\0';
+ tp->offset = 0;
+ *np = (*np)->p[1];
+}
+
+static struct fml_node *fml_lex_list (Fml fml, struct token *tp)
+{
+ struct fml_node *fn;
+
+ if (tp->kind == 'g')
+ return tp->sub;
+ fn = fml_node_alloc (fml);
+ fn->is_atom = 1;
+ fn->p[0] = tp->atom;
+ return fn;
+}
+
+static struct fml_node *fml_exec_group (struct fml_node *list, Fml fml);
+
+static void fml_lr_values (struct fml_node *l, int *left_val,
+ struct fml_node *r, int *right_val)
+{
+ static char arg[128];
+ if (l->is_atom)
+ {
+ fml_atom_strx (l->p[0], arg, 127);
+ *left_val = atoi (arg);
+ }
+ else
+ *left_val = 0;
+ if (r->is_atom)
+ {
+ fml_atom_strx (r->p[0], arg, 127);
+ *right_val = atoi (arg);
+ }
+ else
+ *right_val = 0;
+}
+
+static struct fml_node *fml_exec_and (Fml fml, struct fml_node *l,
+ struct fml_node *r)
+{
+ if (l && r)
+ return r;
+ else
+ return NULL;
+}
+
+static struct fml_node *fml_exec_or (Fml fml, struct fml_node *l,
+ struct fml_node *r)
+{
+ if (l)
+ return l;
+ return r;
+}
+
+static struct fml_node *fml_exec_indx (Fml fml, struct fml_node *l,
+ struct fml_node *r)
+{
+ struct fml_node *list = l;
+ int indx;
+
+ if (!l || !r || !r->is_atom)
+ return NULL;
+ indx = fml_atom_val (r->p[0]);
+ while (--indx >= 0 && list)
+ list = list->p[1];
+ if (!list)
+ return NULL;
+ if (list->is_atom)
+ {
+ struct fml_node *fn = fml_node_alloc (fml);
+ fn->is_atom = 1;
+ fn->p[0] = list->p[0];
+ return fn;
+ }
+ else
+ return list->p[0];
+}
+
+static struct fml_node *fml_exec_plus (Fml fml, struct fml_node *l,
+ struct fml_node *r)
+{
+ int left_val, right_val;
+ char arg[20];
+ struct fml_node *fn;
+
+ fml_lr_values (l, &left_val, r, &right_val);
+ sprintf (arg, "%d", left_val + right_val);
+ fn = fml_node_alloc (fml);
+ fn->is_atom = 1;
+ fn->p[0] = fml_atom_alloc (fml, arg);
+ return fn;
+}
+
+static struct fml_node *fml_exec_minus (Fml fml, struct fml_node *l,
+ struct fml_node *r)
+{
+ int left_val, right_val;
+ char arg[20];
+ struct fml_node *fn;
+
+ fml_lr_values (l, &left_val, r, &right_val);
+ sprintf (arg, "%d", left_val - right_val);
+ fn = fml_node_alloc (fml);
+ fn->is_atom = 1;
+ fn->p[0] = fml_atom_alloc (fml, arg);
+ return fn;
+}
+
+
+static struct fml_node *fml_exec_gt (Fml fml, struct fml_node *l,
+ struct fml_node *r)
+{
+ int left_val, right_val;
+ struct fml_node *fn;
+ fml_lr_values (l, &left_val, r, &right_val);
+ if (left_val > right_val)
+ {
+ fn = fml_node_alloc (fml);
+ fn->is_atom = 1;
+ fn->p[0] = fml_atom_alloc (fml, "1");
+ }
+ else
+ fn = NULL;
+ return fn;
+}
+
+
+static struct fml_node *fml_exec_lt (Fml fml, struct fml_node *l,
+ struct fml_node *r)
+{
+ int left_val, right_val;
+ struct fml_node *fn;
+ fml_lr_values (l, &left_val, r, &right_val);
+ if (left_val < right_val)
+ {
+ fn = fml_node_alloc (fml);
+ fn->is_atom = 1;
+ fn->p[0] = fml_atom_alloc (fml, "1");
+ }
+ else
+ fn = NULL;
+ return fn;
+}
+
+static struct fml_node *fml_exec_eq (Fml fml, struct fml_node *l,
+ struct fml_node *r)
+{
+ int left_val, right_val;
+ struct fml_node *fn;
+ fml_lr_values (l, &left_val, r, &right_val);
+ if (left_val == right_val)
+ {
+ fn = fml_node_alloc (fml);
+ fn->is_atom = 1;
+ fn->p[0] = fml_atom_alloc (fml, "1");
+ }
+ else
+ fn = NULL;
+ return fn;
+}
+
+
+static struct fml_node *fml_exec_space (Fml fml, struct fml_node **lp,
+ struct token *tp)
+{
+ return NULL;
+}
+
+static struct fml_node *fml_exec_nl (Fml fml, struct fml_node **lp,
+ struct token *tp)
+{
+ putchar ('\n');
+ return NULL;
+}
+
+static struct fml_node *fml_exec_prefix (struct fml_sym_info *info, Fml fml,
+ struct fml_node **lp,
+ struct token *tp)
+{
+ struct fml_node *fn;
+ struct fml_sym_info *arg_info;
+ struct fml_node *return_value;
+ static char arg[128];
+
+ if (fml->debug)
+ {
+ pr_indent (1);
+ printf ("exec_prefix ");
+ }
+ fml_sym_push (fml->sym_tab);
+ for (fn = info->args; fn; fn = fn->p[1])
+ {
+ fml_cmd_lex (lp, tp);
+
+ assert (fn->is_atom);
+ fml_atom_strx (fn->p[0], arg, 127);
+ if (fml->debug)
+ {
+
+ pr_indent (1);
+ printf ("%s=", arg);
+ }
+ arg_info = fml_sym_add_local (fml->sym_tab, arg);
+ arg_info->kind = FML_VAR;
+ arg_info->body = fml_lex_list (fml, tp);
+ if (arg_info->body)
+ arg_info->body = fml_sub0 (fml, arg_info->body);
+ if (fml->debug)
+ {
+ fml_pr_list (arg_info->body);
+ pr_indent (-1);
+ }
+ }
+ return_value = fml_exec_group (info->body, fml);
+ if (fml->debug)
+ {
+ pr_indent(0);
+ pr_indent (-1);
+ }
+ fml_do_pop (fml);
+ return return_value;
+}
+
+
+static void fml_emit (struct fml_node *list)
+{
+ int s = 0;
+ while (list)
+ {
+ if (list->is_atom)
+ {
+ struct fml_atom *a;
+ if (s)
+ printf (" ");
+ s++;
+ for (a = list->p[0]; a; a=a->next)
+ printf ("%s", a->buf);
+ }
+ else
+ fml_emit (list->p[0]);
+ list = list->p[1];
+ }
+}
+
+static struct fml_node *fml_sub1 (Fml fml, struct fml_node **lp,
+ struct token *tp);
+
+
+static struct fml_node *fml_sub2 (Fml fml, struct fml_node **lp,
+ struct token *tp)
+{
+ struct fml_node *fn;
+ struct fml_sym_info *info;
+ if (tp->kind == 'e')
+ {
+ info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
+ assert (info);
+ switch (info->kind)
+ {
+ case FML_VAR:
+ fn = info->body;
+ fml_cmd_lex (lp, tp);
+ break;
+ case FML_PREFIX:
+ fn = fml_exec_prefix (info, fml, lp, tp);
+ fml_cmd_lex (lp, tp);
+ break;
+ case FML_CPREFIX:
+ fn = (*info->prefix) (fml, lp, tp);
+ fml_cmd_lex (lp, tp);
+ break;
+ default:
+ fml_cmd_lex (lp, tp);
+ fn = NULL;
+ }
+ }
+ else if (tp->kind == 'g')
+ {
+ if (tp->sub)
+ fn = fml_sub0 (fml, tp->sub);
+ else
+ fn = NULL;
+ fml_cmd_lex (lp, tp);
+ }
+ else if (tp->kind == 't')
+ {
+ fn = fml_node_alloc (fml);
+ fn->is_atom = 1;
+ fn->p[0] = fml_atom_alloc (fml, tp->tokenbuf);
+ fml_cmd_lex (lp, tp);
+ }
+ else
+ fn = NULL;
+ return fn;
+}
+
+static struct fml_node *fml_sub1 (Fml fml, struct fml_node **lp,
+ struct token *tp)
+{
+ struct fml_node *f1, *f2;
+ struct fml_sym_info *info;
+
+ f1 = fml_sub2 (fml, lp, tp);
+ while (tp->kind == 'e')
+ {
+ info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
+ if (!info)
+ {
+ fprintf (stderr, "cannot locate `%s'", tp->tokenbuf);
+ exit (1);
+ }
+ if (info->kind == FML_CBINARY)
+ {
+ fml_cmd_lex (lp, tp);
+ f2 = fml_sub2 (fml, lp, tp);
+ f1 = (*info->binary) (fml, f1, f2);
+ continue;
+ }
+ else if (info->kind == FML_BINARY)
+ {
+ struct fml_sym_info *arg_info;
+ char arg[127];
+
+ if (fml->debug)
+ {
+ pr_indent (1);
+ printf ("exec binary %s", tp->tokenbuf);
+ }
+ fml_cmd_lex (lp, tp);
+ f2 = fml_sub2 (fml, lp, tp);
+ fml_sym_push (fml->sym_tab);
+
+ fml_atom_strx (info->args->p[0], arg, 127);
+ arg_info = fml_sym_add_local (fml->sym_tab, arg);
+ arg_info->kind = FML_VAR;
+ arg_info->body = f1;
+ if (fml->debug)
+ {
+ printf (" left=");
+ fml_pr_list (f1);
+ }
+ fml_atom_strx ( ((struct fml_node *) info->args->p[1])->p[0],
+ arg, 127);
+ arg_info = fml_sym_add_local (fml->sym_tab, arg);
+ arg_info->kind = FML_VAR;
+ arg_info->body = f2;
+ if (fml->debug)
+ {
+ printf (" right=");
+ fml_pr_list (f2);
+ putchar ('\n');
+ }
+ f1 = fml_exec_group (info->body, fml);
+ fml_do_pop (fml);
+ if (fml->debug)
+ {
+ pr_indent (0);
+ pr_indent (-1);
+ }
+ }
+ else
+ break;
+ }
+ return f1;
+}
+
+#if 0
+static struct fml_node *fml_sub_bad (Fml fml, struct fml_node *list)
+{
+ struct token token;
+ struct fml_node *fn, *fn1;
+
+ fml_init_token (&token, fml);
+ assert (list);
+ fml_cmd_lex (&list, &token);
+ fn = fml_sub1 (fml, &list, &token);
+ if (token.kind == '\0')
+ {
+ fml_del_token (&token, fml);
+ return fn;
+ }
+ fn1 = fml_node_alloc (fml);
+ fn1->p[0] = fn;
+ fn = fn1;
+ while (token.kind != '\0')
+ {
+ fn1 = fn1->p[1] = fml_node_alloc (fml);
+ fn1->p[0] = fml_sub1 (fml, &list, &token);
+ }
+ fml_del_token (&token, fml);
+ return fn;
+}
+#endif
+
+static struct fml_node *fml_sub0 (Fml fml, struct fml_node *list)
+{
+ struct token token;
+ struct fml_node *fn, *fn1;
+
+ fml_init_token (&token, fml);
+ assert (list);
+ fml_cmd_lex (&list, &token);
+ fn1 = fn = fml_sub1 (fml, &list, &token);
+
+ while (token.kind != '\0')
+ fn1 = fn1->p[1] = fml_sub1 (fml, &list, &token);
+ fml_del_token (&token, fml);
+ return fn;
+}
+
+static struct fml_node *fml_exec_foreach (struct fml_sym_info *info, Fml fml,
+ struct fml_node **lp,
+ struct token *tp)
+{
+ struct fml_sym_info *info_var;
+ struct fml_node *fn, *body;
+ struct fml_node *return_value = NULL, *rv;
+
+ fml_cmd_lex (lp, tp);
+ assert (tp->kind == 't');
+
+ info_var = fml_sym_lookup_local (fml->sym_tab, tp->tokenbuf);
+ if (!info_var)
+ {
+ info_var = fml_sym_add_local (fml->sym_tab, tp->tokenbuf);
+ info_var->body = NULL;
+ info_var->kind = FML_VAR;
+ }
+ if (fml->debug)
+ {
+ pr_indent (1);
+ printf ("[foreach %s ", tp->tokenbuf);
+ }
+ fml_cmd_lex (lp, tp);
+
+ fn = fml_lex_list (fml, tp);
+ if (fn)
+ fn = fml_sub0 (fml, fn);
+
+ fml_cmd_lex (lp, tp);
+
+ body = fml_lex_list (fml, tp);
+
+ while (fn)
+ {
+ if (fn->is_atom)
+ {
+ struct fml_node *fn1;
+ fn1 = fml_node_alloc (fml);
+ fn1->is_atom=1;
+ fn1->p[0] = fn->p[0];
+ info_var->body = fn1;
+ }
+ else
+ info_var->body = fn->p[0];
+
+ if (fml->debug)
+ {
+ pr_indent (1);
+ printf ("[foreach loop var=");
+ fml_pr_list (info_var->body);
+ pr_indent (-1);
+ }
+ rv = fml_exec_group (body, fml);
+ if (rv)
+ return_value = rv;
+ fn = fn->p[1];
+ }
+ if (fml->debug)
+ pr_indent (-1);
+ return return_value;
+}
+
+static struct fml_node *fml_exec_if (struct fml_sym_info *info, Fml fml,
+ struct fml_node **lp, struct token *tp)
+{
+ struct fml_node *fn, *body;
+ struct fml_node *rv, *return_value = NULL;
+
+ fml_cmd_lex (lp, tp);
+ fn = fml_lex_list (fml, tp);
+ if (fn)
+ fn = fml_sub0 (fml, fn);
+ fml_cmd_lex (lp, tp);
+ if (fn)
+ {
+ body = fml_lex_list (fml, tp);
+ rv = fml_exec_group (body, fml);
+ if (rv)
+ return_value = rv;
+ }
+ fml_cmd_lex (lp, tp);
+ if (tp->kind == 'e')
+ {
+ info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
+ if (info->kind == FML_ELSE)
+ {
+ fml_cmd_lex (lp, tp);
+ body = fml_lex_list (fml, tp);
+ fml_cmd_lex (lp, tp);
+ if (!fn)
+ {
+ rv = fml_exec_group (body, fml);
+ if (rv)
+ return_value = rv;
+ }
+ }
+ }
+ return return_value;
+}
+
+static struct fml_node *fml_exec_while (struct fml_sym_info *info, Fml fml,
+ struct fml_node **lp, struct token *tp)
+{
+ struct fml_node *fn, *body;
+ struct fml_node *return_value = NULL;
+
+ fml_cmd_lex (lp, tp);
+ fn = fml_lex_list (fml, tp);
+
+ fml_cmd_lex (lp, tp);
+ body = fml_lex_list (fml, tp);
+ while (1)
+ {
+ struct fml_node *fn_expr;
+ struct fml_node *rv;
+ if (!fn)
+ break;
+ fn_expr = fml_sub0 (fml, fn);
+ if (!fn_expr)
+ break;
+ rv = fml_exec_group (body, fml);
+ if (rv)
+ return_value = rv;
+ }
+ return return_value;
+}
+
+static void fml_exec_set (struct fml_sym_info *info, Fml fml,
+ struct fml_node **lp, struct token *tp)
+{
+ struct fml_node *fn;
+ struct fml_sym_info *info_var;
+
+ fml_cmd_lex (lp, tp);
+ info_var = fml_sym_lookup_local (fml->sym_tab, tp->tokenbuf);
+ if (!info_var)
+ {
+ info_var = fml_sym_add_local (fml->sym_tab, tp->tokenbuf);
+ info_var->body = NULL;
+ }
+ if (fml->debug)
+ {
+ pr_indent (1);
+ printf ("set %s ", tp->tokenbuf);
+ }
+ info_var->kind = FML_VAR;
+ fml_cmd_lex (lp, tp);
+ fn = fml_lex_list (fml, tp);
+ assert (fn);
+ if (fn)
+ fn = fml_sub0 (fml, fn);
+ info_var->body = fn;
+ if (fml->debug)
+ {
+ fml_pr_list (info_var->body);
+ pr_indent (-1);
+ }
+}
+
+static void fml_emit_expr (Fml fml, struct fml_node **lp, struct token *tp)
+{
+ struct fml_node *fn;
+
+ fn = fml_sub1 (fml, lp, tp);
+ fml_emit (fn);
+#if 0
+ if (fn && fn->is_atom)
+ {
+ char arg[128];
+ fml_atom_strx (fn->p[0], arg, 127);
+ printf ("%s", arg);
+ }
+#endif
+}
+
+static struct fml_node *fml_exec_group (struct fml_node *list, Fml fml)
+{
+ struct token token;
+ struct fml_sym_info *info;
+ int separate = 0;
+ struct fml_node *return_value = NULL, *rv;
+
+ if (!list)
+ return NULL;
+ fml_init_token (&token, fml);
+ fml_cmd_lex (&list, &token);
+ while (token.kind)
+ {
+ switch (token.kind)
+ {
+ case 'g':
+ rv = fml_exec_group (token.sub, fml);
+ if (rv)
+ return_value = rv;
+ break;
+ case 'e':
+ info = fml_sym_lookup (fml->sym_tab, token.tokenbuf);
+ if (info)
+ {
+ struct fml_node *fn;
+
+ switch (info->kind)
+ {
+ case FML_FUNC:
+ fml_cmd_lex (&list, &token);
+ assert (token.kind == 't');
+ info = fml_sym_lookup (fml->sym_tab, token.tokenbuf);
+ if (!info)
+ info = fml_sym_add (fml->sym_tab, token.tokenbuf);
+ info->kind = FML_PREFIX;
+ info->args = NULL;
+ while (1)
+ {
+ fml_cmd_lex (&list, &token);
+ if (token.kind != 't')
+ break;
+ if (!info->args)
+ {
+ info->args = fn = fml_node_alloc (fml);
+ }
+ else
+ {
+ for (fn = info->args; fn->p[1]; fn=fn->p[1])
+ ;
+ fn = fn->p[1] = fml_node_alloc (fml);
+ }
+ fn->p[0] = token.atom;
+ fn->is_atom = 1;
+ }
+ assert (token.kind == 'g');
+ info->body = token.sub;
+ break;
+ case FML_BIN:
+ fml_cmd_lex (&list, &token);
+ assert (token.kind == 't');
+ info = fml_sym_lookup (fml->sym_tab, token.tokenbuf);
+ if (!info)
+ info = fml_sym_add (fml->sym_tab, token.tokenbuf);
+ info->kind = FML_BINARY;
+
+ fml_cmd_lex (&list, &token);
+ assert (token.kind == 't');
+ info->args = fn = fml_node_alloc (fml);
+ fn->p[0] = token.atom;
+ fn->is_atom = 1;
+
+ fml_cmd_lex (&list, &token);
+ assert (token.kind == 't');
+ fn = fn->p[1] = fml_node_alloc (fml);
+ fn->p[0] = token.atom;
+ fn->is_atom = 1;
+
+ fml_cmd_lex (&list, &token);
+ assert (token.kind == 'g');
+ info->body = token.sub;
+ break;
+#if 0
+ case FML_PREFIX:
+ after_char = token.after_char;
+ fml_exec_prefix (info, fml, &list, &token);
+ if (after_char)
+ putchar (after_char);
+ break;
+ case FML_VAR:
+ fml_emit (info->body);
+ if (token.after_char)
+ putchar (token.after_char);
+ break;
+#endif
+ case FML_VAR:
+ case FML_PREFIX:
+ case FML_CPREFIX:
+ if (separate)
+ putchar (' ');
+ if (token.offset == 0)
+ separate = ' ';
+ else
+ separate = 0;
+ fml_emit_expr (fml, &list, &token);
+ continue;
+ case FML_FOREACH:
+ rv = fml_exec_foreach (info, fml, &list, &token);
+ if (rv)
+ return_value = rv;
+ break;
+ case FML_IF:
+ rv = fml_exec_if (info, fml, &list, &token);
+ if (rv)
+ return_value = rv;
+ break;
+ case FML_SET:
+ fml_exec_set (info, fml, &list, &token);
+ break;
+ case FML_WHILE:
+ rv = fml_exec_while (info, fml, &list, &token);
+ if (rv)
+ return_value = rv;
+ break;
+ case FML_RETURN:
+ fml_cmd_lex (&list, &token);
+ return_value = fml_lex_list (fml, &token);
+ if (return_value)
+ return_value = fml_sub0 (fml, return_value);
+ if (fml->debug)
+ {
+ pr_indent (1);
+ printf ("return of:");
+ fml_pr_list (return_value);
+ pr_indent (-1);
+ }
+ break;
+ default:
+ printf ("unknown token: `%s'", token.tokenbuf);
+ fml_cmd_lex (&list, &token);
+ }
+ }
+ else
+ {
+ printf ("<unknown>");
+ }
+ break;
+ case 't':
+ if (separate)
+ putchar (' ');
+ if (token.offset == 0)
+ separate = ' ';
+ else
+ separate = 0;
+ fml_emit_expr (fml, &list, &token);
+ continue;
+#if 0
+ printf ("%s", token.tokenbuf);
+ if (token.after_char)
+ putchar (token.after_char);
+#endif
+ }
+ fml_cmd_lex (&list, &token);
+ }
+ fml_del_token (&token, fml);
+ return return_value;
+}
+
+void fml_exec (Fml fml)
+{
+ fml_exec_group (fml->list, fml);
+ if (fml->debug)
+ printf ("\n");
+}
+
+