2 * FML interpreter. Europagate, 1995
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).
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.
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.
26 static int default_read_func (void)
31 static void default_err_handle (int no)
33 fprintf (stderr, "Error: %d\n", no);
36 static struct fml_node *fml_exec_space (Fml fml, struct fml_node **lp,
38 static struct fml_node *fml_exec_nl (Fml fml, struct fml_node **lp,
40 static struct fml_node *fml_exec_incr (Fml fml, struct fml_node **lp,
42 static struct fml_node *fml_exec_decr (Fml fml, struct fml_node **lp,
45 static struct fml_node *fml_sub_bad (Fml fml, struct fml_node *list);
47 static struct fml_node *fml_sub0 (Fml fml, struct fml_node *list);
49 static struct fml_node *fml_exec_plus (Fml fml, struct fml_node *l,
51 static struct fml_node *fml_exec_minus (Fml fml, struct fml_node *l,
53 static struct fml_node *fml_exec_gt (Fml fml, struct fml_node *l,
55 static struct fml_node *fml_exec_lt (Fml fml, struct fml_node *l,
57 static struct fml_node *fml_exec_eq (Fml fml, struct fml_node *l,
59 static struct fml_node *fml_exec_ge (Fml fml, struct fml_node *l,
61 static struct fml_node *fml_exec_le (Fml fml, struct fml_node *l,
63 static struct fml_node *fml_exec_ne (Fml fml, struct fml_node *l,
65 static struct fml_node *fml_exec_and (Fml fml, struct fml_node *l,
67 static struct fml_node *fml_exec_or (Fml fml, struct fml_node *l,
69 static struct fml_node *fml_exec_indx (Fml fml, struct fml_node *l,
72 static int indent = 0;
74 static void pr_indent (int n)
97 struct fml_sym_info *sym_info;
99 Fml fml = malloc (sizeof(*fml));
104 fml->escape_char = '\\';
105 fml->comment_char = '#';
107 fml->white_chars = " \t\f\r\n";
108 fml->read_func = default_read_func;
109 fml->err_handle = default_err_handle;
112 fml->sym_tab = fml_sym_open ();
113 fml->atom_free_list = NULL;
114 fml->node_free_list = NULL;
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;
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;
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;
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;
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;
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;
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;
192 static Fml fml_pop_handler = NULL;
193 static void pop_handler (struct fml_sym_info *info)
195 assert (fml_pop_handler);
199 /* fml_node_delete (fml_pop_handler, info->body); */
203 static void fml_do_pop (Fml fml)
205 fml_pop_handler = fml;
206 fml_sym_pop (fml->sym_tab, pop_handler);
209 int fml_preprocess (Fml fml)
211 fml->list = fml_tokenize (fml);
216 static void fml_init_token (struct token *tp, Fml fml)
218 tp->maxbuf = FML_ATOM_BUF*2;
220 tp->atombuf = tp->sbuf;
221 tp->tokenbuf = tp->sbuf + tp->maxbuf;
222 tp->escape_char = fml->escape_char;
225 static void fml_del_token (struct token *tp, Fml fml)
227 if (tp->maxbuf != FML_ATOM_BUF*2)
231 static void fml_cmd_lex (struct fml_node **np, struct token *tp)
245 tp->atom = (*np)->p[0];
247 fml_atom_str (tp->atom, tp->atombuf);
250 int l = fml_atom_str (tp->atom, NULL);
251 if (l >= tp->maxbuf-1)
253 if (tp->maxbuf != FML_ATOM_BUF*2)
256 tp->atombuf = malloc (tp->maxbuf*2);
257 tp->tokenbuf = tp->atombuf + tp->maxbuf;
259 fml_atom_str (tp->atom, tp->atombuf);
264 tp->sub = (*np)->p[0];
272 cp = tp->atombuf + tp->offset;
274 if (*cp == tp->escape_char)
277 tp->after_char = '\0';
290 tp->after_char = ' ';
294 if (*cp == tp->escape_char)
300 tp->after_char = ' ';
312 tp->offset = cp - tp->atombuf;
313 tp->after_char = '\0';
323 static struct fml_node *fml_lex_list (Fml fml, struct token *tp)
329 fn = fml_node_alloc (fml);
335 static struct fml_node *fml_exec_group (struct fml_node *list, Fml fml);
337 static void fml_lr_values (struct fml_node *l, int *left_val,
338 struct fml_node *r, int *right_val)
341 *left_val = fml_atom_val (l->p[0]);
345 *right_val = fml_atom_val (r->p[0]);
350 static struct fml_node *fml_exec_and (Fml fml, struct fml_node *l,
359 static struct fml_node *fml_exec_or (Fml fml, struct fml_node *l,
367 static struct fml_node *fml_exec_indx (Fml fml, struct fml_node *l,
370 struct fml_node *list = l;
373 if (!l || !r || !r->is_atom)
375 indx = fml_atom_val (r->p[0]);
376 while (--indx >= 1 && list)
382 struct fml_node *fn = fml_node_alloc (fml);
384 fn->p[0] = list->p[0];
391 static struct fml_node *fml_exec_plus (Fml fml, struct fml_node *l,
394 int left_val, right_val;
398 fml_lr_values (l, &left_val, r, &right_val);
399 sprintf (arg, "%d", left_val + right_val);
400 fn = fml_node_alloc (fml);
402 fn->p[0] = fml_atom_alloc (fml, arg);
406 static struct fml_node *fml_exec_minus (Fml fml, struct fml_node *l,
409 int left_val, right_val;
413 fml_lr_values (l, &left_val, r, &right_val);
414 sprintf (arg, "%d", left_val - right_val);
415 fn = fml_node_alloc (fml);
417 fn->p[0] = fml_atom_alloc (fml, arg);
422 static struct fml_node *fml_exec_gt (Fml fml, struct fml_node *l,
425 int left_val, right_val;
427 fml_lr_values (l, &left_val, r, &right_val);
428 if (left_val > right_val)
430 fn = fml_node_alloc (fml);
432 fn->p[0] = fml_atom_alloc (fml, "1");
440 static struct fml_node *fml_exec_lt (Fml fml, struct fml_node *l,
443 int left_val, right_val;
445 fml_lr_values (l, &left_val, r, &right_val);
446 if (left_val < right_val)
448 fn = fml_node_alloc (fml);
450 fn->p[0] = fml_atom_alloc (fml, "1");
457 static struct fml_node *fml_exec_eq (Fml fml, struct fml_node *l,
460 int left_val, right_val;
462 fml_lr_values (l, &left_val, r, &right_val);
463 if (left_val == right_val)
465 fn = fml_node_alloc (fml);
467 fn->p[0] = fml_atom_alloc (fml, "1");
474 static struct fml_node *fml_exec_ne (Fml fml, struct fml_node *l,
477 int left_val, right_val;
479 fml_lr_values (l, &left_val, r, &right_val);
480 if (left_val != right_val)
482 fn = fml_node_alloc (fml);
484 fn->p[0] = fml_atom_alloc (fml, "1");
491 static struct fml_node *fml_exec_le (Fml fml, struct fml_node *l,
494 int left_val, right_val;
496 fml_lr_values (l, &left_val, r, &right_val);
497 if (left_val <= right_val)
499 fn = fml_node_alloc (fml);
501 fn->p[0] = fml_atom_alloc (fml, "1");
508 static struct fml_node *fml_exec_ge (Fml fml, struct fml_node *l,
511 int left_val, right_val;
513 fml_lr_values (l, &left_val, r, &right_val);
514 if (left_val >= right_val)
516 fn = fml_node_alloc (fml);
518 fn->p[0] = fml_atom_alloc (fml, "1");
526 static struct fml_node *fml_exec_space (Fml fml, struct fml_node **lp,
533 static struct fml_node *fml_exec_nl (Fml fml, struct fml_node **lp,
540 static struct fml_node *fml_exec_incr (Fml fml, struct fml_node **lp,
543 struct fml_node *fn = NULL;
544 struct fml_sym_info *info;
545 fml_cmd_lex (lp, tp);
548 info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
550 if (info->kind == FML_VAR && info->body && info->body->is_atom)
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);
560 fn->p[0] = fml_atom_alloc (fml, arg);
566 static struct fml_node *fml_exec_decr (Fml fml, struct fml_node **lp,
569 struct fml_node *fn = NULL;
570 struct fml_sym_info *info;
571 fml_cmd_lex (lp, tp);
574 info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
576 if (info->kind == FML_VAR && info->body && info->body->is_atom)
581 val = fml_atom_val (info->body->p[0]);
582 sprintf (arg, "%d", val-1);
583 info->body = fn = fml_node_alloc (fml);
585 fn->p[0] = fml_atom_alloc (fml, arg);
591 static struct fml_node *fml_exec_prefix (struct fml_sym_info *info, Fml fml,
592 struct fml_node **lp,
596 struct fml_sym_info *arg_info;
597 struct fml_node *return_value;
598 static char arg[128];
603 printf ("exec_prefix ");
605 fml_sym_push (fml->sym_tab);
606 for (fn = info->args; fn; fn = fn->p[1])
608 fml_cmd_lex (lp, tp);
610 assert (fn->is_atom);
611 fml_atom_strx (fn->p[0], arg, 127);
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);
622 arg_info->body = fml_sub0 (fml, arg_info->body);
625 fml_pr_list (arg_info->body);
629 return_value = fml_exec_group (info->body, fml);
640 static void fml_emit (struct fml_node *list)
651 for (a = list->p[0]; a; a=a->next)
652 printf ("%s", a->buf);
655 fml_emit (list->p[0]);
660 static struct fml_node *fml_sub1 (Fml fml, struct fml_node **lp,
664 static struct fml_node *fml_sub2 (Fml fml, struct fml_node **lp,
668 struct fml_sym_info *info;
671 info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
677 fml_cmd_lex (lp, tp);
680 fn = fml_exec_prefix (info, fml, lp, tp);
681 fml_cmd_lex (lp, tp);
684 fn = (*info->prefix) (fml, lp, tp);
685 fml_cmd_lex (lp, tp);
688 fml_cmd_lex (lp, tp);
692 else if (tp->kind == 'g')
695 fn = fml_sub0 (fml, tp->sub);
698 fml_cmd_lex (lp, tp);
700 else if (tp->kind == 't')
702 fn = fml_node_alloc (fml);
704 fn->p[0] = fml_atom_alloc (fml, tp->tokenbuf);
705 fml_cmd_lex (lp, tp);
712 static struct fml_node *fml_sub1 (Fml fml, struct fml_node **lp,
715 struct fml_node *f1, *f2;
716 struct fml_sym_info *info;
718 f1 = fml_sub2 (fml, lp, tp);
719 while (tp->kind == 'e')
721 info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
724 fprintf (stderr, "cannot locate `%s'", tp->tokenbuf);
727 if (info->kind == FML_CBINARY)
729 fml_cmd_lex (lp, tp);
730 f2 = fml_sub2 (fml, lp, tp);
731 f1 = (*info->binary) (fml, f1, f2);
734 else if (info->kind == FML_BINARY)
736 struct fml_sym_info *arg_info;
742 printf ("exec binary %s", tp->tokenbuf);
744 fml_cmd_lex (lp, tp);
745 f2 = fml_sub2 (fml, lp, tp);
746 fml_sym_push (fml->sym_tab);
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;
757 fml_atom_strx ( ((struct fml_node *) info->args->p[1])->p[0],
759 arg_info = fml_sym_add_local (fml->sym_tab, arg);
760 arg_info->kind = FML_VAR;
768 f1 = fml_exec_group (info->body, fml);
783 static struct fml_node *fml_sub0 (Fml fml, struct fml_node *list)
786 struct fml_node *fn, *fn1;
788 fml_init_token (&token, fml);
790 fml_cmd_lex (&list, &token);
791 fn = fml_sub1 (fml, &list, &token);
792 if (token.kind == '\0')
794 fml_del_token (&token, fml);
797 fn1 = fml_node_alloc (fml);
800 while (token.kind != '\0')
802 fn1 = fn1->p[1] = fml_node_alloc (fml);
803 fn1->p[0] = fml_sub1 (fml, &list, &token);
805 fml_del_token (&token, fml);
809 static struct fml_node *fml_sub0 (Fml fml, struct fml_node *list)
812 struct fml_node *fn, *fn0, *fn1;
814 fml_init_token (&token, fml);
816 fml_cmd_lex (&list, &token);
817 fn1 = fn = fml_sub1 (fml, &list, &token);
818 if (fn->p[1] && token.kind != '\0')
820 fn1 = fml_node_alloc (fml);
824 while (token.kind != '\0')
826 fn = fml_sub1 (fml, &list, &token);
829 fn1 = fn1->p[1] = fml_node_alloc (fml);
834 fn1 = fn1->p[1] = fn;
837 fml_del_token (&token, fml);
843 static struct fml_node *fml_exec_foreach (struct fml_sym_info *info, Fml fml,
844 struct fml_node **lp,
847 struct fml_sym_info *info_var;
848 struct fml_node *fn, *body;
849 struct fml_node *return_value = NULL, *rv;
851 fml_cmd_lex (lp, tp);
852 assert (tp->kind == 't');
854 info_var = fml_sym_lookup_local (fml->sym_tab, tp->tokenbuf);
857 info_var = fml_sym_add_local (fml->sym_tab, tp->tokenbuf);
858 info_var->body = NULL;
859 info_var->kind = FML_VAR;
864 printf ("[foreach %s ", tp->tokenbuf);
866 fml_cmd_lex (lp, tp);
868 fn = fml_lex_list (fml, tp);
870 fn = fml_sub0 (fml, fn);
872 fml_cmd_lex (lp, tp);
874 body = fml_lex_list (fml, tp);
880 struct fml_node *fn1;
881 fn1 = fml_node_alloc (fml);
883 fn1->p[0] = fn->p[0];
884 info_var->body = fn1;
887 info_var->body = fn->p[0];
892 printf ("[foreach loop var=");
893 fml_pr_list (info_var->body);
896 rv = fml_exec_group (body, fml);
906 static struct fml_node *fml_exec_if (struct fml_sym_info *info, Fml fml,
907 struct fml_node **lp, struct token *tp)
909 struct fml_node *fn, *body;
910 struct fml_node *rv, *return_value = NULL;
912 fml_cmd_lex (lp, tp);
913 fn = fml_lex_list (fml, tp);
915 fn = fml_sub0 (fml, fn);
916 fml_cmd_lex (lp, tp);
919 body = fml_lex_list (fml, tp);
920 rv = fml_exec_group (body, fml);
924 fml_cmd_lex (lp, tp);
927 info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
928 if (info->kind == FML_ELSE)
930 fml_cmd_lex (lp, tp);
931 body = fml_lex_list (fml, tp);
932 fml_cmd_lex (lp, tp);
935 rv = fml_exec_group (body, fml);
944 static struct fml_node *fml_exec_while (struct fml_sym_info *info, Fml fml,
945 struct fml_node **lp, struct token *tp)
947 struct fml_node *fn, *body;
948 struct fml_node *return_value = NULL;
950 fml_cmd_lex (lp, tp);
951 fn = fml_lex_list (fml, tp);
953 fml_cmd_lex (lp, tp);
954 body = fml_lex_list (fml, tp);
957 struct fml_node *fn_expr;
961 fn_expr = fml_sub0 (fml, fn);
964 rv = fml_exec_group (body, fml);
971 static void fml_exec_set (struct fml_sym_info *info, Fml fml,
972 struct fml_node **lp, struct token *tp)
975 struct fml_sym_info *info_var;
977 fml_cmd_lex (lp, tp);
978 info_var = fml_sym_lookup_local (fml->sym_tab, tp->tokenbuf);
981 info_var = fml_sym_add_local (fml->sym_tab, tp->tokenbuf);
982 info_var->body = NULL;
987 printf ("set %s ", tp->tokenbuf);
989 info_var->kind = FML_VAR;
990 fml_cmd_lex (lp, tp);
991 fn = fml_lex_list (fml, tp);
994 fn = fml_sub0 (fml, fn);
998 fml_pr_list (info_var->body);
1003 static void fml_emit_expr (Fml fml, struct fml_node **lp, struct token *tp)
1005 struct fml_node *fn;
1007 fn = fml_sub1 (fml, lp, tp);
1011 static struct fml_node *fml_exec_group (struct fml_node *list, Fml fml)
1014 struct fml_sym_info *info;
1016 struct fml_node *return_value = NULL, *rv;
1020 fml_init_token (&token, fml);
1021 fml_cmd_lex (&list, &token);
1027 rv = fml_exec_group (token.sub, fml);
1032 info = fml_sym_lookup (fml->sym_tab, token.tokenbuf);
1035 struct fml_node *fn;
1040 fml_cmd_lex (&list, &token);
1041 assert (token.kind == 't');
1042 info = fml_sym_lookup (fml->sym_tab, token.tokenbuf);
1044 info = fml_sym_add (fml->sym_tab, token.tokenbuf);
1045 info->kind = FML_PREFIX;
1049 fml_cmd_lex (&list, &token);
1050 if (token.kind != 't')
1054 info->args = fn = fml_node_alloc (fml);
1058 for (fn = info->args; fn->p[1]; fn=fn->p[1])
1060 fn = fn->p[1] = fml_node_alloc (fml);
1062 fn->p[0] = token.atom;
1065 assert (token.kind == 'g');
1066 info->body = token.sub;
1069 fml_cmd_lex (&list, &token);
1070 assert (token.kind == 't');
1071 info = fml_sym_lookup (fml->sym_tab, token.tokenbuf);
1073 info = fml_sym_add (fml->sym_tab, token.tokenbuf);
1074 info->kind = FML_BINARY;
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;
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;
1088 fml_cmd_lex (&list, &token);
1089 assert (token.kind == 'g');
1090 info->body = token.sub;
1094 after_char = token.after_char;
1095 fml_exec_prefix (info, fml, &list, &token);
1097 putchar (after_char);
1100 fml_emit (info->body);
1101 if (token.after_char)
1102 putchar (token.after_char);
1108 if (token.separate && !first)
1113 fml_emit_expr (fml, &list, &token);
1116 rv = fml_exec_foreach (info, fml, &list, &token);
1121 rv = fml_exec_if (info, fml, &list, &token);
1126 fml_exec_set (info, fml, &list, &token);
1129 rv = fml_exec_while (info, fml, &list, &token);
1134 fml_cmd_lex (&list, &token);
1135 return_value = fml_lex_list (fml, &token);
1137 return_value = fml_sub0 (fml, return_value);
1141 printf ("return of:");
1142 fml_pr_list (return_value);
1147 printf ("unknown token: `%s'", token.tokenbuf);
1148 fml_cmd_lex (&list, &token);
1153 printf ("<unknown>");
1158 printf ("<token.tokenbuf=%s>", token.tokenbuf);
1160 if (token.separate && !first)
1163 fml_emit_expr (fml, &list, &token);
1166 fml_cmd_lex (&list, &token);
1168 fml_del_token (&token, fml);
1169 return return_value;
1172 void fml_exec (Fml fml)
1174 fml_exec_group (fml->list, fml);