2 * FML interpreter. Europagate, 1995
5 * Revision 1.14 1995/02/23 08:32:04 adam
8 * Revision 1.12 1995/02/22 15:20:13 adam
9 * Bug fix in fml_exec_space.
11 * Revision 1.11 1995/02/22 08:50:49 adam
12 * Definition of CPP changed. Output function can be customized.
14 * Revision 1.10 1995/02/21 17:46:08 adam
15 * Bug fix in fml_sub0.
17 * Revision 1.9 1995/02/21 14:00:03 adam
20 * Revision 1.8 1995/02/10 18:15:52 adam
21 * FML function 'strcmp' implemented. This function can be used to
22 * test for existence of MARC fields.
24 * Revision 1.7 1995/02/10 15:50:54 adam
25 * MARC interface implemented. Minor bugs fixed. fmltest can
26 * be used to format single MARC records. New function '\list'
29 * Revision 1.6 1995/02/09 16:06:06 adam
30 * FML can be called from the outside multiple times by the functions:
31 * fml_exec_call and fml_exec_call_str.
32 * An interactive parameter (-i) to fmltest starts a shell-like
33 * interface to FML by using the fml_exec_call_str function.
35 * Revision 1.5 1995/02/09 14:33:36 adam
36 * Split source fml.c and define relevant build-in functions in separate
37 * files. New operators mult, div, not, llen implemented.
39 * Revision 1.4 1995/02/09 13:07:14 adam
40 * Nodes are freed now. Many bugs fixed.
42 * Revision 1.3 1995/02/07 16:09:23 adam
43 * The \ character is no longer INCLUDED when terminating a token.
44 * Major changes in tokenization routines. Bug fixes in expressions
45 * with lists (fml_sub0).
47 * Revision 1.2 1995/02/06 15:23:25 adam
48 * Added some more relational operators (le,ne,ge). Added increment
49 * and decrement operators. Function index changed, so that first
50 * element is 1 - not 0. Function fml_atom_val edited.
52 * Revision 1.1.1.1 1995/02/06 13:48:10 adam
53 * First version of the FML interpreter. It's slow and memory isn't
54 * freed properly. In particular, the FML nodes aren't released yet.
63 static int default_read_func (void)
68 static void default_write_func (int c)
73 static void default_err_handle (int no)
75 fprintf (stderr, "Error: %d\n", no);
78 static struct fml_node *fml_sub0 (Fml fml, struct fml_node *list);
79 static struct fml_node *fml_sub1 (Fml fml, struct fml_node **lp,
81 static struct fml_node *fml_sub2 (Fml fml, struct fml_node **lp,
83 static struct fml_node *fml_exec_space (Fml fml, struct fml_node **lp,
85 static struct fml_node *fml_exec_nl (Fml fml, struct fml_node **lp,
88 static int indent = 0;
90 static void pr_indent (int n)
113 struct fml_sym_info *sym_info;
115 Fml fml = malloc (sizeof(*fml));
120 fml->escape_char = '\\';
121 fml->comment_char = '#';
123 fml->white_chars = " \t\f\r\n";
124 fml->read_func = default_read_func;
125 fml->err_handle = default_err_handle;
126 fml->write_func = default_write_func;
129 fml->sym_tab = fml_sym_open ();
130 fml->atom_free_list = NULL;
131 fml->node_free_list = NULL;
134 sym_info = fml_sym_add (fml->sym_tab, "func");
135 sym_info->kind = FML_FUNC;
136 sym_info = fml_sym_add (fml->sym_tab, "bin");
137 sym_info->kind = FML_BIN;
138 sym_info = fml_sym_add (fml->sym_tab, "if");
139 sym_info->kind = FML_IF;
140 sym_info = fml_sym_add (fml->sym_tab, "else");
141 sym_info->kind = FML_ELSE;
142 sym_info = fml_sym_add (fml->sym_tab, "foreach");
143 sym_info->kind = FML_FOREACH;
144 sym_info = fml_sym_add (fml->sym_tab, "set");
145 sym_info->kind = FML_SET;
146 sym_info = fml_sym_add (fml->sym_tab, "while");
147 sym_info->kind = FML_WHILE;
148 sym_info = fml_sym_add (fml->sym_tab, "return");
149 sym_info->kind = FML_RETURN;
156 sym_info = fml_sym_add (fml->sym_tab, "s");
157 sym_info->kind = FML_CPREFIX;
158 sym_info->prefix = fml_exec_space;
159 sym_info = fml_sym_add (fml->sym_tab, " ");
160 sym_info->kind = FML_CPREFIX;
161 sym_info->prefix = fml_exec_space;
162 sym_info = fml_sym_add (fml->sym_tab, "n");
163 sym_info->kind = FML_CPREFIX;
164 sym_info->prefix = fml_exec_nl;
169 static Fml fml_pop_handler = NULL;
170 static void pop_handler (struct fml_sym_info *info)
172 assert (fml_pop_handler);
176 fml_node_delete (fml_pop_handler, info->body);
180 static void fml_do_pop (Fml fml)
182 fml_pop_handler = fml;
183 fml_sym_pop (fml->sym_tab, pop_handler);
186 int fml_preprocess (Fml fml)
188 fml->list = fml_tokenize (fml);
193 void fml_init_token (struct token *tp, Fml fml)
195 tp->maxbuf = FML_ATOM_BUF*2;
197 tp->atombuf = tp->sbuf;
198 tp->tokenbuf = tp->sbuf + tp->maxbuf;
199 tp->escape_char = fml->escape_char;
202 void fml_del_token (struct token *tp, Fml fml)
204 if (tp->maxbuf != FML_ATOM_BUF*2)
208 void fml_cmd_lex (struct fml_node **np, struct token *tp)
222 tp->atom = (*np)->p[0];
224 fml_atom_str (tp->atom, tp->atombuf);
227 int l = fml_atom_str (tp->atom, NULL);
228 if (l >= tp->maxbuf-1)
230 if (tp->maxbuf != FML_ATOM_BUF*2)
233 tp->atombuf = malloc (tp->maxbuf*2);
234 tp->tokenbuf = tp->atombuf + tp->maxbuf;
236 fml_atom_str (tp->atom, tp->atombuf);
241 tp->sub = (*np)->p[0];
249 cp = tp->atombuf + tp->offset;
251 if (*cp == tp->escape_char)
269 if (*cp == tp->escape_char)
272 tp->offset = cp - tp->atombuf;
282 struct fml_node *fml_expr_term (Fml fml, struct fml_node **lp,
288 fn = fml_sub0 (fml, tp->sub);
289 fml_cmd_lex (lp, tp);
292 fn = fml_sub2 (fml, lp, tp);
296 void fml_lr_values (Fml fml, struct fml_node *l, int *left_val,
297 struct fml_node *r, int *right_val)
300 *left_val = fml_atom_val (l->p[0]);
304 *right_val = fml_atom_val (r->p[0]);
307 fml_node_delete (fml, l);
308 fml_node_delete (fml, r);
311 static struct fml_node *fml_exec_space (Fml fml, struct fml_node **lp,
314 fml_cmd_lex (lp, tp);
316 (*fml->write_func) ('_');
318 (*fml->write_func) (' ');
323 static struct fml_node *fml_exec_nl (Fml fml, struct fml_node **lp,
326 fml_cmd_lex (lp, tp);
327 (*fml->write_func) ('\n');
331 static struct fml_node *fml_exec_prefix (struct fml_sym_info *info, Fml fml,
332 struct fml_node **lp,
336 struct fml_sym_info *arg_info;
337 struct fml_node *return_value;
338 static char arg[128];
343 printf ("exec_prefix ");
345 fml_sym_push (fml->sym_tab);
346 fml_cmd_lex (lp, tp);
347 for (fn = info->args; fn; fn = fn->p[1])
350 assert (fn->is_atom);
351 fml_atom_strx (fn->p[0], arg, 127);
357 arg_info = fml_sym_add_local (fml->sym_tab, arg);
358 arg_info->kind = FML_VAR;
362 arg_info->body = fml_sub0 (fml, tp->sub);
363 fml_cmd_lex (lp, tp);
366 arg_info->body = fml_sub2 (fml, lp, tp);
369 fml_pr_list (arg_info->body);
373 return_value = fml_exec_group (info->body, fml);
384 static void fml_emit (Fml fml, struct fml_node *list)
393 (*fml->write_func) (' ');
395 for (a = list->p[0]; a; a=a->next)
398 while (i < FML_ATOM_BUF && a->buf[i])
399 (*fml->write_func) (a->buf[i++]);
403 fml_emit (fml, list->p[0]);
409 static struct fml_node *fml_sub2 (Fml fml, struct fml_node **lp,
413 struct fml_sym_info *info;
416 info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
421 fn = fml_node_copy (fml, info->body);
422 fml_cmd_lex (lp, tp);
425 fn = fml_exec_prefix (info, fml, lp, tp);
428 fn = (*info->prefix) (fml, lp, tp);
431 fml_cmd_lex (lp, tp);
435 else if (tp->kind == 'g')
438 fn = fml_sub0 (fml, tp->sub);
441 fml_cmd_lex (lp, tp);
443 else if (tp->kind == 't')
445 fn = fml_node_alloc (fml);
447 fn->p[0] = fml_atom_alloc (fml, tp->tokenbuf);
448 fml_cmd_lex (lp, tp);
455 static struct fml_node *fml_sub1 (Fml fml, struct fml_node **lp,
458 struct fml_node *f1, *f2, *fn;
459 struct fml_sym_info *info;
461 f1 = fml_sub2 (fml, lp, tp);
462 while (tp->kind == 'e')
464 info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
467 fprintf (stderr, "cannot locate `%s'", tp->tokenbuf);
470 if (info->kind == FML_CBINARY)
472 fml_cmd_lex (lp, tp);
473 f2 = fml_sub2 (fml, lp, tp);
474 fn = (*info->binary) (fml, f1, f2);
478 else if (info->kind == FML_BINARY)
480 struct fml_sym_info *arg_info;
486 printf ("exec binary %s", tp->tokenbuf);
488 fml_cmd_lex (lp, tp);
489 f2 = fml_sub2 (fml, lp, tp);
490 fml_sym_push (fml->sym_tab);
492 fml_atom_strx (info->args->p[0], arg, 127);
493 arg_info = fml_sym_add_local (fml->sym_tab, arg);
494 arg_info->kind = FML_VAR;
501 fml_atom_strx ( ((struct fml_node *) info->args->p[1])->p[0],
503 arg_info = fml_sym_add_local (fml->sym_tab, arg);
504 arg_info->kind = FML_VAR;
512 f1 = fml_exec_group (info->body, fml);
527 static struct fml_node *fml_sub0 (Fml fml, struct fml_node *list)
530 struct fml_node *fn, *fn1;
532 fml_init_token (&token, fml);
534 fml_cmd_lex (&list, &token);
535 fn = fml_sub1 (fml, &list, &token);
536 if (token.kind == '\0')
538 fml_del_token (&token, fml);
541 fn1 = fml_node_alloc (fml);
544 while (token.kind != '\0')
546 fn1 = fn1->p[1] = fml_node_alloc (fml);
547 fn1->p[0] = fml_sub1 (fml, &list, &token);
549 fml_del_token (&token, fml);
553 static struct fml_node *fml_sub0 (Fml fml, struct fml_node *list)
556 struct fml_node *fn, *fn0, *fn1;
560 fml_init_token (&token, fml);
561 fml_cmd_lex (&list, &token);
562 fn1 = fn = fml_sub1 (fml, &list, &token);
565 fml_del_token (&token, fml);
568 if (fn->p[1] && token.kind != '\0')
570 fn1 = fml_node_alloc (fml);
574 while (token.kind != '\0')
576 fn = fml_sub1 (fml, &list, &token);
579 fn1 = fn1->p[1] = fml_node_alloc (fml);
584 fn1 = fn1->p[1] = fn;
587 fml_del_token (&token, fml);
592 static struct fml_node *fml_exec_foreach (struct fml_sym_info *info, Fml fml,
593 struct fml_node **lp,
596 struct fml_sym_info *info_var;
597 struct fml_node *fn, *body;
598 struct fml_node *return_value = NULL, *rv;
600 fml_cmd_lex (lp, tp);
601 assert (tp->kind == 't');
603 info_var = fml_sym_lookup_local (fml->sym_tab, tp->tokenbuf);
606 info_var = fml_sym_add_local (fml->sym_tab, tp->tokenbuf);
607 info_var->body = NULL;
608 info_var->kind = FML_VAR;
612 if (info_var->kind == FML_VAR)
613 fml_node_delete (fml, info_var->body);
614 info_var->body = NULL;
619 printf ("[foreach %s ", tp->tokenbuf);
621 fml_cmd_lex (lp, tp);
622 assert (tp->kind == 'g');
623 fn = fml_sub0 (fml, tp->sub);
625 fml_cmd_lex (lp, tp);
626 assert (tp->kind == 'g');
631 struct fml_node *fn1;
638 info_var->body = fn->p[0];
642 printf ("[foreach loop var=");
643 fml_pr_list (info_var->body);
646 rv = fml_exec_group (body, fml);
649 fml_node_delete (fml, fn);
652 info_var->body = NULL;
658 static struct fml_node *fml_exec_if (struct fml_sym_info *info, Fml fml,
659 struct fml_node **lp, struct token *tp)
661 struct fml_node *fn, *body;
662 struct fml_node *rv, *return_value = NULL;
664 fml_cmd_lex (lp, tp);
665 assert (tp->kind == 'g');
666 fn = fml_sub0 (fml, tp->sub);
667 fml_cmd_lex (lp, tp);
668 assert (tp->kind == 'g');
671 rv = fml_exec_group (tp->sub, fml);
675 fml_cmd_lex (lp, tp);
678 info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
679 if (info->kind == FML_ELSE)
681 fml_cmd_lex (lp, tp);
682 assert (tp->kind == 'g');
686 rv = fml_exec_group (body, fml);
690 fml_cmd_lex (lp, tp);
693 fml_node_delete (fml, fn);
697 static struct fml_node *fml_exec_while (struct fml_sym_info *info, Fml fml,
698 struct fml_node **lp, struct token *tp)
700 struct fml_node *fn, *body;
701 struct fml_node *return_value = NULL;
703 fml_cmd_lex (lp, tp);
704 assert (tp->kind == 'g');
707 fml_cmd_lex (lp, tp);
708 assert (tp->kind == 'g');
713 struct fml_node *fn_expr;
717 fn_expr = fml_sub0 (fml, fn);
720 fml_node_delete (fml, fn_expr);
721 rv = fml_exec_group (body, fml);
728 static void fml_exec_set (struct fml_sym_info *info, Fml fml,
729 struct fml_node **lp, struct token *tp)
732 struct fml_sym_info *info_var;
734 fml_cmd_lex (lp, tp);
735 info_var = fml_sym_lookup_local (fml->sym_tab, tp->tokenbuf);
738 info_var = fml_sym_add_local (fml->sym_tab, tp->tokenbuf);
739 info_var->body = NULL;
744 printf ("set %s ", tp->tokenbuf);
746 info_var->kind = FML_VAR;
747 fml_cmd_lex (lp, tp);
751 fn = fml_sub0 (fml, tp->sub);
752 fml_cmd_lex (lp, tp);
755 fn = fml_sub2 (fml, lp, tp);
756 fml_node_delete (fml, info_var->body);
760 fml_pr_list (info_var->body);
765 static void fml_emit_expr (Fml fml, struct fml_node **lp, struct token *tp)
769 fn = fml_sub1 (fml, lp, tp);
771 fml_node_delete (fml, fn);
774 struct fml_node *fml_exec_group (struct fml_node *list, Fml fml)
777 struct fml_sym_info *info;
779 struct fml_node *return_value = NULL, *rv;
783 fml_init_token (&token, fml);
784 fml_cmd_lex (&list, &token);
790 rv = fml_exec_group (token.sub, fml);
795 info = fml_sym_lookup (fml->sym_tab, token.tokenbuf);
803 fml_cmd_lex (&list, &token);
804 assert (token.kind == 't');
805 info = fml_sym_lookup (fml->sym_tab, token.tokenbuf);
807 info = fml_sym_add (fml->sym_tab, token.tokenbuf);
808 info->kind = FML_PREFIX;
812 fml_cmd_lex (&list, &token);
813 if (token.kind != 't')
817 info->args = fn = fml_node_alloc (fml);
821 for (fn = info->args; fn->p[1]; fn=fn->p[1])
823 fn = fn->p[1] = fml_node_alloc (fml);
825 fn->p[0] = token.atom;
828 assert (token.kind == 'g');
829 info->body = token.sub;
832 fml_cmd_lex (&list, &token);
833 assert (token.kind == 't');
834 info = fml_sym_lookup (fml->sym_tab, token.tokenbuf);
836 info = fml_sym_add (fml->sym_tab, token.tokenbuf);
837 info->kind = FML_BINARY;
839 fml_cmd_lex (&list, &token);
840 assert (token.kind == 't');
841 info->args = fn = fml_node_alloc (fml);
842 fn->p[0] = token.atom;
845 fml_cmd_lex (&list, &token);
846 assert (token.kind == 't');
847 fn = fn->p[1] = fml_node_alloc (fml);
848 fn->p[0] = token.atom;
851 fml_cmd_lex (&list, &token);
852 assert (token.kind == 'g');
853 info->body = token.sub;
858 if (token.separate && !first)
859 (*fml->write_func) (' ');
861 fml_emit_expr (fml, &list, &token);
865 rv = fml_exec_foreach (info, fml, &list, &token);
870 rv = fml_exec_if (info, fml, &list, &token);
875 fml_exec_set (info, fml, &list, &token);
879 rv = fml_exec_while (info, fml, &list, &token);
884 fml_cmd_lex (&list, &token);
886 if (token.kind == 'g')
888 return_value = fml_sub0 (fml, token.sub);
889 fml_cmd_lex (&list, &token);
892 return_value = fml_sub2 (fml, &list, &token);
896 printf ("return of:");
897 fml_pr_list (return_value);
902 printf ("unknown token: `%s'", token.tokenbuf);
903 fml_cmd_lex (&list, &token);
908 printf ("<unknown>");
912 if (token.separate && !first)
913 (*fml->write_func) (' ');
915 fml_emit_expr (fml, &list, &token);
919 fml_cmd_lex (&list, &token);
921 fml_del_token (&token, fml);
925 void fml_exec (Fml fml)
928 fml_exec_group (fml->list, fml);