2 * FML interpreter. Europagate, 1995
5 * Revision 1.15 1995/02/27 09:01:20 adam
6 * Regular expression support. Argument passing by name option. New FML
9 * Revision 1.14 1995/02/23 08:32:04 adam
12 * Revision 1.12 1995/02/22 15:20:13 adam
13 * Bug fix in fml_exec_space.
15 * Revision 1.11 1995/02/22 08:50:49 adam
16 * Definition of CPP changed. Output function can be customized.
18 * Revision 1.10 1995/02/21 17:46:08 adam
19 * Bug fix in fml_sub0.
21 * Revision 1.9 1995/02/21 14:00:03 adam
24 * Revision 1.8 1995/02/10 18:15:52 adam
25 * FML function 'strcmp' implemented. This function can be used to
26 * test for existence of MARC fields.
28 * Revision 1.7 1995/02/10 15:50:54 adam
29 * MARC interface implemented. Minor bugs fixed. fmltest can
30 * be used to format single MARC records. New function '\list'
33 * Revision 1.6 1995/02/09 16:06:06 adam
34 * FML can be called from the outside multiple times by the functions:
35 * fml_exec_call and fml_exec_call_str.
36 * An interactive parameter (-i) to fmltest starts a shell-like
37 * interface to FML by using the fml_exec_call_str function.
39 * Revision 1.5 1995/02/09 14:33:36 adam
40 * Split source fml.c and define relevant build-in functions in separate
41 * files. New operators mult, div, not, llen implemented.
43 * Revision 1.4 1995/02/09 13:07:14 adam
44 * Nodes are freed now. Many bugs fixed.
46 * Revision 1.3 1995/02/07 16:09:23 adam
47 * The \ character is no longer INCLUDED when terminating a token.
48 * Major changes in tokenization routines. Bug fixes in expressions
49 * with lists (fml_sub0).
51 * Revision 1.2 1995/02/06 15:23:25 adam
52 * Added some more relational operators (le,ne,ge). Added increment
53 * and decrement operators. Function index changed, so that first
54 * element is 1 - not 0. Function fml_atom_val edited.
56 * Revision 1.1.1.1 1995/02/06 13:48:10 adam
57 * First version of the FML interpreter. It's slow and memory isn't
58 * freed properly. In particular, the FML nodes aren't released yet.
67 static int default_read_func (void)
72 static void default_write_func (int c)
77 static void default_err_handle (int no)
79 fprintf (stderr, "Error: %d\n", no);
82 static struct fml_node *fml_sub0 (Fml fml, struct fml_node *list);
83 static struct fml_node *fml_sub1 (Fml fml, struct fml_node **lp,
85 static struct fml_node *fml_sub2 (Fml fml, struct fml_node **lp,
87 static struct fml_node *fml_exec_space (Fml fml, struct fml_node **lp,
89 static struct fml_node *fml_exec_nl (Fml fml, struct fml_node **lp,
92 static int indent = 0;
94 static void pr_indent (int n)
117 struct fml_sym_info *sym_info;
119 Fml fml = malloc (sizeof(*fml));
124 fml->escape_char = '\\';
125 fml->comment_char = '#';
127 fml->white_chars = " \t\f\r\n";
128 fml->read_func = default_read_func;
129 fml->err_handle = default_err_handle;
130 fml->write_func = default_write_func;
133 fml->sym_tab = fml_sym_open ();
134 fml->atom_free_list = NULL;
135 fml->node_free_list = NULL;
138 sym_info = fml_sym_add (fml->sym_tab, "func");
139 sym_info->kind = FML_FUNC;
140 sym_info = fml_sym_add (fml->sym_tab, "bin");
141 sym_info->kind = FML_BIN;
142 sym_info = fml_sym_add (fml->sym_tab, "if");
143 sym_info->kind = FML_IF;
144 sym_info = fml_sym_add (fml->sym_tab, "else");
145 sym_info->kind = FML_ELSE;
146 sym_info = fml_sym_add (fml->sym_tab, "foreach");
147 sym_info->kind = FML_FOREACH;
148 sym_info = fml_sym_add (fml->sym_tab, "set");
149 sym_info->kind = FML_SET;
150 sym_info = fml_sym_add (fml->sym_tab, "while");
151 sym_info->kind = FML_WHILE;
152 sym_info = fml_sym_add (fml->sym_tab, "return");
153 sym_info->kind = FML_RETURN;
160 sym_info = fml_sym_add (fml->sym_tab, "s");
161 sym_info->kind = FML_CPREFIX;
162 sym_info->prefix = fml_exec_space;
163 sym_info = fml_sym_add (fml->sym_tab, " ");
164 sym_info->kind = FML_CPREFIX;
165 sym_info->prefix = fml_exec_space;
166 sym_info = fml_sym_add (fml->sym_tab, "n");
167 sym_info->kind = FML_CPREFIX;
168 sym_info->prefix = fml_exec_nl;
173 static Fml fml_pop_handler = NULL;
174 static void pop_handler (struct fml_sym_info *info)
176 assert (fml_pop_handler);
180 fml_node_delete (fml_pop_handler, info->body);
184 static void fml_do_pop (Fml fml)
186 fml_pop_handler = fml;
187 fml_sym_pop (fml->sym_tab, pop_handler);
190 int fml_preprocess (Fml fml)
192 fml->list = fml_tokenize (fml);
197 void fml_init_token (struct token *tp, Fml fml)
199 tp->maxbuf = FML_ATOM_BUF*2;
201 tp->atombuf = tp->sbuf;
202 tp->tokenbuf = tp->sbuf + tp->maxbuf;
203 tp->escape_char = fml->escape_char;
206 void fml_del_token (struct token *tp, Fml fml)
208 if (tp->maxbuf != FML_ATOM_BUF*2)
212 void fml_cmd_lex (struct fml_node **np, struct token *tp)
214 fml_cmd_lex_s (np, tp, 1);
217 void fml_cmd_lex_s (struct fml_node **np, struct token *tp, int esc_stop)
231 tp->atom = (*np)->p[0];
233 fml_atom_str (tp->atom, tp->atombuf);
236 int l = fml_atom_str (tp->atom, NULL);
237 if (l >= tp->maxbuf-1)
239 if (tp->maxbuf != FML_ATOM_BUF*2)
242 tp->atombuf = malloc (tp->maxbuf*2);
243 tp->tokenbuf = tp->atombuf + tp->maxbuf;
245 fml_atom_str (tp->atom, tp->atombuf);
250 tp->sub = (*np)->p[0];
258 cp = tp->atombuf + tp->offset;
260 if (*cp == tp->escape_char)
278 if (*cp == tp->escape_char && esc_stop)
281 tp->offset = cp - tp->atombuf;
291 struct fml_node *fml_expr_term (Fml fml, struct fml_node **lp,
297 fn = fml_sub0 (fml, tp->sub);
298 fml_cmd_lex (lp, tp);
301 fn = fml_sub2 (fml, lp, tp);
305 void fml_lr_values (Fml fml, struct fml_node *l, int *left_val,
306 struct fml_node *r, int *right_val)
309 *left_val = fml_atom_val (l->p[0]);
313 *right_val = fml_atom_val (r->p[0]);
316 fml_node_delete (fml, l);
317 fml_node_delete (fml, r);
320 static struct fml_node *fml_exec_space (Fml fml, struct fml_node **lp,
323 fml_cmd_lex (lp, tp);
325 (*fml->write_func) ('_');
327 (*fml->write_func) (' ');
331 static struct fml_node *fml_exec_nl (Fml fml, struct fml_node **lp,
334 fml_cmd_lex (lp, tp);
335 (*fml->write_func) ('\n');
339 static struct fml_node *fml_exec_prefix (struct fml_sym_info *info, Fml fml,
340 struct fml_node **lp,
344 struct fml_sym_info *arg_info;
345 struct fml_node *return_value;
346 static char arg_name[128];
351 printf ("exec_prefix ");
353 fml_sym_push (fml->sym_tab);
354 fml_cmd_lex (lp, tp);
355 for (fn = info->args; fn; fn = fn->p[1])
357 assert (fn->is_atom);
358 fml_atom_strx (fn->p[0], arg_name, 127);
362 printf ("%s=", arg_name);
364 if (*arg_name == fml->escape_char)
366 arg_info = fml_sym_add_local (fml->sym_tab, 1+arg_name);
367 arg_info->kind = FML_CODE;
370 arg_info->body = tp->sub;
372 arg_info->body = NULL;
375 fml_pr_list (arg_info->body);
378 fml_cmd_lex (lp, tp);
382 arg_info = fml_sym_add_local (fml->sym_tab, arg_name);
383 arg_info->kind = FML_VAR;
387 arg_info->body = fml_sub0 (fml, tp->sub);
388 fml_cmd_lex (lp, tp);
391 arg_info->body = fml_sub2 (fml, lp, tp);
394 fml_pr_list (arg_info->body);
399 return_value = fml_exec_group (info->body, fml);
410 static void fml_emit (Fml fml, struct fml_node *list)
419 (*fml->write_func) (' ');
421 for (a = list->p[0]; a; a=a->next)
424 while (i < FML_ATOM_BUF && a->buf[i])
425 (*fml->write_func) (a->buf[i++]);
429 fml_emit (fml, list->p[0]);
435 static struct fml_node *fml_sub2 (Fml fml, struct fml_node **lp,
439 struct fml_sym_info *info;
442 info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
445 printf ("<<unknown %s in expression>>", tp->tokenbuf);
452 fn = fml_node_copy (fml, info->body);
453 fml_cmd_lex (lp, tp);
456 fn = fml_node_copy (fml, info->body);
457 fml_cmd_lex (lp, tp);
460 fn = fml_exec_prefix (info, fml, lp, tp);
463 fn = (*info->prefix) (fml, lp, tp);
466 fml_cmd_lex (lp, tp);
470 else if (tp->kind == 'g')
473 fn = fml_sub0 (fml, tp->sub);
476 fml_cmd_lex (lp, tp);
478 else if (tp->kind == 't')
480 fn = fml_node_alloc (fml);
482 fn->p[0] = fml_atom_alloc (fml, tp->tokenbuf);
483 fml_cmd_lex (lp, tp);
490 static struct fml_node *fml_sub1 (Fml fml, struct fml_node **lp,
493 struct fml_node *f1, *f2, *fn;
494 struct fml_sym_info *info;
496 f1 = fml_sub2 (fml, lp, tp);
497 while (tp->kind == 'e')
499 info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
502 fprintf (stderr, "cannot locate `%s'", tp->tokenbuf);
505 if (info->kind == FML_CBINARY)
507 fml_cmd_lex (lp, tp);
508 f2 = fml_sub2 (fml, lp, tp);
509 fn = (*info->binary) (fml, f1, f2);
513 else if (info->kind == FML_BINARY)
515 struct fml_sym_info *arg_info;
521 printf ("exec binary %s", tp->tokenbuf);
523 fml_cmd_lex (lp, tp);
524 f2 = fml_sub2 (fml, lp, tp);
525 fml_sym_push (fml->sym_tab);
527 fml_atom_strx (info->args->p[0], arg, 127);
528 arg_info = fml_sym_add_local (fml->sym_tab, arg);
529 arg_info->kind = FML_VAR;
536 fml_atom_strx ( ((struct fml_node *) info->args->p[1])->p[0],
538 arg_info = fml_sym_add_local (fml->sym_tab, arg);
539 arg_info->kind = FML_VAR;
547 f1 = fml_exec_group (info->body, fml);
562 static struct fml_node *fml_sub0 (Fml fml, struct fml_node *list)
565 struct fml_node *fn, *fn1;
567 fml_init_token (&token, fml);
569 fml_cmd_lex (&list, &token);
570 fn = fml_sub1 (fml, &list, &token);
571 if (token.kind == '\0')
573 fml_del_token (&token, fml);
576 fn1 = fml_node_alloc (fml);
579 while (token.kind != '\0')
581 fn1 = fn1->p[1] = fml_node_alloc (fml);
582 fn1->p[0] = fml_sub1 (fml, &list, &token);
584 fml_del_token (&token, fml);
588 static struct fml_node *fml_sub0 (Fml fml, struct fml_node *list)
591 struct fml_node *fn, *fn0, *fn1;
595 fml_init_token (&token, fml);
596 fml_cmd_lex (&list, &token);
597 fn1 = fn = fml_sub1 (fml, &list, &token);
600 fml_del_token (&token, fml);
603 if (fn->p[1] && token.kind != '\0')
605 fn1 = fml_node_alloc (fml);
609 while (token.kind != '\0')
611 fn = fml_sub1 (fml, &list, &token);
614 fn1 = fn1->p[1] = fml_node_alloc (fml);
619 fn1 = fn1->p[1] = fn;
622 fml_del_token (&token, fml);
627 static struct fml_node *fml_exec_foreach (struct fml_sym_info *info, Fml fml,
628 struct fml_node **lp,
631 struct fml_sym_info *info_var;
632 struct fml_node *fn, *body;
633 struct fml_node *return_value = NULL, *rv;
635 fml_cmd_lex (lp, tp);
636 assert (tp->kind == 't');
638 info_var = fml_sym_lookup_local (fml->sym_tab, tp->tokenbuf);
641 info_var = fml_sym_add_local (fml->sym_tab, tp->tokenbuf);
642 info_var->body = NULL;
643 info_var->kind = FML_VAR;
647 if (info_var->kind == FML_VAR)
648 fml_node_delete (fml, info_var->body);
649 info_var->body = NULL;
654 printf ("[foreach %s ", tp->tokenbuf);
656 fml_cmd_lex (lp, tp);
657 assert (tp->kind == 'g');
658 fn = fml_sub0 (fml, tp->sub);
660 fml_cmd_lex (lp, tp);
661 assert (tp->kind == 'g');
666 struct fml_node *fn1;
673 info_var->body = fn->p[0];
677 printf ("[foreach loop var=");
678 fml_pr_list (info_var->body);
681 rv = fml_exec_group (body, fml);
684 fml_node_delete (fml, fn);
687 info_var->body = NULL;
693 static struct fml_node *fml_exec_if (struct fml_sym_info *info, Fml fml,
694 struct fml_node **lp, struct token *tp)
696 struct fml_node *fn, *body;
697 struct fml_node *rv, *return_value = NULL;
699 fml_cmd_lex (lp, tp);
700 assert (tp->kind == 'g');
701 fn = fml_sub0 (fml, tp->sub);
702 fml_cmd_lex (lp, tp);
703 assert (tp->kind == 'g');
706 rv = fml_exec_group (tp->sub, fml);
710 fml_cmd_lex (lp, tp);
713 info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
714 if (info->kind == FML_ELSE)
716 fml_cmd_lex (lp, tp);
717 assert (tp->kind == 'g');
721 rv = fml_exec_group (body, fml);
725 fml_cmd_lex (lp, tp);
728 fml_node_delete (fml, fn);
732 static struct fml_node *fml_exec_while (struct fml_sym_info *info, Fml fml,
733 struct fml_node **lp, struct token *tp)
735 struct fml_node *fn, *body;
736 struct fml_node *return_value = NULL;
738 fml_cmd_lex (lp, tp);
739 assert (tp->kind == 'g');
742 fml_cmd_lex (lp, tp);
743 assert (tp->kind == 'g');
748 struct fml_node *fn_expr;
752 fn_expr = fml_sub0 (fml, fn);
755 fml_node_delete (fml, fn_expr);
756 rv = fml_exec_group (body, fml);
763 static void fml_exec_set (struct fml_sym_info *info, Fml fml,
764 struct fml_node **lp, struct token *tp)
767 struct fml_sym_info *info_var;
769 fml_cmd_lex (lp, tp);
770 info_var = fml_sym_lookup_local (fml->sym_tab, tp->tokenbuf);
773 info_var = fml_sym_add_local (fml->sym_tab, tp->tokenbuf);
774 info_var->body = NULL;
779 printf ("set %s ", tp->tokenbuf);
781 info_var->kind = FML_VAR;
782 fml_cmd_lex (lp, tp);
786 fn = fml_sub0 (fml, tp->sub);
787 fml_cmd_lex (lp, tp);
790 fn = fml_sub2 (fml, lp, tp);
791 fml_node_delete (fml, info_var->body);
795 fml_pr_list (info_var->body);
800 static void fml_emit_expr (Fml fml, struct fml_node **lp, struct token *tp)
804 fn = fml_sub1 (fml, lp, tp);
806 fml_node_delete (fml, fn);
809 struct fml_node *fml_exec_group (struct fml_node *list, Fml fml)
812 struct fml_sym_info *info;
814 struct fml_node *return_value = NULL, *rv;
818 fml_init_token (&token, fml);
819 fml_cmd_lex (&list, &token);
825 rv = fml_exec_group (token.sub, fml);
830 info = fml_sym_lookup (fml->sym_tab, token.tokenbuf);
838 fml_cmd_lex (&list, &token);
839 assert (token.kind == 't');
840 info = fml_sym_lookup (fml->sym_tab, token.tokenbuf);
842 info = fml_sym_add (fml->sym_tab, token.tokenbuf);
843 info->kind = FML_PREFIX;
847 fml_cmd_lex (&list, &token);
848 if (token.kind != 't' && token.kind != 'e')
852 info->args = fn = fml_node_alloc (fml);
856 for (fn = info->args; fn->p[1]; fn=fn->p[1])
858 fn = fn->p[1] = fml_node_alloc (fml);
860 fn->p[0] = token.atom;
863 assert (token.kind == 'g');
864 info->body = token.sub;
867 fml_cmd_lex (&list, &token);
868 assert (token.kind == 't');
869 info = fml_sym_lookup (fml->sym_tab, token.tokenbuf);
871 info = fml_sym_add (fml->sym_tab, token.tokenbuf);
872 info->kind = FML_BINARY;
874 fml_cmd_lex (&list, &token);
875 assert (token.kind == 't');
876 info->args = fn = fml_node_alloc (fml);
877 fn->p[0] = token.atom;
880 fml_cmd_lex (&list, &token);
881 assert (token.kind == 't');
882 fn = fn->p[1] = fml_node_alloc (fml);
883 fn->p[0] = token.atom;
886 fml_cmd_lex (&list, &token);
887 assert (token.kind == 'g');
888 info->body = token.sub;
893 if (token.separate && !first)
894 (*fml->write_func) (' ');
896 fml_emit_expr (fml, &list, &token);
900 rv = fml_exec_foreach (info, fml, &list, &token);
905 rv = fml_exec_if (info, fml, &list, &token);
910 fml_exec_set (info, fml, &list, &token);
914 rv = fml_exec_while (info, fml, &list, &token);
919 fml_cmd_lex (&list, &token);
921 if (token.kind == 'g')
923 return_value = fml_sub0 (fml, token.sub);
924 fml_cmd_lex (&list, &token);
927 return_value = fml_sub2 (fml, &list, &token);
931 printf ("return of:");
932 fml_pr_list (return_value);
937 fml_exec_group (info->body, fml);
940 printf ("<unknown token: `%s'>", token.tokenbuf);
941 fml_cmd_lex (&list, &token);
946 printf ("<unknown %s>", token.tokenbuf);
950 if (token.separate && !first)
951 (*fml->write_func) (' ');
953 fml_emit_expr (fml, &list, &token);
957 fml_cmd_lex (&list, &token);
959 fml_del_token (&token, fml);
963 void fml_exec (Fml fml)
966 fml_exec_group (fml->list, fml);