2 * FML interpreter. Europagate, 1995
5 * Revision 1.8 1995/02/10 18:15:52 adam
6 * FML function 'strcmp' implemented. This function can be used to
7 * test for existence of MARC fields.
9 * Revision 1.7 1995/02/10 15:50:54 adam
10 * MARC interface implemented. Minor bugs fixed. fmltest can
11 * be used to format single MARC records. New function '\list'
14 * Revision 1.6 1995/02/09 16:06:06 adam
15 * FML can be called from the outside multiple times by the functions:
16 * fml_exec_call and fml_exec_call_str.
17 * An interactive parameter (-i) to fmltest starts a shell-like
18 * interface to FML by using the fml_exec_call_str function.
20 * Revision 1.5 1995/02/09 14:33:36 adam
21 * Split source fml.c and define relevant build-in functions in separate
22 * files. New operators mult, div, not, llen implemented.
24 * Revision 1.4 1995/02/09 13:07:14 adam
25 * Nodes are freed now. Many bugs fixed.
27 * Revision 1.3 1995/02/07 16:09:23 adam
28 * The \ character is no longer INCLUDED when terminating a token.
29 * Major changes in tokenization routines. Bug fixes in expressions
30 * with lists (fml_sub0).
32 * Revision 1.2 1995/02/06 15:23:25 adam
33 * Added some more relational operators (le,ne,ge). Added increment
34 * and decrement operators. Function index changed, so that first
35 * element is 1 - not 0. Function fml_atom_val edited.
37 * Revision 1.1.1.1 1995/02/06 13:48:10 adam
38 * First version of the FML interpreter. It's slow and memory isn't
39 * freed properly. In particular, the FML nodes aren't released yet.
48 static int default_read_func (void)
53 static void default_err_handle (int no)
55 fprintf (stderr, "Error: %d\n", no);
58 static struct fml_node *fml_sub0 (Fml fml, struct fml_node *list);
59 static struct fml_node *fml_sub1 (Fml fml, struct fml_node **lp,
61 static struct fml_node *fml_sub2 (Fml fml, struct fml_node **lp,
63 static struct fml_node *fml_exec_space (Fml fml, struct fml_node **lp,
65 static struct fml_node *fml_exec_nl (Fml fml, struct fml_node **lp,
68 static int indent = 0;
70 static void pr_indent (int n)
93 struct fml_sym_info *sym_info;
95 Fml fml = malloc (sizeof(*fml));
100 fml->escape_char = '\\';
101 fml->comment_char = '#';
103 fml->white_chars = " \t\f\r\n";
104 fml->read_func = default_read_func;
105 fml->err_handle = default_err_handle;
108 fml->sym_tab = fml_sym_open ();
109 fml->atom_free_list = NULL;
110 fml->node_free_list = NULL;
113 sym_info = fml_sym_add (fml->sym_tab, "func");
114 sym_info->kind = FML_FUNC;
115 sym_info = fml_sym_add (fml->sym_tab, "bin");
116 sym_info->kind = FML_BIN;
117 sym_info = fml_sym_add (fml->sym_tab, "if");
118 sym_info->kind = FML_IF;
119 sym_info = fml_sym_add (fml->sym_tab, "else");
120 sym_info->kind = FML_ELSE;
121 sym_info = fml_sym_add (fml->sym_tab, "foreach");
122 sym_info->kind = FML_FOREACH;
123 sym_info = fml_sym_add (fml->sym_tab, "set");
124 sym_info->kind = FML_SET;
125 sym_info = fml_sym_add (fml->sym_tab, "while");
126 sym_info->kind = FML_WHILE;
127 sym_info = fml_sym_add (fml->sym_tab, "return");
128 sym_info->kind = FML_RETURN;
135 sym_info = fml_sym_add (fml->sym_tab, "s");
136 sym_info->kind = FML_CPREFIX;
137 sym_info->prefix = fml_exec_space;
138 sym_info = fml_sym_add (fml->sym_tab, " ");
139 sym_info->kind = FML_CPREFIX;
140 sym_info->prefix = fml_exec_space;
141 sym_info = fml_sym_add (fml->sym_tab, "n");
142 sym_info->kind = FML_CPREFIX;
143 sym_info->prefix = fml_exec_nl;
148 static Fml fml_pop_handler = NULL;
149 static void pop_handler (struct fml_sym_info *info)
151 assert (fml_pop_handler);
155 fml_node_delete (fml_pop_handler, info->body);
159 static void fml_do_pop (Fml fml)
161 fml_pop_handler = fml;
162 fml_sym_pop (fml->sym_tab, pop_handler);
165 int fml_preprocess (Fml fml)
167 fml->list = fml_tokenize (fml);
172 void fml_init_token (struct token *tp, Fml fml)
174 tp->maxbuf = FML_ATOM_BUF*2;
176 tp->atombuf = tp->sbuf;
177 tp->tokenbuf = tp->sbuf + tp->maxbuf;
178 tp->escape_char = fml->escape_char;
181 void fml_del_token (struct token *tp, Fml fml)
183 if (tp->maxbuf != FML_ATOM_BUF*2)
187 void fml_cmd_lex (struct fml_node **np, struct token *tp)
201 tp->atom = (*np)->p[0];
203 fml_atom_str (tp->atom, tp->atombuf);
206 int l = fml_atom_str (tp->atom, NULL);
207 if (l >= tp->maxbuf-1)
209 if (tp->maxbuf != FML_ATOM_BUF*2)
212 tp->atombuf = malloc (tp->maxbuf*2);
213 tp->tokenbuf = tp->atombuf + tp->maxbuf;
215 fml_atom_str (tp->atom, tp->atombuf);
220 tp->sub = (*np)->p[0];
228 cp = tp->atombuf + tp->offset;
230 if (*cp == tp->escape_char)
248 if (*cp == tp->escape_char)
251 tp->offset = cp - tp->atombuf;
261 struct fml_node *fml_expr_term (Fml fml, struct fml_node **lp,
267 fn = fml_sub0 (fml, tp->sub);
268 fml_cmd_lex (lp, tp);
271 fn = fml_sub2 (fml, lp, tp);
275 void fml_lr_values (Fml fml, struct fml_node *l, int *left_val,
276 struct fml_node *r, int *right_val)
279 *left_val = fml_atom_val (l->p[0]);
283 *right_val = fml_atom_val (r->p[0]);
286 fml_node_delete (fml, l);
287 fml_node_delete (fml, r);
290 static struct fml_node *fml_exec_space (Fml fml, struct fml_node **lp,
293 fml_cmd_lex (lp, tp);
301 static struct fml_node *fml_exec_nl (Fml fml, struct fml_node **lp,
304 fml_cmd_lex (lp, tp);
309 static struct fml_node *fml_exec_prefix (struct fml_sym_info *info, Fml fml,
310 struct fml_node **lp,
314 struct fml_sym_info *arg_info;
315 struct fml_node *return_value;
316 static char arg[128];
321 printf ("exec_prefix ");
323 fml_sym_push (fml->sym_tab);
324 fml_cmd_lex (lp, tp);
325 for (fn = info->args; fn; fn = fn->p[1])
328 assert (fn->is_atom);
329 fml_atom_strx (fn->p[0], arg, 127);
335 arg_info = fml_sym_add_local (fml->sym_tab, arg);
336 arg_info->kind = FML_VAR;
340 arg_info->body = fml_sub0 (fml, tp->sub);
341 fml_cmd_lex (lp, tp);
344 arg_info->body = fml_sub2 (fml, lp, tp);
347 fml_pr_list (arg_info->body);
351 return_value = fml_exec_group (info->body, fml);
362 static void fml_emit (struct fml_node *list)
373 for (a = list->p[0]; a; a=a->next)
374 printf ("%.*s", FML_ATOM_BUF, a->buf);
377 fml_emit (list->p[0]);
383 static struct fml_node *fml_sub2 (Fml fml, struct fml_node **lp,
387 struct fml_sym_info *info;
390 info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
395 fn = fml_node_copy (fml, info->body);
396 fml_cmd_lex (lp, tp);
399 fn = fml_exec_prefix (info, fml, lp, tp);
402 fn = (*info->prefix) (fml, lp, tp);
405 fml_cmd_lex (lp, tp);
409 else if (tp->kind == 'g')
412 fn = fml_sub0 (fml, tp->sub);
415 fml_cmd_lex (lp, tp);
417 else if (tp->kind == 't')
419 fn = fml_node_alloc (fml);
421 fn->p[0] = fml_atom_alloc (fml, tp->tokenbuf);
422 fml_cmd_lex (lp, tp);
429 static struct fml_node *fml_sub1 (Fml fml, struct fml_node **lp,
432 struct fml_node *f1, *f2, *fn;
433 struct fml_sym_info *info;
435 f1 = fml_sub2 (fml, lp, tp);
436 while (tp->kind == 'e')
438 info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
441 fprintf (stderr, "cannot locate `%s'", tp->tokenbuf);
444 if (info->kind == FML_CBINARY)
446 fml_cmd_lex (lp, tp);
447 f2 = fml_sub2 (fml, lp, tp);
448 fn = (*info->binary) (fml, f1, f2);
452 else if (info->kind == FML_BINARY)
454 struct fml_sym_info *arg_info;
460 printf ("exec binary %s", tp->tokenbuf);
462 fml_cmd_lex (lp, tp);
463 f2 = fml_sub2 (fml, lp, tp);
464 fml_sym_push (fml->sym_tab);
466 fml_atom_strx (info->args->p[0], arg, 127);
467 arg_info = fml_sym_add_local (fml->sym_tab, arg);
468 arg_info->kind = FML_VAR;
475 fml_atom_strx ( ((struct fml_node *) info->args->p[1])->p[0],
477 arg_info = fml_sym_add_local (fml->sym_tab, arg);
478 arg_info->kind = FML_VAR;
486 f1 = fml_exec_group (info->body, fml);
501 static struct fml_node *fml_sub0 (Fml fml, struct fml_node *list)
504 struct fml_node *fn, *fn1;
506 fml_init_token (&token, fml);
508 fml_cmd_lex (&list, &token);
509 fn = fml_sub1 (fml, &list, &token);
510 if (token.kind == '\0')
512 fml_del_token (&token, fml);
515 fn1 = fml_node_alloc (fml);
518 while (token.kind != '\0')
520 fn1 = fn1->p[1] = fml_node_alloc (fml);
521 fn1->p[0] = fml_sub1 (fml, &list, &token);
523 fml_del_token (&token, fml);
527 static struct fml_node *fml_sub0 (Fml fml, struct fml_node *list)
530 struct fml_node *fn, *fn0, *fn1;
534 fml_init_token (&token, fml);
536 fml_cmd_lex (&list, &token);
537 fn1 = fn = fml_sub1 (fml, &list, &token);
538 if (fn->p[1] && token.kind != '\0')
540 fn1 = fml_node_alloc (fml);
544 while (token.kind != '\0')
546 fn = fml_sub1 (fml, &list, &token);
549 fn1 = fn1->p[1] = fml_node_alloc (fml);
554 fn1 = fn1->p[1] = fn;
557 fml_del_token (&token, fml);
562 static struct fml_node *fml_exec_foreach (struct fml_sym_info *info, Fml fml,
563 struct fml_node **lp,
566 struct fml_sym_info *info_var;
567 struct fml_node *fn, *body;
568 struct fml_node *return_value = NULL, *rv;
570 fml_cmd_lex (lp, tp);
571 assert (tp->kind == 't');
573 info_var = fml_sym_lookup_local (fml->sym_tab, tp->tokenbuf);
576 info_var = fml_sym_add_local (fml->sym_tab, tp->tokenbuf);
577 info_var->body = NULL;
578 info_var->kind = FML_VAR;
582 if (info_var->kind == FML_VAR)
583 fml_node_delete (fml, info_var->body);
584 info_var->body = NULL;
589 printf ("[foreach %s ", tp->tokenbuf);
591 fml_cmd_lex (lp, tp);
592 assert (tp->kind == 'g');
593 fn = fml_sub0 (fml, tp->sub);
595 fml_cmd_lex (lp, tp);
596 assert (tp->kind == 'g');
601 struct fml_node *fn1;
608 info_var->body = fn->p[0];
612 printf ("[foreach loop var=");
613 fml_pr_list (info_var->body);
616 rv = fml_exec_group (body, fml);
619 fml_node_delete (fml, fn);
622 info_var->body = NULL;
628 static struct fml_node *fml_exec_if (struct fml_sym_info *info, Fml fml,
629 struct fml_node **lp, struct token *tp)
631 struct fml_node *fn, *body;
632 struct fml_node *rv, *return_value = NULL;
634 fml_cmd_lex (lp, tp);
635 assert (tp->kind == 'g');
636 fn = fml_sub0 (fml, tp->sub);
637 fml_cmd_lex (lp, tp);
638 assert (tp->kind == 'g');
641 rv = fml_exec_group (tp->sub, fml);
645 fml_cmd_lex (lp, tp);
648 info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
649 if (info->kind == FML_ELSE)
651 fml_cmd_lex (lp, tp);
652 assert (tp->kind == 'g');
656 rv = fml_exec_group (body, fml);
660 fml_cmd_lex (lp, tp);
663 fml_node_delete (fml, fn);
667 static struct fml_node *fml_exec_while (struct fml_sym_info *info, Fml fml,
668 struct fml_node **lp, struct token *tp)
670 struct fml_node *fn, *body;
671 struct fml_node *return_value = NULL;
673 fml_cmd_lex (lp, tp);
674 assert (tp->kind == 'g');
677 fml_cmd_lex (lp, tp);
678 assert (tp->kind == 'g');
683 struct fml_node *fn_expr;
687 fn_expr = fml_sub0 (fml, fn);
690 fml_node_delete (fml, fn_expr);
691 rv = fml_exec_group (body, fml);
698 static void fml_exec_set (struct fml_sym_info *info, Fml fml,
699 struct fml_node **lp, struct token *tp)
702 struct fml_sym_info *info_var;
704 fml_cmd_lex (lp, tp);
705 info_var = fml_sym_lookup_local (fml->sym_tab, tp->tokenbuf);
708 info_var = fml_sym_add_local (fml->sym_tab, tp->tokenbuf);
709 info_var->body = NULL;
714 printf ("set %s ", tp->tokenbuf);
716 info_var->kind = FML_VAR;
717 fml_cmd_lex (lp, tp);
721 fn = fml_sub0 (fml, tp->sub);
722 fml_cmd_lex (lp, tp);
725 fn = fml_sub2 (fml, lp, tp);
726 fml_node_delete (fml, info_var->body);
730 fml_pr_list (info_var->body);
735 static void fml_emit_expr (Fml fml, struct fml_node **lp, struct token *tp)
739 fn = fml_sub1 (fml, lp, tp);
741 fml_node_delete (fml, fn);
744 struct fml_node *fml_exec_group (struct fml_node *list, Fml fml)
747 struct fml_sym_info *info;
749 struct fml_node *return_value = NULL, *rv;
753 fml_init_token (&token, fml);
754 fml_cmd_lex (&list, &token);
760 rv = fml_exec_group (token.sub, fml);
765 info = fml_sym_lookup (fml->sym_tab, token.tokenbuf);
773 fml_cmd_lex (&list, &token);
774 assert (token.kind == 't');
775 info = fml_sym_lookup (fml->sym_tab, token.tokenbuf);
777 info = fml_sym_add (fml->sym_tab, token.tokenbuf);
778 info->kind = FML_PREFIX;
782 fml_cmd_lex (&list, &token);
783 if (token.kind != 't')
787 info->args = fn = fml_node_alloc (fml);
791 for (fn = info->args; fn->p[1]; fn=fn->p[1])
793 fn = fn->p[1] = fml_node_alloc (fml);
795 fn->p[0] = token.atom;
798 assert (token.kind == 'g');
799 info->body = token.sub;
802 fml_cmd_lex (&list, &token);
803 assert (token.kind == 't');
804 info = fml_sym_lookup (fml->sym_tab, token.tokenbuf);
806 info = fml_sym_add (fml->sym_tab, token.tokenbuf);
807 info->kind = FML_BINARY;
809 fml_cmd_lex (&list, &token);
810 assert (token.kind == 't');
811 info->args = fn = fml_node_alloc (fml);
812 fn->p[0] = token.atom;
815 fml_cmd_lex (&list, &token);
816 assert (token.kind == 't');
817 fn = fn->p[1] = fml_node_alloc (fml);
818 fn->p[0] = token.atom;
821 fml_cmd_lex (&list, &token);
822 assert (token.kind == 'g');
823 info->body = token.sub;
828 if (token.separate && !first)
831 fml_emit_expr (fml, &list, &token);
835 rv = fml_exec_foreach (info, fml, &list, &token);
840 rv = fml_exec_if (info, fml, &list, &token);
845 fml_exec_set (info, fml, &list, &token);
849 rv = fml_exec_while (info, fml, &list, &token);
854 fml_cmd_lex (&list, &token);
856 if (token.kind == 'g')
858 return_value = fml_sub0 (fml, token.sub);
859 fml_cmd_lex (&list, &token);
862 return_value = fml_sub2 (fml, &list, &token);
866 printf ("return of:");
867 fml_pr_list (return_value);
872 printf ("unknown token: `%s'", token.tokenbuf);
873 fml_cmd_lex (&list, &token);
878 printf ("<unknown>");
882 if (token.separate && !first)
885 fml_emit_expr (fml, &list, &token);
889 fml_cmd_lex (&list, &token);
891 fml_del_token (&token, fml);
895 void fml_exec (Fml fml)
898 fml_exec_group (fml->list, fml);