2 * FML interpreter. Europagate, 1995
5 * Revision 1.2 1995/02/06 15:23:25 adam
6 * Added some more relational operators (le,ne,ge). Added increment
7 * and decrement operators. Function index changed, so that first
8 * element is 1 - not 0. Function fml_atom_val edited.
10 * Revision 1.1.1.1 1995/02/06 13:48:10 adam
11 * First version of the FML interpreter. It's slow and memory isn't
12 * freed properly. In particular, the FML nodes aren't released yet.
21 static int default_read_func (void)
26 static void default_err_handle (int no)
28 fprintf (stderr, "Error: %d\n", no);
31 static struct fml_node *fml_exec_space (Fml fml, struct fml_node **lp,
33 static struct fml_node *fml_exec_nl (Fml fml, struct fml_node **lp,
35 static struct fml_node *fml_exec_incr (Fml fml, struct fml_node **lp,
37 static struct fml_node *fml_exec_decr (Fml fml, struct fml_node **lp,
40 static struct fml_node *fml_sub_bad (Fml fml, struct fml_node *list);
42 static struct fml_node *fml_sub0 (Fml fml, struct fml_node *list);
44 static struct fml_node *fml_exec_plus (Fml fml, struct fml_node *l,
46 static struct fml_node *fml_exec_minus (Fml fml, struct fml_node *l,
48 static struct fml_node *fml_exec_gt (Fml fml, struct fml_node *l,
50 static struct fml_node *fml_exec_lt (Fml fml, struct fml_node *l,
52 static struct fml_node *fml_exec_eq (Fml fml, struct fml_node *l,
54 static struct fml_node *fml_exec_ge (Fml fml, struct fml_node *l,
56 static struct fml_node *fml_exec_le (Fml fml, struct fml_node *l,
58 static struct fml_node *fml_exec_ne (Fml fml, struct fml_node *l,
60 static struct fml_node *fml_exec_and (Fml fml, struct fml_node *l,
62 static struct fml_node *fml_exec_or (Fml fml, struct fml_node *l,
64 static struct fml_node *fml_exec_indx (Fml fml, struct fml_node *l,
67 static int indent = 0;
69 static void pr_indent (int n)
92 struct fml_sym_info *sym_info;
94 Fml fml = malloc (sizeof(*fml));
99 fml->escape_char = '\\';
100 fml->comment_char = '#';
102 fml->white_chars = " \t\f\r\n";
103 fml->read_func = default_read_func;
104 fml->err_handle = default_err_handle;
107 fml->sym_tab = fml_sym_open ();
108 fml->atom_free_list = NULL;
109 fml->node_free_list = NULL;
112 sym_info = fml_sym_add (fml->sym_tab, "func");
113 sym_info->kind = FML_FUNC;
114 sym_info = fml_sym_add (fml->sym_tab, "bin");
115 sym_info->kind = FML_BIN;
116 sym_info = fml_sym_add (fml->sym_tab, "if");
117 sym_info->kind = FML_IF;
118 sym_info = fml_sym_add (fml->sym_tab, "else");
119 sym_info->kind = FML_ELSE;
120 sym_info = fml_sym_add (fml->sym_tab, "foreach");
121 sym_info->kind = FML_FOREACH;
122 sym_info = fml_sym_add (fml->sym_tab, "set");
123 sym_info->kind = FML_SET;
124 sym_info = fml_sym_add (fml->sym_tab, "while");
125 sym_info->kind = FML_WHILE;
126 sym_info = fml_sym_add (fml->sym_tab, "return");
127 sym_info->kind = FML_RETURN;
130 sym_info = fml_sym_add (fml->sym_tab, "and");
131 sym_info->kind = FML_CBINARY;
132 sym_info->binary = fml_exec_and;
133 sym_info = fml_sym_add (fml->sym_tab, "or");
134 sym_info->kind = FML_CBINARY;
135 sym_info->binary = fml_exec_or;
136 sym_info = fml_sym_add (fml->sym_tab, "index");
137 sym_info->kind = FML_CBINARY;
138 sym_info->binary = fml_exec_indx;
140 sym_info = fml_sym_add (fml->sym_tab, "plus");
141 sym_info->kind = FML_CBINARY;
142 sym_info->binary = fml_exec_plus;
143 sym_info = fml_sym_add (fml->sym_tab, "minus");
144 sym_info->kind = FML_CBINARY;
145 sym_info->binary = fml_exec_minus;
147 sym_info = fml_sym_add (fml->sym_tab, "gt");
148 sym_info->kind = FML_CBINARY;
149 sym_info->binary = fml_exec_gt;
150 sym_info = fml_sym_add (fml->sym_tab, "lt");
151 sym_info->kind = FML_CBINARY;
152 sym_info->binary = fml_exec_lt;
153 sym_info = fml_sym_add (fml->sym_tab, "eq");
154 sym_info->kind = FML_CBINARY;
155 sym_info->binary = fml_exec_eq;
157 sym_info = fml_sym_add (fml->sym_tab, "ge");
158 sym_info->kind = FML_CBINARY;
159 sym_info->binary = fml_exec_ge;
160 sym_info = fml_sym_add (fml->sym_tab, "le");
161 sym_info->kind = FML_CBINARY;
162 sym_info->binary = fml_exec_le;
163 sym_info = fml_sym_add (fml->sym_tab, "ne");
164 sym_info->kind = FML_CBINARY;
165 sym_info->binary = fml_exec_ne;
167 sym_info = fml_sym_add (fml->sym_tab, "incr");
168 sym_info->kind = FML_CPREFIX;
169 sym_info->prefix = fml_exec_incr;
170 sym_info = fml_sym_add (fml->sym_tab, "decr");
171 sym_info->kind = FML_CPREFIX;
172 sym_info->prefix = fml_exec_decr;
174 sym_info = fml_sym_add (fml->sym_tab, "s");
175 sym_info->kind = FML_CPREFIX;
176 sym_info->prefix = fml_exec_space;
177 sym_info = fml_sym_add (fml->sym_tab, " ");
178 sym_info->kind = FML_CPREFIX;
179 sym_info->prefix = fml_exec_space;
180 sym_info = fml_sym_add (fml->sym_tab, "n");
181 sym_info->kind = FML_CPREFIX;
182 sym_info->prefix = fml_exec_nl;
187 static Fml fml_pop_handler = NULL;
188 static void pop_handler (struct fml_sym_info *info)
190 assert (fml_pop_handler);
194 /* fml_node_delete (fml_pop_handler, info->body); */
198 static void fml_do_pop (Fml fml)
200 fml_pop_handler = fml;
201 fml_sym_pop (fml->sym_tab, pop_handler);
204 int fml_preprocess (Fml fml)
206 fml->list = fml_tokenize (fml);
211 static void fml_init_token (struct token *tp, Fml fml)
213 tp->maxbuf = FML_ATOM_BUF*2;
215 tp->atombuf = tp->sbuf;
216 tp->tokenbuf = tp->sbuf + tp->maxbuf;
217 tp->escape_char = fml->escape_char;
220 static void fml_del_token (struct token *tp, Fml fml)
222 if (tp->maxbuf != FML_ATOM_BUF*2)
226 static void fml_cmd_lex (struct fml_node **np, struct token *tp)
239 tp->atom = (*np)->p[0];
241 fml_atom_str (tp->atom, tp->atombuf);
244 int l = fml_atom_str (tp->atom, NULL);
245 if (l >= tp->maxbuf-1)
247 if (tp->maxbuf != FML_ATOM_BUF*2)
250 tp->atombuf = malloc (tp->maxbuf*2);
251 tp->tokenbuf = tp->atombuf + tp->maxbuf;
253 fml_atom_str (tp->atom, tp->atombuf);
258 tp->sub = (*np)->p[0];
264 cp = tp->atombuf + tp->offset;
266 if (*cp == tp->escape_char)
269 tp->after_char = '\0';
282 tp->after_char = ' ';
286 if (*cp == tp->escape_char)
292 tp->after_char = ' ';
302 tp->offset = cp - tp->atombuf;
303 tp->after_char = '\0';
313 static struct fml_node *fml_lex_list (Fml fml, struct token *tp)
319 fn = fml_node_alloc (fml);
325 static struct fml_node *fml_exec_group (struct fml_node *list, Fml fml);
327 static void fml_lr_values (struct fml_node *l, int *left_val,
328 struct fml_node *r, int *right_val)
331 *left_val = fml_atom_val (l->p[0]);
335 *right_val = fml_atom_val (r->p[0]);
340 static struct fml_node *fml_exec_and (Fml fml, struct fml_node *l,
349 static struct fml_node *fml_exec_or (Fml fml, struct fml_node *l,
357 static struct fml_node *fml_exec_indx (Fml fml, struct fml_node *l,
360 struct fml_node *list = l;
363 if (!l || !r || !r->is_atom)
365 indx = fml_atom_val (r->p[0]);
366 while (--indx >= 1 && list)
372 struct fml_node *fn = fml_node_alloc (fml);
374 fn->p[0] = list->p[0];
381 static struct fml_node *fml_exec_plus (Fml fml, struct fml_node *l,
384 int left_val, right_val;
388 fml_lr_values (l, &left_val, r, &right_val);
389 sprintf (arg, "%d", left_val + right_val);
390 fn = fml_node_alloc (fml);
392 fn->p[0] = fml_atom_alloc (fml, arg);
396 static struct fml_node *fml_exec_minus (Fml fml, struct fml_node *l,
399 int left_val, right_val;
403 fml_lr_values (l, &left_val, r, &right_val);
404 sprintf (arg, "%d", left_val - right_val);
405 fn = fml_node_alloc (fml);
407 fn->p[0] = fml_atom_alloc (fml, arg);
412 static struct fml_node *fml_exec_gt (Fml fml, struct fml_node *l,
415 int left_val, right_val;
417 fml_lr_values (l, &left_val, r, &right_val);
418 if (left_val > right_val)
420 fn = fml_node_alloc (fml);
422 fn->p[0] = fml_atom_alloc (fml, "1");
430 static struct fml_node *fml_exec_lt (Fml fml, struct fml_node *l,
433 int left_val, right_val;
435 fml_lr_values (l, &left_val, r, &right_val);
436 if (left_val < right_val)
438 fn = fml_node_alloc (fml);
440 fn->p[0] = fml_atom_alloc (fml, "1");
447 static struct fml_node *fml_exec_eq (Fml fml, struct fml_node *l,
450 int left_val, right_val;
452 fml_lr_values (l, &left_val, r, &right_val);
453 if (left_val == right_val)
455 fn = fml_node_alloc (fml);
457 fn->p[0] = fml_atom_alloc (fml, "1");
464 static struct fml_node *fml_exec_ne (Fml fml, struct fml_node *l,
467 int left_val, right_val;
469 fml_lr_values (l, &left_val, r, &right_val);
470 if (left_val != right_val)
472 fn = fml_node_alloc (fml);
474 fn->p[0] = fml_atom_alloc (fml, "1");
481 static struct fml_node *fml_exec_le (Fml fml, struct fml_node *l,
484 int left_val, right_val;
486 fml_lr_values (l, &left_val, r, &right_val);
487 if (left_val <= right_val)
489 fn = fml_node_alloc (fml);
491 fn->p[0] = fml_atom_alloc (fml, "1");
498 static struct fml_node *fml_exec_ge (Fml fml, struct fml_node *l,
501 int left_val, right_val;
503 fml_lr_values (l, &left_val, r, &right_val);
504 if (left_val >= right_val)
506 fn = fml_node_alloc (fml);
508 fn->p[0] = fml_atom_alloc (fml, "1");
516 static struct fml_node *fml_exec_space (Fml fml, struct fml_node **lp,
522 static struct fml_node *fml_exec_nl (Fml fml, struct fml_node **lp,
529 static struct fml_node *fml_exec_incr (Fml fml, struct fml_node **lp,
532 struct fml_node *fn = NULL;
533 struct fml_sym_info *info;
534 fml_cmd_lex (lp, tp);
537 info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
539 if (info->kind == FML_VAR && info->body && info->body->is_atom)
544 val = fml_atom_val (info->body->p[0]);
545 fml_node_delete (fml, info->body);
546 sprintf (arg, "%d", val+1);
547 info->body = fn = fml_node_alloc (fml);
549 fn->p[0] = fml_atom_alloc (fml, arg);
555 static struct fml_node *fml_exec_decr (Fml fml, struct fml_node **lp,
558 struct fml_node *fn = NULL;
559 struct fml_sym_info *info;
560 fml_cmd_lex (lp, tp);
563 info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
565 if (info->kind == FML_VAR && info->body && info->body->is_atom)
570 val = fml_atom_val (info->body->p[0]);
571 sprintf (arg, "%d", val-1);
572 info->body = fn = fml_node_alloc (fml);
574 fn->p[0] = fml_atom_alloc (fml, arg);
580 static struct fml_node *fml_exec_prefix (struct fml_sym_info *info, Fml fml,
581 struct fml_node **lp,
585 struct fml_sym_info *arg_info;
586 struct fml_node *return_value;
587 static char arg[128];
592 printf ("exec_prefix ");
594 fml_sym_push (fml->sym_tab);
595 for (fn = info->args; fn; fn = fn->p[1])
597 fml_cmd_lex (lp, tp);
599 assert (fn->is_atom);
600 fml_atom_strx (fn->p[0], arg, 127);
607 arg_info = fml_sym_add_local (fml->sym_tab, arg);
608 arg_info->kind = FML_VAR;
609 arg_info->body = fml_lex_list (fml, tp);
611 arg_info->body = fml_sub0 (fml, arg_info->body);
614 fml_pr_list (arg_info->body);
618 return_value = fml_exec_group (info->body, fml);
629 static void fml_emit (struct fml_node *list)
640 for (a = list->p[0]; a; a=a->next)
641 printf ("%s", a->buf);
644 fml_emit (list->p[0]);
649 static struct fml_node *fml_sub1 (Fml fml, struct fml_node **lp,
653 static struct fml_node *fml_sub2 (Fml fml, struct fml_node **lp,
657 struct fml_sym_info *info;
660 info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
666 fml_cmd_lex (lp, tp);
669 fn = fml_exec_prefix (info, fml, lp, tp);
670 fml_cmd_lex (lp, tp);
673 fn = (*info->prefix) (fml, lp, tp);
674 fml_cmd_lex (lp, tp);
677 fml_cmd_lex (lp, tp);
681 else if (tp->kind == 'g')
684 fn = fml_sub0 (fml, tp->sub);
687 fml_cmd_lex (lp, tp);
689 else if (tp->kind == 't')
691 fn = fml_node_alloc (fml);
693 fn->p[0] = fml_atom_alloc (fml, tp->tokenbuf);
694 fml_cmd_lex (lp, tp);
701 static struct fml_node *fml_sub1 (Fml fml, struct fml_node **lp,
704 struct fml_node *f1, *f2;
705 struct fml_sym_info *info;
707 f1 = fml_sub2 (fml, lp, tp);
708 while (tp->kind == 'e')
710 info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
713 fprintf (stderr, "cannot locate `%s'", tp->tokenbuf);
716 if (info->kind == FML_CBINARY)
718 fml_cmd_lex (lp, tp);
719 f2 = fml_sub2 (fml, lp, tp);
720 f1 = (*info->binary) (fml, f1, f2);
723 else if (info->kind == FML_BINARY)
725 struct fml_sym_info *arg_info;
731 printf ("exec binary %s", tp->tokenbuf);
733 fml_cmd_lex (lp, tp);
734 f2 = fml_sub2 (fml, lp, tp);
735 fml_sym_push (fml->sym_tab);
737 fml_atom_strx (info->args->p[0], arg, 127);
738 arg_info = fml_sym_add_local (fml->sym_tab, arg);
739 arg_info->kind = FML_VAR;
746 fml_atom_strx ( ((struct fml_node *) info->args->p[1])->p[0],
748 arg_info = fml_sym_add_local (fml->sym_tab, arg);
749 arg_info->kind = FML_VAR;
757 f1 = fml_exec_group (info->body, fml);
772 static struct fml_node *fml_sub_bad (Fml fml, struct fml_node *list)
775 struct fml_node *fn, *fn1;
777 fml_init_token (&token, fml);
779 fml_cmd_lex (&list, &token);
780 fn = fml_sub1 (fml, &list, &token);
781 if (token.kind == '\0')
783 fml_del_token (&token, fml);
786 fn1 = fml_node_alloc (fml);
789 while (token.kind != '\0')
791 fn1 = fn1->p[1] = fml_node_alloc (fml);
792 fn1->p[0] = fml_sub1 (fml, &list, &token);
794 fml_del_token (&token, fml);
799 static struct fml_node *fml_sub0 (Fml fml, struct fml_node *list)
802 struct fml_node *fn, *fn1;
804 fml_init_token (&token, fml);
806 fml_cmd_lex (&list, &token);
807 fn1 = fn = fml_sub1 (fml, &list, &token);
809 while (token.kind != '\0')
810 fn1 = fn1->p[1] = fml_sub1 (fml, &list, &token);
811 fml_del_token (&token, fml);
815 static struct fml_node *fml_exec_foreach (struct fml_sym_info *info, Fml fml,
816 struct fml_node **lp,
819 struct fml_sym_info *info_var;
820 struct fml_node *fn, *body;
821 struct fml_node *return_value = NULL, *rv;
823 fml_cmd_lex (lp, tp);
824 assert (tp->kind == 't');
826 info_var = fml_sym_lookup_local (fml->sym_tab, tp->tokenbuf);
829 info_var = fml_sym_add_local (fml->sym_tab, tp->tokenbuf);
830 info_var->body = NULL;
831 info_var->kind = FML_VAR;
836 printf ("[foreach %s ", tp->tokenbuf);
838 fml_cmd_lex (lp, tp);
840 fn = fml_lex_list (fml, tp);
842 fn = fml_sub0 (fml, fn);
844 fml_cmd_lex (lp, tp);
846 body = fml_lex_list (fml, tp);
852 struct fml_node *fn1;
853 fn1 = fml_node_alloc (fml);
855 fn1->p[0] = fn->p[0];
856 info_var->body = fn1;
859 info_var->body = fn->p[0];
864 printf ("[foreach loop var=");
865 fml_pr_list (info_var->body);
868 rv = fml_exec_group (body, fml);
878 static struct fml_node *fml_exec_if (struct fml_sym_info *info, Fml fml,
879 struct fml_node **lp, struct token *tp)
881 struct fml_node *fn, *body;
882 struct fml_node *rv, *return_value = NULL;
884 fml_cmd_lex (lp, tp);
885 fn = fml_lex_list (fml, tp);
887 fn = fml_sub0 (fml, fn);
888 fml_cmd_lex (lp, tp);
891 body = fml_lex_list (fml, tp);
892 rv = fml_exec_group (body, fml);
896 fml_cmd_lex (lp, tp);
899 info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
900 if (info->kind == FML_ELSE)
902 fml_cmd_lex (lp, tp);
903 body = fml_lex_list (fml, tp);
904 fml_cmd_lex (lp, tp);
907 rv = fml_exec_group (body, fml);
916 static struct fml_node *fml_exec_while (struct fml_sym_info *info, Fml fml,
917 struct fml_node **lp, struct token *tp)
919 struct fml_node *fn, *body;
920 struct fml_node *return_value = NULL;
922 fml_cmd_lex (lp, tp);
923 fn = fml_lex_list (fml, tp);
925 fml_cmd_lex (lp, tp);
926 body = fml_lex_list (fml, tp);
929 struct fml_node *fn_expr;
933 fn_expr = fml_sub0 (fml, fn);
936 rv = fml_exec_group (body, fml);
943 static void fml_exec_set (struct fml_sym_info *info, Fml fml,
944 struct fml_node **lp, struct token *tp)
947 struct fml_sym_info *info_var;
949 fml_cmd_lex (lp, tp);
950 info_var = fml_sym_lookup_local (fml->sym_tab, tp->tokenbuf);
953 info_var = fml_sym_add_local (fml->sym_tab, tp->tokenbuf);
954 info_var->body = NULL;
959 printf ("set %s ", tp->tokenbuf);
961 info_var->kind = FML_VAR;
962 fml_cmd_lex (lp, tp);
963 fn = fml_lex_list (fml, tp);
966 fn = fml_sub0 (fml, fn);
970 fml_pr_list (info_var->body);
975 static void fml_emit_expr (Fml fml, struct fml_node **lp, struct token *tp)
979 fn = fml_sub1 (fml, lp, tp);
983 static struct fml_node *fml_exec_group (struct fml_node *list, Fml fml)
986 struct fml_sym_info *info;
988 struct fml_node *return_value = NULL, *rv;
992 fml_init_token (&token, fml);
993 fml_cmd_lex (&list, &token);
999 rv = fml_exec_group (token.sub, fml);
1004 info = fml_sym_lookup (fml->sym_tab, token.tokenbuf);
1007 struct fml_node *fn;
1012 fml_cmd_lex (&list, &token);
1013 assert (token.kind == 't');
1014 info = fml_sym_lookup (fml->sym_tab, token.tokenbuf);
1016 info = fml_sym_add (fml->sym_tab, token.tokenbuf);
1017 info->kind = FML_PREFIX;
1021 fml_cmd_lex (&list, &token);
1022 if (token.kind != 't')
1026 info->args = fn = fml_node_alloc (fml);
1030 for (fn = info->args; fn->p[1]; fn=fn->p[1])
1032 fn = fn->p[1] = fml_node_alloc (fml);
1034 fn->p[0] = token.atom;
1037 assert (token.kind == 'g');
1038 info->body = token.sub;
1041 fml_cmd_lex (&list, &token);
1042 assert (token.kind == 't');
1043 info = fml_sym_lookup (fml->sym_tab, token.tokenbuf);
1045 info = fml_sym_add (fml->sym_tab, token.tokenbuf);
1046 info->kind = FML_BINARY;
1048 fml_cmd_lex (&list, &token);
1049 assert (token.kind == 't');
1050 info->args = fn = fml_node_alloc (fml);
1051 fn->p[0] = token.atom;
1054 fml_cmd_lex (&list, &token);
1055 assert (token.kind == 't');
1056 fn = fn->p[1] = fml_node_alloc (fml);
1057 fn->p[0] = token.atom;
1060 fml_cmd_lex (&list, &token);
1061 assert (token.kind == 'g');
1062 info->body = token.sub;
1066 after_char = token.after_char;
1067 fml_exec_prefix (info, fml, &list, &token);
1069 putchar (after_char);
1072 fml_emit (info->body);
1073 if (token.after_char)
1074 putchar (token.after_char);
1082 if (token.offset == 0)
1086 fml_emit_expr (fml, &list, &token);
1089 rv = fml_exec_foreach (info, fml, &list, &token);
1094 rv = fml_exec_if (info, fml, &list, &token);
1099 fml_exec_set (info, fml, &list, &token);
1102 rv = fml_exec_while (info, fml, &list, &token);
1107 fml_cmd_lex (&list, &token);
1108 return_value = fml_lex_list (fml, &token);
1110 return_value = fml_sub0 (fml, return_value);
1114 printf ("return of:");
1115 fml_pr_list (return_value);
1120 printf ("unknown token: `%s'", token.tokenbuf);
1121 fml_cmd_lex (&list, &token);
1126 printf ("<unknown>");
1132 if (token.offset == 0)
1136 fml_emit_expr (fml, &list, &token);
1139 printf ("%s", token.tokenbuf);
1140 if (token.after_char)
1141 putchar (token.after_char);
1144 fml_cmd_lex (&list, &token);
1146 fml_del_token (&token, fml);
1147 return return_value;
1150 void fml_exec (Fml fml)
1152 fml_exec_group (fml->list, fml);