2 * FML interpreter. Europagate, 1995
5 * Revision 1.10 1995/02/21 17:46:08 adam
8 * Revision 1.9 1995/02/21 14:00:03 adam
11 * Revision 1.8 1995/02/10 18:15:52 adam
12 * FML function 'strcmp' implemented. This function can be used to
13 * test for existence of MARC fields.
15 * Revision 1.7 1995/02/10 15:50:54 adam
16 * MARC interface implemented. Minor bugs fixed. fmltest can
17 * be used to format single MARC records. New function '\list'
20 * Revision 1.6 1995/02/09 16:06:06 adam
21 * FML can be called from the outside multiple times by the functions:
22 * fml_exec_call and fml_exec_call_str.
23 * An interactive parameter (-i) to fmltest starts a shell-like
24 * interface to FML by using the fml_exec_call_str function.
26 * Revision 1.5 1995/02/09 14:33:36 adam
27 * Split source fml.c and define relevant build-in functions in separate
28 * files. New operators mult, div, not, llen implemented.
30 * Revision 1.4 1995/02/09 13:07:14 adam
31 * Nodes are freed now. Many bugs fixed.
33 * Revision 1.3 1995/02/07 16:09:23 adam
34 * The \ character is no longer INCLUDED when terminating a token.
35 * Major changes in tokenization routines. Bug fixes in expressions
36 * with lists (fml_sub0).
38 * Revision 1.2 1995/02/06 15:23:25 adam
39 * Added some more relational operators (le,ne,ge). Added increment
40 * and decrement operators. Function index changed, so that first
41 * element is 1 - not 0. Function fml_atom_val edited.
43 * Revision 1.1.1.1 1995/02/06 13:48:10 adam
44 * First version of the FML interpreter. It's slow and memory isn't
45 * freed properly. In particular, the FML nodes aren't released yet.
54 static int default_read_func (void)
59 static void default_err_handle (int no)
61 fprintf (stderr, "Error: %d\n", no);
64 static struct fml_node *fml_sub0 (Fml fml, struct fml_node *list);
65 static struct fml_node *fml_sub1 (Fml fml, struct fml_node **lp,
67 static struct fml_node *fml_sub2 (Fml fml, struct fml_node **lp,
69 static struct fml_node *fml_exec_space (Fml fml, struct fml_node **lp,
71 static struct fml_node *fml_exec_nl (Fml fml, struct fml_node **lp,
74 static int indent = 0;
76 static void pr_indent (int n)
99 struct fml_sym_info *sym_info;
101 Fml fml = malloc (sizeof(*fml));
106 fml->escape_char = '\\';
107 fml->comment_char = '#';
109 fml->white_chars = " \t\f\r\n";
110 fml->read_func = default_read_func;
111 fml->err_handle = default_err_handle;
114 fml->sym_tab = fml_sym_open ();
115 fml->atom_free_list = NULL;
116 fml->node_free_list = NULL;
119 sym_info = fml_sym_add (fml->sym_tab, "func");
120 sym_info->kind = FML_FUNC;
121 sym_info = fml_sym_add (fml->sym_tab, "bin");
122 sym_info->kind = FML_BIN;
123 sym_info = fml_sym_add (fml->sym_tab, "if");
124 sym_info->kind = FML_IF;
125 sym_info = fml_sym_add (fml->sym_tab, "else");
126 sym_info->kind = FML_ELSE;
127 sym_info = fml_sym_add (fml->sym_tab, "foreach");
128 sym_info->kind = FML_FOREACH;
129 sym_info = fml_sym_add (fml->sym_tab, "set");
130 sym_info->kind = FML_SET;
131 sym_info = fml_sym_add (fml->sym_tab, "while");
132 sym_info->kind = FML_WHILE;
133 sym_info = fml_sym_add (fml->sym_tab, "return");
134 sym_info->kind = FML_RETURN;
141 sym_info = fml_sym_add (fml->sym_tab, "s");
142 sym_info->kind = FML_CPREFIX;
143 sym_info->prefix = fml_exec_space;
144 sym_info = fml_sym_add (fml->sym_tab, " ");
145 sym_info->kind = FML_CPREFIX;
146 sym_info->prefix = fml_exec_space;
147 sym_info = fml_sym_add (fml->sym_tab, "n");
148 sym_info->kind = FML_CPREFIX;
149 sym_info->prefix = fml_exec_nl;
154 static Fml fml_pop_handler = NULL;
155 static void pop_handler (struct fml_sym_info *info)
157 assert (fml_pop_handler);
161 fml_node_delete (fml_pop_handler, info->body);
165 static void fml_do_pop (Fml fml)
167 fml_pop_handler = fml;
168 fml_sym_pop (fml->sym_tab, pop_handler);
171 int fml_preprocess (Fml fml)
173 fml->list = fml_tokenize (fml);
178 void fml_init_token (struct token *tp, Fml fml)
180 tp->maxbuf = FML_ATOM_BUF*2;
182 tp->atombuf = tp->sbuf;
183 tp->tokenbuf = tp->sbuf + tp->maxbuf;
184 tp->escape_char = fml->escape_char;
187 void fml_del_token (struct token *tp, Fml fml)
189 if (tp->maxbuf != FML_ATOM_BUF*2)
193 void fml_cmd_lex (struct fml_node **np, struct token *tp)
207 tp->atom = (*np)->p[0];
209 fml_atom_str (tp->atom, tp->atombuf);
212 int l = fml_atom_str (tp->atom, NULL);
213 if (l >= tp->maxbuf-1)
215 if (tp->maxbuf != FML_ATOM_BUF*2)
218 tp->atombuf = malloc (tp->maxbuf*2);
219 tp->tokenbuf = tp->atombuf + tp->maxbuf;
221 fml_atom_str (tp->atom, tp->atombuf);
226 tp->sub = (*np)->p[0];
234 cp = tp->atombuf + tp->offset;
236 if (*cp == tp->escape_char)
254 if (*cp == tp->escape_char)
257 tp->offset = cp - tp->atombuf;
267 struct fml_node *fml_expr_term (Fml fml, struct fml_node **lp,
273 fn = fml_sub0 (fml, tp->sub);
274 fml_cmd_lex (lp, tp);
277 fn = fml_sub2 (fml, lp, tp);
281 void fml_lr_values (Fml fml, struct fml_node *l, int *left_val,
282 struct fml_node *r, int *right_val)
285 *left_val = fml_atom_val (l->p[0]);
289 *right_val = fml_atom_val (r->p[0]);
292 fml_node_delete (fml, l);
293 fml_node_delete (fml, r);
296 static struct fml_node *fml_exec_space (Fml fml, struct fml_node **lp,
299 fml_cmd_lex (lp, tp);
307 static struct fml_node *fml_exec_nl (Fml fml, struct fml_node **lp,
310 fml_cmd_lex (lp, tp);
315 static struct fml_node *fml_exec_prefix (struct fml_sym_info *info, Fml fml,
316 struct fml_node **lp,
320 struct fml_sym_info *arg_info;
321 struct fml_node *return_value;
322 static char arg[128];
327 printf ("exec_prefix ");
329 fml_sym_push (fml->sym_tab);
330 fml_cmd_lex (lp, tp);
331 for (fn = info->args; fn; fn = fn->p[1])
334 assert (fn->is_atom);
335 fml_atom_strx (fn->p[0], arg, 127);
341 arg_info = fml_sym_add_local (fml->sym_tab, arg);
342 arg_info->kind = FML_VAR;
346 arg_info->body = fml_sub0 (fml, tp->sub);
347 fml_cmd_lex (lp, tp);
350 arg_info->body = fml_sub2 (fml, lp, tp);
353 fml_pr_list (arg_info->body);
357 return_value = fml_exec_group (info->body, fml);
368 static void fml_emit (struct fml_node *list)
379 for (a = list->p[0]; a; a=a->next)
380 printf ("%.*s", FML_ATOM_BUF, a->buf);
383 fml_emit (list->p[0]);
389 static struct fml_node *fml_sub2 (Fml fml, struct fml_node **lp,
393 struct fml_sym_info *info;
396 info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
401 fn = fml_node_copy (fml, info->body);
402 fml_cmd_lex (lp, tp);
405 fn = fml_exec_prefix (info, fml, lp, tp);
408 fn = (*info->prefix) (fml, lp, tp);
411 fml_cmd_lex (lp, tp);
415 else if (tp->kind == 'g')
418 fn = fml_sub0 (fml, tp->sub);
421 fml_cmd_lex (lp, tp);
423 else if (tp->kind == 't')
425 fn = fml_node_alloc (fml);
427 fn->p[0] = fml_atom_alloc (fml, tp->tokenbuf);
428 fml_cmd_lex (lp, tp);
435 static struct fml_node *fml_sub1 (Fml fml, struct fml_node **lp,
438 struct fml_node *f1, *f2, *fn;
439 struct fml_sym_info *info;
441 f1 = fml_sub2 (fml, lp, tp);
442 while (tp->kind == 'e')
444 info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
447 fprintf (stderr, "cannot locate `%s'", tp->tokenbuf);
450 if (info->kind == FML_CBINARY)
452 fml_cmd_lex (lp, tp);
453 f2 = fml_sub2 (fml, lp, tp);
454 fn = (*info->binary) (fml, f1, f2);
458 else if (info->kind == FML_BINARY)
460 struct fml_sym_info *arg_info;
466 printf ("exec binary %s", tp->tokenbuf);
468 fml_cmd_lex (lp, tp);
469 f2 = fml_sub2 (fml, lp, tp);
470 fml_sym_push (fml->sym_tab);
472 fml_atom_strx (info->args->p[0], arg, 127);
473 arg_info = fml_sym_add_local (fml->sym_tab, arg);
474 arg_info->kind = FML_VAR;
481 fml_atom_strx ( ((struct fml_node *) info->args->p[1])->p[0],
483 arg_info = fml_sym_add_local (fml->sym_tab, arg);
484 arg_info->kind = FML_VAR;
492 f1 = fml_exec_group (info->body, fml);
507 static struct fml_node *fml_sub0 (Fml fml, struct fml_node *list)
510 struct fml_node *fn, *fn1;
512 fml_init_token (&token, fml);
514 fml_cmd_lex (&list, &token);
515 fn = fml_sub1 (fml, &list, &token);
516 if (token.kind == '\0')
518 fml_del_token (&token, fml);
521 fn1 = fml_node_alloc (fml);
524 while (token.kind != '\0')
526 fn1 = fn1->p[1] = fml_node_alloc (fml);
527 fn1->p[0] = fml_sub1 (fml, &list, &token);
529 fml_del_token (&token, fml);
533 static struct fml_node *fml_sub0 (Fml fml, struct fml_node *list)
536 struct fml_node *fn, *fn0, *fn1;
540 fml_init_token (&token, fml);
541 fml_cmd_lex (&list, &token);
542 fn1 = fn = fml_sub1 (fml, &list, &token);
545 fml_del_token (&token, fml);
548 if (fn->p[1] && token.kind != '\0')
550 fn1 = fml_node_alloc (fml);
554 while (token.kind != '\0')
556 fn = fml_sub1 (fml, &list, &token);
559 fn1 = fn1->p[1] = fml_node_alloc (fml);
564 fn1 = fn1->p[1] = fn;
567 fml_del_token (&token, fml);
572 static struct fml_node *fml_exec_foreach (struct fml_sym_info *info, Fml fml,
573 struct fml_node **lp,
576 struct fml_sym_info *info_var;
577 struct fml_node *fn, *body;
578 struct fml_node *return_value = NULL, *rv;
580 fml_cmd_lex (lp, tp);
581 assert (tp->kind == 't');
583 info_var = fml_sym_lookup_local (fml->sym_tab, tp->tokenbuf);
586 info_var = fml_sym_add_local (fml->sym_tab, tp->tokenbuf);
587 info_var->body = NULL;
588 info_var->kind = FML_VAR;
592 if (info_var->kind == FML_VAR)
593 fml_node_delete (fml, info_var->body);
594 info_var->body = NULL;
599 printf ("[foreach %s ", tp->tokenbuf);
601 fml_cmd_lex (lp, tp);
602 assert (tp->kind == 'g');
603 fn = fml_sub0 (fml, tp->sub);
605 fml_cmd_lex (lp, tp);
606 assert (tp->kind == 'g');
611 struct fml_node *fn1;
618 info_var->body = fn->p[0];
622 printf ("[foreach loop var=");
623 fml_pr_list (info_var->body);
626 rv = fml_exec_group (body, fml);
629 fml_node_delete (fml, fn);
632 info_var->body = NULL;
638 static struct fml_node *fml_exec_if (struct fml_sym_info *info, Fml fml,
639 struct fml_node **lp, struct token *tp)
641 struct fml_node *fn, *body;
642 struct fml_node *rv, *return_value = NULL;
644 fml_cmd_lex (lp, tp);
645 assert (tp->kind == 'g');
646 fn = fml_sub0 (fml, tp->sub);
647 fml_cmd_lex (lp, tp);
648 assert (tp->kind == 'g');
651 rv = fml_exec_group (tp->sub, fml);
655 fml_cmd_lex (lp, tp);
658 info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
659 if (info->kind == FML_ELSE)
661 fml_cmd_lex (lp, tp);
662 assert (tp->kind == 'g');
666 rv = fml_exec_group (body, fml);
670 fml_cmd_lex (lp, tp);
673 fml_node_delete (fml, fn);
677 static struct fml_node *fml_exec_while (struct fml_sym_info *info, Fml fml,
678 struct fml_node **lp, struct token *tp)
680 struct fml_node *fn, *body;
681 struct fml_node *return_value = NULL;
683 fml_cmd_lex (lp, tp);
684 assert (tp->kind == 'g');
687 fml_cmd_lex (lp, tp);
688 assert (tp->kind == 'g');
693 struct fml_node *fn_expr;
697 fn_expr = fml_sub0 (fml, fn);
700 fml_node_delete (fml, fn_expr);
701 rv = fml_exec_group (body, fml);
708 static void fml_exec_set (struct fml_sym_info *info, Fml fml,
709 struct fml_node **lp, struct token *tp)
712 struct fml_sym_info *info_var;
714 fml_cmd_lex (lp, tp);
715 info_var = fml_sym_lookup_local (fml->sym_tab, tp->tokenbuf);
718 info_var = fml_sym_add_local (fml->sym_tab, tp->tokenbuf);
719 info_var->body = NULL;
724 printf ("set %s ", tp->tokenbuf);
726 info_var->kind = FML_VAR;
727 fml_cmd_lex (lp, tp);
731 fn = fml_sub0 (fml, tp->sub);
732 fml_cmd_lex (lp, tp);
735 fn = fml_sub2 (fml, lp, tp);
736 fml_node_delete (fml, info_var->body);
740 fml_pr_list (info_var->body);
745 static void fml_emit_expr (Fml fml, struct fml_node **lp, struct token *tp)
749 fn = fml_sub1 (fml, lp, tp);
751 fml_node_delete (fml, fn);
754 struct fml_node *fml_exec_group (struct fml_node *list, Fml fml)
757 struct fml_sym_info *info;
759 struct fml_node *return_value = NULL, *rv;
763 fml_init_token (&token, fml);
764 fml_cmd_lex (&list, &token);
770 rv = fml_exec_group (token.sub, fml);
775 info = fml_sym_lookup (fml->sym_tab, token.tokenbuf);
783 fml_cmd_lex (&list, &token);
784 assert (token.kind == 't');
785 info = fml_sym_lookup (fml->sym_tab, token.tokenbuf);
787 info = fml_sym_add (fml->sym_tab, token.tokenbuf);
788 info->kind = FML_PREFIX;
792 fml_cmd_lex (&list, &token);
793 if (token.kind != 't')
797 info->args = fn = fml_node_alloc (fml);
801 for (fn = info->args; fn->p[1]; fn=fn->p[1])
803 fn = fn->p[1] = fml_node_alloc (fml);
805 fn->p[0] = token.atom;
808 assert (token.kind == 'g');
809 info->body = token.sub;
812 fml_cmd_lex (&list, &token);
813 assert (token.kind == 't');
814 info = fml_sym_lookup (fml->sym_tab, token.tokenbuf);
816 info = fml_sym_add (fml->sym_tab, token.tokenbuf);
817 info->kind = FML_BINARY;
819 fml_cmd_lex (&list, &token);
820 assert (token.kind == 't');
821 info->args = fn = fml_node_alloc (fml);
822 fn->p[0] = token.atom;
825 fml_cmd_lex (&list, &token);
826 assert (token.kind == 't');
827 fn = fn->p[1] = fml_node_alloc (fml);
828 fn->p[0] = token.atom;
831 fml_cmd_lex (&list, &token);
832 assert (token.kind == 'g');
833 info->body = token.sub;
838 if (token.separate && !first)
841 fml_emit_expr (fml, &list, &token);
845 rv = fml_exec_foreach (info, fml, &list, &token);
850 rv = fml_exec_if (info, fml, &list, &token);
855 fml_exec_set (info, fml, &list, &token);
859 rv = fml_exec_while (info, fml, &list, &token);
864 fml_cmd_lex (&list, &token);
866 if (token.kind == 'g')
868 return_value = fml_sub0 (fml, token.sub);
869 fml_cmd_lex (&list, &token);
872 return_value = fml_sub2 (fml, &list, &token);
876 printf ("return of:");
877 fml_pr_list (return_value);
882 printf ("unknown token: `%s'", token.tokenbuf);
883 fml_cmd_lex (&list, &token);
888 printf ("<unknown>");
892 if (token.separate && !first)
895 fml_emit_expr (fml, &list, &token);
899 fml_cmd_lex (&list, &token);
901 fml_del_token (&token, fml);
905 void fml_exec (Fml fml)
908 fml_exec_group (fml->list, fml);