2 * FML interpreter. Europagate, 1995
5 * Revision 1.11 1995/02/22 08:50:49 adam
6 * Definition of CPP changed. Output function can be customized.
8 * Revision 1.10 1995/02/21 17:46:08 adam
11 * Revision 1.9 1995/02/21 14:00:03 adam
14 * Revision 1.8 1995/02/10 18:15:52 adam
15 * FML function 'strcmp' implemented. This function can be used to
16 * test for existence of MARC fields.
18 * Revision 1.7 1995/02/10 15:50:54 adam
19 * MARC interface implemented. Minor bugs fixed. fmltest can
20 * be used to format single MARC records. New function '\list'
23 * Revision 1.6 1995/02/09 16:06:06 adam
24 * FML can be called from the outside multiple times by the functions:
25 * fml_exec_call and fml_exec_call_str.
26 * An interactive parameter (-i) to fmltest starts a shell-like
27 * interface to FML by using the fml_exec_call_str function.
29 * Revision 1.5 1995/02/09 14:33:36 adam
30 * Split source fml.c and define relevant build-in functions in separate
31 * files. New operators mult, div, not, llen implemented.
33 * Revision 1.4 1995/02/09 13:07:14 adam
34 * Nodes are freed now. Many bugs fixed.
36 * Revision 1.3 1995/02/07 16:09:23 adam
37 * The \ character is no longer INCLUDED when terminating a token.
38 * Major changes in tokenization routines. Bug fixes in expressions
39 * with lists (fml_sub0).
41 * Revision 1.2 1995/02/06 15:23:25 adam
42 * Added some more relational operators (le,ne,ge). Added increment
43 * and decrement operators. Function index changed, so that first
44 * element is 1 - not 0. Function fml_atom_val edited.
46 * Revision 1.1.1.1 1995/02/06 13:48:10 adam
47 * First version of the FML interpreter. It's slow and memory isn't
48 * freed properly. In particular, the FML nodes aren't released yet.
57 static int default_read_func (void)
62 static void default_write_func (int c)
67 static void default_err_handle (int no)
69 fprintf (stderr, "Error: %d\n", no);
72 static struct fml_node *fml_sub0 (Fml fml, struct fml_node *list);
73 static struct fml_node *fml_sub1 (Fml fml, struct fml_node **lp,
75 static struct fml_node *fml_sub2 (Fml fml, struct fml_node **lp,
77 static struct fml_node *fml_exec_space (Fml fml, struct fml_node **lp,
79 static struct fml_node *fml_exec_nl (Fml fml, struct fml_node **lp,
82 static int indent = 0;
84 static void pr_indent (int n)
107 struct fml_sym_info *sym_info;
109 Fml fml = malloc (sizeof(*fml));
114 fml->escape_char = '\\';
115 fml->comment_char = '#';
117 fml->white_chars = " \t\f\r\n";
118 fml->read_func = default_read_func;
119 fml->err_handle = default_err_handle;
120 fml->write_func = default_write_func;
123 fml->sym_tab = fml_sym_open ();
124 fml->atom_free_list = NULL;
125 fml->node_free_list = NULL;
128 sym_info = fml_sym_add (fml->sym_tab, "func");
129 sym_info->kind = FML_FUNC;
130 sym_info = fml_sym_add (fml->sym_tab, "bin");
131 sym_info->kind = FML_BIN;
132 sym_info = fml_sym_add (fml->sym_tab, "if");
133 sym_info->kind = FML_IF;
134 sym_info = fml_sym_add (fml->sym_tab, "else");
135 sym_info->kind = FML_ELSE;
136 sym_info = fml_sym_add (fml->sym_tab, "foreach");
137 sym_info->kind = FML_FOREACH;
138 sym_info = fml_sym_add (fml->sym_tab, "set");
139 sym_info->kind = FML_SET;
140 sym_info = fml_sym_add (fml->sym_tab, "while");
141 sym_info->kind = FML_WHILE;
142 sym_info = fml_sym_add (fml->sym_tab, "return");
143 sym_info->kind = FML_RETURN;
150 sym_info = fml_sym_add (fml->sym_tab, "s");
151 sym_info->kind = FML_CPREFIX;
152 sym_info->prefix = fml_exec_space;
153 sym_info = fml_sym_add (fml->sym_tab, " ");
154 sym_info->kind = FML_CPREFIX;
155 sym_info->prefix = fml_exec_space;
156 sym_info = fml_sym_add (fml->sym_tab, "n");
157 sym_info->kind = FML_CPREFIX;
158 sym_info->prefix = fml_exec_nl;
163 static Fml fml_pop_handler = NULL;
164 static void pop_handler (struct fml_sym_info *info)
166 assert (fml_pop_handler);
170 fml_node_delete (fml_pop_handler, info->body);
174 static void fml_do_pop (Fml fml)
176 fml_pop_handler = fml;
177 fml_sym_pop (fml->sym_tab, pop_handler);
180 int fml_preprocess (Fml fml)
182 fml->list = fml_tokenize (fml);
187 void fml_init_token (struct token *tp, Fml fml)
189 tp->maxbuf = FML_ATOM_BUF*2;
191 tp->atombuf = tp->sbuf;
192 tp->tokenbuf = tp->sbuf + tp->maxbuf;
193 tp->escape_char = fml->escape_char;
196 void fml_del_token (struct token *tp, Fml fml)
198 if (tp->maxbuf != FML_ATOM_BUF*2)
202 void fml_cmd_lex (struct fml_node **np, struct token *tp)
216 tp->atom = (*np)->p[0];
218 fml_atom_str (tp->atom, tp->atombuf);
221 int l = fml_atom_str (tp->atom, NULL);
222 if (l >= tp->maxbuf-1)
224 if (tp->maxbuf != FML_ATOM_BUF*2)
227 tp->atombuf = malloc (tp->maxbuf*2);
228 tp->tokenbuf = tp->atombuf + tp->maxbuf;
230 fml_atom_str (tp->atom, tp->atombuf);
235 tp->sub = (*np)->p[0];
243 cp = tp->atombuf + tp->offset;
245 if (*cp == tp->escape_char)
263 if (*cp == tp->escape_char)
266 tp->offset = cp - tp->atombuf;
276 struct fml_node *fml_expr_term (Fml fml, struct fml_node **lp,
282 fn = fml_sub0 (fml, tp->sub);
283 fml_cmd_lex (lp, tp);
286 fn = fml_sub2 (fml, lp, tp);
290 void fml_lr_values (Fml fml, struct fml_node *l, int *left_val,
291 struct fml_node *r, int *right_val)
294 *left_val = fml_atom_val (l->p[0]);
298 *right_val = fml_atom_val (r->p[0]);
301 fml_node_delete (fml, l);
302 fml_node_delete (fml, r);
305 static struct fml_node *fml_exec_space (Fml fml, struct fml_node **lp,
308 fml_cmd_lex (lp, tp);
316 static struct fml_node *fml_exec_nl (Fml fml, struct fml_node **lp,
319 fml_cmd_lex (lp, tp);
320 (*fml->write_func) ('\n');
324 static struct fml_node *fml_exec_prefix (struct fml_sym_info *info, Fml fml,
325 struct fml_node **lp,
329 struct fml_sym_info *arg_info;
330 struct fml_node *return_value;
331 static char arg[128];
336 printf ("exec_prefix ");
338 fml_sym_push (fml->sym_tab);
339 fml_cmd_lex (lp, tp);
340 for (fn = info->args; fn; fn = fn->p[1])
343 assert (fn->is_atom);
344 fml_atom_strx (fn->p[0], arg, 127);
350 arg_info = fml_sym_add_local (fml->sym_tab, arg);
351 arg_info->kind = FML_VAR;
355 arg_info->body = fml_sub0 (fml, tp->sub);
356 fml_cmd_lex (lp, tp);
359 arg_info->body = fml_sub2 (fml, lp, tp);
362 fml_pr_list (arg_info->body);
366 return_value = fml_exec_group (info->body, fml);
377 static void fml_emit (Fml fml, struct fml_node *list)
386 (*fml->write_func) (' ');
388 for (a = list->p[0]; a; a=a->next)
391 while (i < FML_ATOM_BUF && a->buf[i])
392 (*fml->write_func) (a->buf[i++]);
396 fml_emit (fml, list->p[0]);
402 static struct fml_node *fml_sub2 (Fml fml, struct fml_node **lp,
406 struct fml_sym_info *info;
409 info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
414 fn = fml_node_copy (fml, info->body);
415 fml_cmd_lex (lp, tp);
418 fn = fml_exec_prefix (info, fml, lp, tp);
421 fn = (*info->prefix) (fml, lp, tp);
424 fml_cmd_lex (lp, tp);
428 else if (tp->kind == 'g')
431 fn = fml_sub0 (fml, tp->sub);
434 fml_cmd_lex (lp, tp);
436 else if (tp->kind == 't')
438 fn = fml_node_alloc (fml);
440 fn->p[0] = fml_atom_alloc (fml, tp->tokenbuf);
441 fml_cmd_lex (lp, tp);
448 static struct fml_node *fml_sub1 (Fml fml, struct fml_node **lp,
451 struct fml_node *f1, *f2, *fn;
452 struct fml_sym_info *info;
454 f1 = fml_sub2 (fml, lp, tp);
455 while (tp->kind == 'e')
457 info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
460 fprintf (stderr, "cannot locate `%s'", tp->tokenbuf);
463 if (info->kind == FML_CBINARY)
465 fml_cmd_lex (lp, tp);
466 f2 = fml_sub2 (fml, lp, tp);
467 fn = (*info->binary) (fml, f1, f2);
471 else if (info->kind == FML_BINARY)
473 struct fml_sym_info *arg_info;
479 printf ("exec binary %s", tp->tokenbuf);
481 fml_cmd_lex (lp, tp);
482 f2 = fml_sub2 (fml, lp, tp);
483 fml_sym_push (fml->sym_tab);
485 fml_atom_strx (info->args->p[0], arg, 127);
486 arg_info = fml_sym_add_local (fml->sym_tab, arg);
487 arg_info->kind = FML_VAR;
494 fml_atom_strx ( ((struct fml_node *) info->args->p[1])->p[0],
496 arg_info = fml_sym_add_local (fml->sym_tab, arg);
497 arg_info->kind = FML_VAR;
505 f1 = fml_exec_group (info->body, fml);
520 static struct fml_node *fml_sub0 (Fml fml, struct fml_node *list)
523 struct fml_node *fn, *fn1;
525 fml_init_token (&token, fml);
527 fml_cmd_lex (&list, &token);
528 fn = fml_sub1 (fml, &list, &token);
529 if (token.kind == '\0')
531 fml_del_token (&token, fml);
534 fn1 = fml_node_alloc (fml);
537 while (token.kind != '\0')
539 fn1 = fn1->p[1] = fml_node_alloc (fml);
540 fn1->p[0] = fml_sub1 (fml, &list, &token);
542 fml_del_token (&token, fml);
546 static struct fml_node *fml_sub0 (Fml fml, struct fml_node *list)
549 struct fml_node *fn, *fn0, *fn1;
553 fml_init_token (&token, fml);
554 fml_cmd_lex (&list, &token);
555 fn1 = fn = fml_sub1 (fml, &list, &token);
558 fml_del_token (&token, fml);
561 if (fn->p[1] && token.kind != '\0')
563 fn1 = fml_node_alloc (fml);
567 while (token.kind != '\0')
569 fn = fml_sub1 (fml, &list, &token);
572 fn1 = fn1->p[1] = fml_node_alloc (fml);
577 fn1 = fn1->p[1] = fn;
580 fml_del_token (&token, fml);
585 static struct fml_node *fml_exec_foreach (struct fml_sym_info *info, Fml fml,
586 struct fml_node **lp,
589 struct fml_sym_info *info_var;
590 struct fml_node *fn, *body;
591 struct fml_node *return_value = NULL, *rv;
593 fml_cmd_lex (lp, tp);
594 assert (tp->kind == 't');
596 info_var = fml_sym_lookup_local (fml->sym_tab, tp->tokenbuf);
599 info_var = fml_sym_add_local (fml->sym_tab, tp->tokenbuf);
600 info_var->body = NULL;
601 info_var->kind = FML_VAR;
605 if (info_var->kind == FML_VAR)
606 fml_node_delete (fml, info_var->body);
607 info_var->body = NULL;
612 printf ("[foreach %s ", tp->tokenbuf);
614 fml_cmd_lex (lp, tp);
615 assert (tp->kind == 'g');
616 fn = fml_sub0 (fml, tp->sub);
618 fml_cmd_lex (lp, tp);
619 assert (tp->kind == 'g');
624 struct fml_node *fn1;
631 info_var->body = fn->p[0];
635 printf ("[foreach loop var=");
636 fml_pr_list (info_var->body);
639 rv = fml_exec_group (body, fml);
642 fml_node_delete (fml, fn);
645 info_var->body = NULL;
651 static struct fml_node *fml_exec_if (struct fml_sym_info *info, Fml fml,
652 struct fml_node **lp, struct token *tp)
654 struct fml_node *fn, *body;
655 struct fml_node *rv, *return_value = NULL;
657 fml_cmd_lex (lp, tp);
658 assert (tp->kind == 'g');
659 fn = fml_sub0 (fml, tp->sub);
660 fml_cmd_lex (lp, tp);
661 assert (tp->kind == 'g');
664 rv = fml_exec_group (tp->sub, fml);
668 fml_cmd_lex (lp, tp);
671 info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
672 if (info->kind == FML_ELSE)
674 fml_cmd_lex (lp, tp);
675 assert (tp->kind == 'g');
679 rv = fml_exec_group (body, fml);
683 fml_cmd_lex (lp, tp);
686 fml_node_delete (fml, fn);
690 static struct fml_node *fml_exec_while (struct fml_sym_info *info, Fml fml,
691 struct fml_node **lp, struct token *tp)
693 struct fml_node *fn, *body;
694 struct fml_node *return_value = NULL;
696 fml_cmd_lex (lp, tp);
697 assert (tp->kind == 'g');
700 fml_cmd_lex (lp, tp);
701 assert (tp->kind == 'g');
706 struct fml_node *fn_expr;
710 fn_expr = fml_sub0 (fml, fn);
713 fml_node_delete (fml, fn_expr);
714 rv = fml_exec_group (body, fml);
721 static void fml_exec_set (struct fml_sym_info *info, Fml fml,
722 struct fml_node **lp, struct token *tp)
725 struct fml_sym_info *info_var;
727 fml_cmd_lex (lp, tp);
728 info_var = fml_sym_lookup_local (fml->sym_tab, tp->tokenbuf);
731 info_var = fml_sym_add_local (fml->sym_tab, tp->tokenbuf);
732 info_var->body = NULL;
737 printf ("set %s ", tp->tokenbuf);
739 info_var->kind = FML_VAR;
740 fml_cmd_lex (lp, tp);
744 fn = fml_sub0 (fml, tp->sub);
745 fml_cmd_lex (lp, tp);
748 fn = fml_sub2 (fml, lp, tp);
749 fml_node_delete (fml, info_var->body);
753 fml_pr_list (info_var->body);
758 static void fml_emit_expr (Fml fml, struct fml_node **lp, struct token *tp)
762 fn = fml_sub1 (fml, lp, tp);
764 fml_node_delete (fml, fn);
767 struct fml_node *fml_exec_group (struct fml_node *list, Fml fml)
770 struct fml_sym_info *info;
772 struct fml_node *return_value = NULL, *rv;
776 fml_init_token (&token, fml);
777 fml_cmd_lex (&list, &token);
783 rv = fml_exec_group (token.sub, fml);
788 info = fml_sym_lookup (fml->sym_tab, token.tokenbuf);
796 fml_cmd_lex (&list, &token);
797 assert (token.kind == 't');
798 info = fml_sym_lookup (fml->sym_tab, token.tokenbuf);
800 info = fml_sym_add (fml->sym_tab, token.tokenbuf);
801 info->kind = FML_PREFIX;
805 fml_cmd_lex (&list, &token);
806 if (token.kind != 't')
810 info->args = fn = fml_node_alloc (fml);
814 for (fn = info->args; fn->p[1]; fn=fn->p[1])
816 fn = fn->p[1] = fml_node_alloc (fml);
818 fn->p[0] = token.atom;
821 assert (token.kind == 'g');
822 info->body = token.sub;
825 fml_cmd_lex (&list, &token);
826 assert (token.kind == 't');
827 info = fml_sym_lookup (fml->sym_tab, token.tokenbuf);
829 info = fml_sym_add (fml->sym_tab, token.tokenbuf);
830 info->kind = FML_BINARY;
832 fml_cmd_lex (&list, &token);
833 assert (token.kind == 't');
834 info->args = fn = fml_node_alloc (fml);
835 fn->p[0] = token.atom;
838 fml_cmd_lex (&list, &token);
839 assert (token.kind == 't');
840 fn = fn->p[1] = fml_node_alloc (fml);
841 fn->p[0] = token.atom;
844 fml_cmd_lex (&list, &token);
845 assert (token.kind == 'g');
846 info->body = token.sub;
851 if (token.separate && !first)
852 (*fml->write_func) (' ');
854 fml_emit_expr (fml, &list, &token);
858 rv = fml_exec_foreach (info, fml, &list, &token);
863 rv = fml_exec_if (info, fml, &list, &token);
868 fml_exec_set (info, fml, &list, &token);
872 rv = fml_exec_while (info, fml, &list, &token);
877 fml_cmd_lex (&list, &token);
879 if (token.kind == 'g')
881 return_value = fml_sub0 (fml, token.sub);
882 fml_cmd_lex (&list, &token);
885 return_value = fml_sub2 (fml, &list, &token);
889 printf ("return of:");
890 fml_pr_list (return_value);
895 printf ("unknown token: `%s'", token.tokenbuf);
896 fml_cmd_lex (&list, &token);
901 printf ("<unknown>");
905 if (token.separate && !first)
906 (*fml->write_func) (' ');
908 fml_emit_expr (fml, &list, &token);
912 fml_cmd_lex (&list, &token);
914 fml_del_token (&token, fml);
918 void fml_exec (Fml fml)
921 fml_exec_group (fml->list, fml);