2 * FML interpreter. Europagate, 1995
5 * Revision 1.7 1995/02/10 15:50:54 adam
6 * MARC interface implemented. Minor bugs fixed. fmltest can
7 * be used to format single MARC records. New function '\list'
10 * Revision 1.6 1995/02/09 16:06:06 adam
11 * FML can be called from the outside multiple times by the functions:
12 * fml_exec_call and fml_exec_call_str.
13 * An interactive parameter (-i) to fmltest starts a shell-like
14 * interface to FML by using the fml_exec_call_str function.
16 * Revision 1.5 1995/02/09 14:33:36 adam
17 * Split source fml.c and define relevant build-in functions in separate
18 * files. New operators mult, div, not, llen implemented.
20 * Revision 1.4 1995/02/09 13:07:14 adam
21 * Nodes are freed now. Many bugs fixed.
23 * Revision 1.3 1995/02/07 16:09:23 adam
24 * The \ character is no longer INCLUDED when terminating a token.
25 * Major changes in tokenization routines. Bug fixes in expressions
26 * with lists (fml_sub0).
28 * Revision 1.2 1995/02/06 15:23:25 adam
29 * Added some more relational operators (le,ne,ge). Added increment
30 * and decrement operators. Function index changed, so that first
31 * element is 1 - not 0. Function fml_atom_val edited.
33 * Revision 1.1.1.1 1995/02/06 13:48:10 adam
34 * First version of the FML interpreter. It's slow and memory isn't
35 * freed properly. In particular, the FML nodes aren't released yet.
44 static int default_read_func (void)
49 static void default_err_handle (int no)
51 fprintf (stderr, "Error: %d\n", no);
54 static struct fml_node *fml_sub0 (Fml fml, struct fml_node *list);
55 static struct fml_node *fml_sub1 (Fml fml, struct fml_node **lp,
57 static struct fml_node *fml_sub2 (Fml fml, struct fml_node **lp,
59 static struct fml_node *fml_exec_space (Fml fml, struct fml_node **lp,
61 static struct fml_node *fml_exec_nl (Fml fml, struct fml_node **lp,
64 static int indent = 0;
66 static void pr_indent (int n)
89 struct fml_sym_info *sym_info;
91 Fml fml = malloc (sizeof(*fml));
96 fml->escape_char = '\\';
97 fml->comment_char = '#';
99 fml->white_chars = " \t\f\r\n";
100 fml->read_func = default_read_func;
101 fml->err_handle = default_err_handle;
104 fml->sym_tab = fml_sym_open ();
105 fml->atom_free_list = NULL;
106 fml->node_free_list = NULL;
109 sym_info = fml_sym_add (fml->sym_tab, "func");
110 sym_info->kind = FML_FUNC;
111 sym_info = fml_sym_add (fml->sym_tab, "bin");
112 sym_info->kind = FML_BIN;
113 sym_info = fml_sym_add (fml->sym_tab, "if");
114 sym_info->kind = FML_IF;
115 sym_info = fml_sym_add (fml->sym_tab, "else");
116 sym_info->kind = FML_ELSE;
117 sym_info = fml_sym_add (fml->sym_tab, "foreach");
118 sym_info->kind = FML_FOREACH;
119 sym_info = fml_sym_add (fml->sym_tab, "set");
120 sym_info->kind = FML_SET;
121 sym_info = fml_sym_add (fml->sym_tab, "while");
122 sym_info->kind = FML_WHILE;
123 sym_info = fml_sym_add (fml->sym_tab, "return");
124 sym_info->kind = FML_RETURN;
130 sym_info = fml_sym_add (fml->sym_tab, "s");
131 sym_info->kind = FML_CPREFIX;
132 sym_info->prefix = fml_exec_space;
133 sym_info = fml_sym_add (fml->sym_tab, " ");
134 sym_info->kind = FML_CPREFIX;
135 sym_info->prefix = fml_exec_space;
136 sym_info = fml_sym_add (fml->sym_tab, "n");
137 sym_info->kind = FML_CPREFIX;
138 sym_info->prefix = fml_exec_nl;
143 static Fml fml_pop_handler = NULL;
144 static void pop_handler (struct fml_sym_info *info)
146 assert (fml_pop_handler);
150 fml_node_delete (fml_pop_handler, info->body);
154 static void fml_do_pop (Fml fml)
156 fml_pop_handler = fml;
157 fml_sym_pop (fml->sym_tab, pop_handler);
160 int fml_preprocess (Fml fml)
162 fml->list = fml_tokenize (fml);
167 void fml_init_token (struct token *tp, Fml fml)
169 tp->maxbuf = FML_ATOM_BUF*2;
171 tp->atombuf = tp->sbuf;
172 tp->tokenbuf = tp->sbuf + tp->maxbuf;
173 tp->escape_char = fml->escape_char;
176 void fml_del_token (struct token *tp, Fml fml)
178 if (tp->maxbuf != FML_ATOM_BUF*2)
182 void fml_cmd_lex (struct fml_node **np, struct token *tp)
196 tp->atom = (*np)->p[0];
198 fml_atom_str (tp->atom, tp->atombuf);
201 int l = fml_atom_str (tp->atom, NULL);
202 if (l >= tp->maxbuf-1)
204 if (tp->maxbuf != FML_ATOM_BUF*2)
207 tp->atombuf = malloc (tp->maxbuf*2);
208 tp->tokenbuf = tp->atombuf + tp->maxbuf;
210 fml_atom_str (tp->atom, tp->atombuf);
215 tp->sub = (*np)->p[0];
223 cp = tp->atombuf + tp->offset;
225 if (*cp == tp->escape_char)
243 if (*cp == tp->escape_char)
246 tp->offset = cp - tp->atombuf;
256 struct fml_node *fml_expr_term (Fml fml, struct fml_node **lp,
262 fn = fml_sub0 (fml, tp->sub);
263 fml_cmd_lex (lp, tp);
266 fn = fml_sub2 (fml, lp, tp);
270 void fml_lr_values (Fml fml, struct fml_node *l, int *left_val,
271 struct fml_node *r, int *right_val)
274 *left_val = fml_atom_val (l->p[0]);
278 *right_val = fml_atom_val (r->p[0]);
281 fml_node_delete (fml, l);
282 fml_node_delete (fml, r);
285 static struct fml_node *fml_exec_space (Fml fml, struct fml_node **lp,
288 fml_cmd_lex (lp, tp);
296 static struct fml_node *fml_exec_nl (Fml fml, struct fml_node **lp,
299 fml_cmd_lex (lp, tp);
304 static struct fml_node *fml_exec_prefix (struct fml_sym_info *info, Fml fml,
305 struct fml_node **lp,
309 struct fml_sym_info *arg_info;
310 struct fml_node *return_value;
311 static char arg[128];
316 printf ("exec_prefix ");
318 fml_sym_push (fml->sym_tab);
319 fml_cmd_lex (lp, tp);
320 for (fn = info->args; fn; fn = fn->p[1])
323 assert (fn->is_atom);
324 fml_atom_strx (fn->p[0], arg, 127);
330 arg_info = fml_sym_add_local (fml->sym_tab, arg);
331 arg_info->kind = FML_VAR;
335 arg_info->body = fml_sub0 (fml, tp->sub);
336 fml_cmd_lex (lp, tp);
339 arg_info->body = fml_sub2 (fml, lp, tp);
342 fml_pr_list (arg_info->body);
346 return_value = fml_exec_group (info->body, fml);
357 static void fml_emit (struct fml_node *list)
368 for (a = list->p[0]; a; a=a->next)
369 printf ("%.*s", FML_ATOM_BUF, a->buf);
372 fml_emit (list->p[0]);
378 static struct fml_node *fml_sub2 (Fml fml, struct fml_node **lp,
382 struct fml_sym_info *info;
385 info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
390 fn = fml_node_copy (fml, info->body);
391 fml_cmd_lex (lp, tp);
394 fn = fml_exec_prefix (info, fml, lp, tp);
397 fn = (*info->prefix) (fml, lp, tp);
400 fml_cmd_lex (lp, tp);
404 else if (tp->kind == 'g')
407 fn = fml_sub0 (fml, tp->sub);
410 fml_cmd_lex (lp, tp);
412 else if (tp->kind == 't')
414 fn = fml_node_alloc (fml);
416 fn->p[0] = fml_atom_alloc (fml, tp->tokenbuf);
417 fml_cmd_lex (lp, tp);
424 static struct fml_node *fml_sub1 (Fml fml, struct fml_node **lp,
427 struct fml_node *f1, *f2, *fn;
428 struct fml_sym_info *info;
430 f1 = fml_sub2 (fml, lp, tp);
431 while (tp->kind == 'e')
433 info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
436 fprintf (stderr, "cannot locate `%s'", tp->tokenbuf);
439 if (info->kind == FML_CBINARY)
441 fml_cmd_lex (lp, tp);
442 f2 = fml_sub2 (fml, lp, tp);
443 fn = (*info->binary) (fml, f1, f2);
447 else if (info->kind == FML_BINARY)
449 struct fml_sym_info *arg_info;
455 printf ("exec binary %s", tp->tokenbuf);
457 fml_cmd_lex (lp, tp);
458 f2 = fml_sub2 (fml, lp, tp);
459 fml_sym_push (fml->sym_tab);
461 fml_atom_strx (info->args->p[0], arg, 127);
462 arg_info = fml_sym_add_local (fml->sym_tab, arg);
463 arg_info->kind = FML_VAR;
470 fml_atom_strx ( ((struct fml_node *) info->args->p[1])->p[0],
472 arg_info = fml_sym_add_local (fml->sym_tab, arg);
473 arg_info->kind = FML_VAR;
481 f1 = fml_exec_group (info->body, fml);
496 static struct fml_node *fml_sub0 (Fml fml, struct fml_node *list)
499 struct fml_node *fn, *fn1;
501 fml_init_token (&token, fml);
503 fml_cmd_lex (&list, &token);
504 fn = fml_sub1 (fml, &list, &token);
505 if (token.kind == '\0')
507 fml_del_token (&token, fml);
510 fn1 = fml_node_alloc (fml);
513 while (token.kind != '\0')
515 fn1 = fn1->p[1] = fml_node_alloc (fml);
516 fn1->p[0] = fml_sub1 (fml, &list, &token);
518 fml_del_token (&token, fml);
522 static struct fml_node *fml_sub0 (Fml fml, struct fml_node *list)
525 struct fml_node *fn, *fn0, *fn1;
529 fml_init_token (&token, fml);
531 fml_cmd_lex (&list, &token);
532 fn1 = fn = fml_sub1 (fml, &list, &token);
533 if (fn->p[1] && token.kind != '\0')
535 fn1 = fml_node_alloc (fml);
539 while (token.kind != '\0')
541 fn = fml_sub1 (fml, &list, &token);
544 fn1 = fn1->p[1] = fml_node_alloc (fml);
549 fn1 = fn1->p[1] = fn;
552 fml_del_token (&token, fml);
557 static struct fml_node *fml_exec_foreach (struct fml_sym_info *info, Fml fml,
558 struct fml_node **lp,
561 struct fml_sym_info *info_var;
562 struct fml_node *fn, *body;
563 struct fml_node *return_value = NULL, *rv;
565 fml_cmd_lex (lp, tp);
566 assert (tp->kind == 't');
568 info_var = fml_sym_lookup_local (fml->sym_tab, tp->tokenbuf);
571 info_var = fml_sym_add_local (fml->sym_tab, tp->tokenbuf);
572 info_var->body = NULL;
573 info_var->kind = FML_VAR;
577 if (info_var->kind == FML_VAR)
578 fml_node_delete (fml, info_var->body);
579 info_var->body = NULL;
584 printf ("[foreach %s ", tp->tokenbuf);
586 fml_cmd_lex (lp, tp);
587 assert (tp->kind == 'g');
588 fn = fml_sub0 (fml, tp->sub);
590 fml_cmd_lex (lp, tp);
591 assert (tp->kind == 'g');
596 struct fml_node *fn1;
603 info_var->body = fn->p[0];
607 printf ("[foreach loop var=");
608 fml_pr_list (info_var->body);
611 rv = fml_exec_group (body, fml);
614 fml_node_delete (fml, fn);
617 info_var->body = NULL;
623 static struct fml_node *fml_exec_if (struct fml_sym_info *info, Fml fml,
624 struct fml_node **lp, struct token *tp)
626 struct fml_node *fn, *body;
627 struct fml_node *rv, *return_value = NULL;
629 fml_cmd_lex (lp, tp);
630 assert (tp->kind == 'g');
631 fn = fml_sub0 (fml, tp->sub);
632 fml_cmd_lex (lp, tp);
633 assert (tp->kind == 'g');
636 rv = fml_exec_group (tp->sub, fml);
640 fml_cmd_lex (lp, tp);
643 info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
644 if (info->kind == FML_ELSE)
646 fml_cmd_lex (lp, tp);
647 assert (tp->kind == 'g');
651 rv = fml_exec_group (body, fml);
655 fml_cmd_lex (lp, tp);
658 fml_node_delete (fml, fn);
662 static struct fml_node *fml_exec_while (struct fml_sym_info *info, Fml fml,
663 struct fml_node **lp, struct token *tp)
665 struct fml_node *fn, *body;
666 struct fml_node *return_value = NULL;
668 fml_cmd_lex (lp, tp);
669 assert (tp->kind == 'g');
672 fml_cmd_lex (lp, tp);
673 assert (tp->kind == 'g');
678 struct fml_node *fn_expr;
682 fn_expr = fml_sub0 (fml, fn);
685 fml_node_delete (fml, fn_expr);
686 rv = fml_exec_group (body, fml);
693 static void fml_exec_set (struct fml_sym_info *info, Fml fml,
694 struct fml_node **lp, struct token *tp)
697 struct fml_sym_info *info_var;
699 fml_cmd_lex (lp, tp);
700 info_var = fml_sym_lookup_local (fml->sym_tab, tp->tokenbuf);
703 info_var = fml_sym_add_local (fml->sym_tab, tp->tokenbuf);
704 info_var->body = NULL;
709 printf ("set %s ", tp->tokenbuf);
711 info_var->kind = FML_VAR;
712 fml_cmd_lex (lp, tp);
716 fn = fml_sub0 (fml, tp->sub);
717 fml_cmd_lex (lp, tp);
720 fn = fml_sub2 (fml, lp, tp);
721 fml_node_delete (fml, info_var->body);
725 fml_pr_list (info_var->body);
730 static void fml_emit_expr (Fml fml, struct fml_node **lp, struct token *tp)
734 fn = fml_sub1 (fml, lp, tp);
736 fml_node_delete (fml, fn);
739 struct fml_node *fml_exec_group (struct fml_node *list, Fml fml)
742 struct fml_sym_info *info;
744 struct fml_node *return_value = NULL, *rv;
748 fml_init_token (&token, fml);
749 fml_cmd_lex (&list, &token);
755 rv = fml_exec_group (token.sub, fml);
760 info = fml_sym_lookup (fml->sym_tab, token.tokenbuf);
768 fml_cmd_lex (&list, &token);
769 assert (token.kind == 't');
770 info = fml_sym_lookup (fml->sym_tab, token.tokenbuf);
772 info = fml_sym_add (fml->sym_tab, token.tokenbuf);
773 info->kind = FML_PREFIX;
777 fml_cmd_lex (&list, &token);
778 if (token.kind != 't')
782 info->args = fn = fml_node_alloc (fml);
786 for (fn = info->args; fn->p[1]; fn=fn->p[1])
788 fn = fn->p[1] = fml_node_alloc (fml);
790 fn->p[0] = token.atom;
793 assert (token.kind == 'g');
794 info->body = token.sub;
797 fml_cmd_lex (&list, &token);
798 assert (token.kind == 't');
799 info = fml_sym_lookup (fml->sym_tab, token.tokenbuf);
801 info = fml_sym_add (fml->sym_tab, token.tokenbuf);
802 info->kind = FML_BINARY;
804 fml_cmd_lex (&list, &token);
805 assert (token.kind == 't');
806 info->args = fn = fml_node_alloc (fml);
807 fn->p[0] = token.atom;
810 fml_cmd_lex (&list, &token);
811 assert (token.kind == 't');
812 fn = fn->p[1] = fml_node_alloc (fml);
813 fn->p[0] = token.atom;
816 fml_cmd_lex (&list, &token);
817 assert (token.kind == 'g');
818 info->body = token.sub;
823 if (token.separate && !first)
826 fml_emit_expr (fml, &list, &token);
830 rv = fml_exec_foreach (info, fml, &list, &token);
835 rv = fml_exec_if (info, fml, &list, &token);
840 fml_exec_set (info, fml, &list, &token);
844 rv = fml_exec_while (info, fml, &list, &token);
849 fml_cmd_lex (&list, &token);
851 if (token.kind == 'g')
853 return_value = fml_sub0 (fml, token.sub);
854 fml_cmd_lex (&list, &token);
857 return_value = fml_sub2 (fml, &list, &token);
861 printf ("return of:");
862 fml_pr_list (return_value);
867 printf ("unknown token: `%s'", token.tokenbuf);
868 fml_cmd_lex (&list, &token);
873 printf ("<unknown>");
877 if (token.separate && !first)
880 fml_emit_expr (fml, &list, &token);
884 fml_cmd_lex (&list, &token);
886 fml_del_token (&token, fml);
890 void fml_exec (Fml fml)
893 fml_exec_group (fml->list, fml);