2 * FML interpreter. Europagate, 1995
5 * Revision 1.12 1995/02/22 15:20:13 adam
6 * Bug fix in fml_exec_space.
8 * Revision 1.11 1995/02/22 08:50:49 adam
9 * Definition of CPP changed. Output function can be customized.
11 * Revision 1.10 1995/02/21 17:46:08 adam
12 * Bug fix in fml_sub0.
14 * Revision 1.9 1995/02/21 14:00:03 adam
17 * Revision 1.8 1995/02/10 18:15:52 adam
18 * FML function 'strcmp' implemented. This function can be used to
19 * test for existence of MARC fields.
21 * Revision 1.7 1995/02/10 15:50:54 adam
22 * MARC interface implemented. Minor bugs fixed. fmltest can
23 * be used to format single MARC records. New function '\list'
26 * Revision 1.6 1995/02/09 16:06:06 adam
27 * FML can be called from the outside multiple times by the functions:
28 * fml_exec_call and fml_exec_call_str.
29 * An interactive parameter (-i) to fmltest starts a shell-like
30 * interface to FML by using the fml_exec_call_str function.
32 * Revision 1.5 1995/02/09 14:33:36 adam
33 * Split source fml.c and define relevant build-in functions in separate
34 * files. New operators mult, div, not, llen implemented.
36 * Revision 1.4 1995/02/09 13:07:14 adam
37 * Nodes are freed now. Many bugs fixed.
39 * Revision 1.3 1995/02/07 16:09:23 adam
40 * The \ character is no longer INCLUDED when terminating a token.
41 * Major changes in tokenization routines. Bug fixes in expressions
42 * with lists (fml_sub0).
44 * Revision 1.2 1995/02/06 15:23:25 adam
45 * Added some more relational operators (le,ne,ge). Added increment
46 * and decrement operators. Function index changed, so that first
47 * element is 1 - not 0. Function fml_atom_val edited.
49 * Revision 1.1.1.1 1995/02/06 13:48:10 adam
50 * First version of the FML interpreter. It's slow and memory isn't
51 * freed properly. In particular, the FML nodes aren't released yet.
60 static int default_read_func (void)
65 static void default_write_func (int c)
70 static void default_err_handle (int no)
72 fprintf (stderr, "Error: %d\n", no);
75 static struct fml_node *fml_sub0 (Fml fml, struct fml_node *list);
76 static struct fml_node *fml_sub1 (Fml fml, struct fml_node **lp,
78 static struct fml_node *fml_sub2 (Fml fml, struct fml_node **lp,
80 static struct fml_node *fml_exec_space (Fml fml, struct fml_node **lp,
82 static struct fml_node *fml_exec_nl (Fml fml, struct fml_node **lp,
85 static int indent = 0;
87 static void pr_indent (int n)
110 struct fml_sym_info *sym_info;
112 Fml fml = malloc (sizeof(*fml));
117 fml->escape_char = '\\';
118 fml->comment_char = '#';
120 fml->white_chars = " \t\f\r\n";
121 fml->read_func = default_read_func;
122 fml->err_handle = default_err_handle;
123 fml->write_func = default_write_func;
126 fml->sym_tab = fml_sym_open ();
127 fml->atom_free_list = NULL;
128 fml->node_free_list = NULL;
131 sym_info = fml_sym_add (fml->sym_tab, "func");
132 sym_info->kind = FML_FUNC;
133 sym_info = fml_sym_add (fml->sym_tab, "bin");
134 sym_info->kind = FML_BIN;
135 sym_info = fml_sym_add (fml->sym_tab, "if");
136 sym_info->kind = FML_IF;
137 sym_info = fml_sym_add (fml->sym_tab, "else");
138 sym_info->kind = FML_ELSE;
139 sym_info = fml_sym_add (fml->sym_tab, "foreach");
140 sym_info->kind = FML_FOREACH;
141 sym_info = fml_sym_add (fml->sym_tab, "set");
142 sym_info->kind = FML_SET;
143 sym_info = fml_sym_add (fml->sym_tab, "while");
144 sym_info->kind = FML_WHILE;
145 sym_info = fml_sym_add (fml->sym_tab, "return");
146 sym_info->kind = FML_RETURN;
153 sym_info = fml_sym_add (fml->sym_tab, "s");
154 sym_info->kind = FML_CPREFIX;
155 sym_info->prefix = fml_exec_space;
156 sym_info = fml_sym_add (fml->sym_tab, " ");
157 sym_info->kind = FML_CPREFIX;
158 sym_info->prefix = fml_exec_space;
159 sym_info = fml_sym_add (fml->sym_tab, "n");
160 sym_info->kind = FML_CPREFIX;
161 sym_info->prefix = fml_exec_nl;
166 static Fml fml_pop_handler = NULL;
167 static void pop_handler (struct fml_sym_info *info)
169 assert (fml_pop_handler);
173 fml_node_delete (fml_pop_handler, info->body);
177 static void fml_do_pop (Fml fml)
179 fml_pop_handler = fml;
180 fml_sym_pop (fml->sym_tab, pop_handler);
183 int fml_preprocess (Fml fml)
185 fml->list = fml_tokenize (fml);
190 void fml_init_token (struct token *tp, Fml fml)
192 tp->maxbuf = FML_ATOM_BUF*2;
194 tp->atombuf = tp->sbuf;
195 tp->tokenbuf = tp->sbuf + tp->maxbuf;
196 tp->escape_char = fml->escape_char;
199 void fml_del_token (struct token *tp, Fml fml)
201 if (tp->maxbuf != FML_ATOM_BUF*2)
205 void fml_cmd_lex (struct fml_node **np, struct token *tp)
219 tp->atom = (*np)->p[0];
221 fml_atom_str (tp->atom, tp->atombuf);
224 int l = fml_atom_str (tp->atom, NULL);
225 if (l >= tp->maxbuf-1)
227 if (tp->maxbuf != FML_ATOM_BUF*2)
230 tp->atombuf = malloc (tp->maxbuf*2);
231 tp->tokenbuf = tp->atombuf + tp->maxbuf;
233 fml_atom_str (tp->atom, tp->atombuf);
238 tp->sub = (*np)->p[0];
246 cp = tp->atombuf + tp->offset;
248 if (*cp == tp->escape_char)
266 if (*cp == tp->escape_char)
269 tp->offset = cp - tp->atombuf;
279 struct fml_node *fml_expr_term (Fml fml, struct fml_node **lp,
285 fn = fml_sub0 (fml, tp->sub);
286 fml_cmd_lex (lp, tp);
289 fn = fml_sub2 (fml, lp, tp);
293 void fml_lr_values (Fml fml, struct fml_node *l, int *left_val,
294 struct fml_node *r, int *right_val)
297 *left_val = fml_atom_val (l->p[0]);
301 *right_val = fml_atom_val (r->p[0]);
304 fml_node_delete (fml, l);
305 fml_node_delete (fml, r);
308 static struct fml_node *fml_exec_space (Fml fml, struct fml_node **lp,
311 fml_cmd_lex (lp, tp);
313 (*fml->write_func) ('_');
315 (*fml->write_func) (' ');
320 static struct fml_node *fml_exec_nl (Fml fml, struct fml_node **lp,
323 fml_cmd_lex (lp, tp);
324 (*fml->write_func) ('\n');
328 static struct fml_node *fml_exec_prefix (struct fml_sym_info *info, Fml fml,
329 struct fml_node **lp,
333 struct fml_sym_info *arg_info;
334 struct fml_node *return_value;
335 static char arg[128];
340 printf ("exec_prefix ");
342 fml_sym_push (fml->sym_tab);
343 fml_cmd_lex (lp, tp);
344 for (fn = info->args; fn; fn = fn->p[1])
347 assert (fn->is_atom);
348 fml_atom_strx (fn->p[0], arg, 127);
354 arg_info = fml_sym_add_local (fml->sym_tab, arg);
355 arg_info->kind = FML_VAR;
359 arg_info->body = fml_sub0 (fml, tp->sub);
360 fml_cmd_lex (lp, tp);
363 arg_info->body = fml_sub2 (fml, lp, tp);
366 fml_pr_list (arg_info->body);
370 return_value = fml_exec_group (info->body, fml);
381 static void fml_emit (Fml fml, struct fml_node *list)
390 (*fml->write_func) (' ');
392 for (a = list->p[0]; a; a=a->next)
395 while (i < FML_ATOM_BUF && a->buf[i])
396 (*fml->write_func) (a->buf[i++]);
400 fml_emit (fml, list->p[0]);
406 static struct fml_node *fml_sub2 (Fml fml, struct fml_node **lp,
410 struct fml_sym_info *info;
413 info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
418 fn = fml_node_copy (fml, info->body);
419 fml_cmd_lex (lp, tp);
422 fn = fml_exec_prefix (info, fml, lp, tp);
425 fn = (*info->prefix) (fml, lp, tp);
428 fml_cmd_lex (lp, tp);
432 else if (tp->kind == 'g')
435 fn = fml_sub0 (fml, tp->sub);
438 fml_cmd_lex (lp, tp);
440 else if (tp->kind == 't')
442 fn = fml_node_alloc (fml);
444 fn->p[0] = fml_atom_alloc (fml, tp->tokenbuf);
445 fml_cmd_lex (lp, tp);
452 static struct fml_node *fml_sub1 (Fml fml, struct fml_node **lp,
455 struct fml_node *f1, *f2, *fn;
456 struct fml_sym_info *info;
458 f1 = fml_sub2 (fml, lp, tp);
459 while (tp->kind == 'e')
461 info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
464 fprintf (stderr, "cannot locate `%s'", tp->tokenbuf);
467 if (info->kind == FML_CBINARY)
469 fml_cmd_lex (lp, tp);
470 f2 = fml_sub2 (fml, lp, tp);
471 fn = (*info->binary) (fml, f1, f2);
475 else if (info->kind == FML_BINARY)
477 struct fml_sym_info *arg_info;
483 printf ("exec binary %s", tp->tokenbuf);
485 fml_cmd_lex (lp, tp);
486 f2 = fml_sub2 (fml, lp, tp);
487 fml_sym_push (fml->sym_tab);
489 fml_atom_strx (info->args->p[0], arg, 127);
490 arg_info = fml_sym_add_local (fml->sym_tab, arg);
491 arg_info->kind = FML_VAR;
498 fml_atom_strx ( ((struct fml_node *) info->args->p[1])->p[0],
500 arg_info = fml_sym_add_local (fml->sym_tab, arg);
501 arg_info->kind = FML_VAR;
509 f1 = fml_exec_group (info->body, fml);
524 static struct fml_node *fml_sub0 (Fml fml, struct fml_node *list)
527 struct fml_node *fn, *fn1;
529 fml_init_token (&token, fml);
531 fml_cmd_lex (&list, &token);
532 fn = fml_sub1 (fml, &list, &token);
533 if (token.kind == '\0')
535 fml_del_token (&token, fml);
538 fn1 = fml_node_alloc (fml);
541 while (token.kind != '\0')
543 fn1 = fn1->p[1] = fml_node_alloc (fml);
544 fn1->p[0] = fml_sub1 (fml, &list, &token);
546 fml_del_token (&token, fml);
550 static struct fml_node *fml_sub0 (Fml fml, struct fml_node *list)
553 struct fml_node *fn, *fn0, *fn1;
557 fml_init_token (&token, fml);
558 fml_cmd_lex (&list, &token);
559 fn1 = fn = fml_sub1 (fml, &list, &token);
562 fml_del_token (&token, fml);
565 if (fn->p[1] && token.kind != '\0')
567 fn1 = fml_node_alloc (fml);
571 while (token.kind != '\0')
573 fn = fml_sub1 (fml, &list, &token);
576 fn1 = fn1->p[1] = fml_node_alloc (fml);
581 fn1 = fn1->p[1] = fn;
584 fml_del_token (&token, fml);
589 static struct fml_node *fml_exec_foreach (struct fml_sym_info *info, Fml fml,
590 struct fml_node **lp,
593 struct fml_sym_info *info_var;
594 struct fml_node *fn, *body;
595 struct fml_node *return_value = NULL, *rv;
597 fml_cmd_lex (lp, tp);
598 assert (tp->kind == 't');
600 info_var = fml_sym_lookup_local (fml->sym_tab, tp->tokenbuf);
603 info_var = fml_sym_add_local (fml->sym_tab, tp->tokenbuf);
604 info_var->body = NULL;
605 info_var->kind = FML_VAR;
609 if (info_var->kind == FML_VAR)
610 fml_node_delete (fml, info_var->body);
611 info_var->body = NULL;
616 printf ("[foreach %s ", tp->tokenbuf);
618 fml_cmd_lex (lp, tp);
619 assert (tp->kind == 'g');
620 fn = fml_sub0 (fml, tp->sub);
622 fml_cmd_lex (lp, tp);
623 assert (tp->kind == 'g');
628 struct fml_node *fn1;
635 info_var->body = fn->p[0];
639 printf ("[foreach loop var=");
640 fml_pr_list (info_var->body);
643 rv = fml_exec_group (body, fml);
646 fml_node_delete (fml, fn);
649 info_var->body = NULL;
655 static struct fml_node *fml_exec_if (struct fml_sym_info *info, Fml fml,
656 struct fml_node **lp, struct token *tp)
658 struct fml_node *fn, *body;
659 struct fml_node *rv, *return_value = NULL;
661 fml_cmd_lex (lp, tp);
662 assert (tp->kind == 'g');
663 fn = fml_sub0 (fml, tp->sub);
664 fml_cmd_lex (lp, tp);
665 assert (tp->kind == 'g');
668 rv = fml_exec_group (tp->sub, fml);
672 fml_cmd_lex (lp, tp);
675 info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
676 if (info->kind == FML_ELSE)
678 fml_cmd_lex (lp, tp);
679 assert (tp->kind == 'g');
683 rv = fml_exec_group (body, fml);
687 fml_cmd_lex (lp, tp);
690 fml_node_delete (fml, fn);
694 static struct fml_node *fml_exec_while (struct fml_sym_info *info, Fml fml,
695 struct fml_node **lp, struct token *tp)
697 struct fml_node *fn, *body;
698 struct fml_node *return_value = NULL;
700 fml_cmd_lex (lp, tp);
701 assert (tp->kind == 'g');
704 fml_cmd_lex (lp, tp);
705 assert (tp->kind == 'g');
710 struct fml_node *fn_expr;
714 fn_expr = fml_sub0 (fml, fn);
717 fml_node_delete (fml, fn_expr);
718 rv = fml_exec_group (body, fml);
725 static void fml_exec_set (struct fml_sym_info *info, Fml fml,
726 struct fml_node **lp, struct token *tp)
729 struct fml_sym_info *info_var;
731 fml_cmd_lex (lp, tp);
732 info_var = fml_sym_lookup_local (fml->sym_tab, tp->tokenbuf);
735 info_var = fml_sym_add_local (fml->sym_tab, tp->tokenbuf);
736 info_var->body = NULL;
741 printf ("set %s ", tp->tokenbuf);
743 info_var->kind = FML_VAR;
744 fml_cmd_lex (lp, tp);
748 fn = fml_sub0 (fml, tp->sub);
749 fml_cmd_lex (lp, tp);
752 fn = fml_sub2 (fml, lp, tp);
753 fml_node_delete (fml, info_var->body);
757 fml_pr_list (info_var->body);
762 static void fml_emit_expr (Fml fml, struct fml_node **lp, struct token *tp)
766 fn = fml_sub1 (fml, lp, tp);
768 fml_node_delete (fml, fn);
771 struct fml_node *fml_exec_group (struct fml_node *list, Fml fml)
774 struct fml_sym_info *info;
776 struct fml_node *return_value = NULL, *rv;
780 fml_init_token (&token, fml);
781 fml_cmd_lex (&list, &token);
787 rv = fml_exec_group (token.sub, fml);
792 info = fml_sym_lookup (fml->sym_tab, token.tokenbuf);
800 fml_cmd_lex (&list, &token);
801 assert (token.kind == 't');
802 info = fml_sym_lookup (fml->sym_tab, token.tokenbuf);
804 info = fml_sym_add (fml->sym_tab, token.tokenbuf);
805 info->kind = FML_PREFIX;
809 fml_cmd_lex (&list, &token);
810 if (token.kind != 't')
814 info->args = fn = fml_node_alloc (fml);
818 for (fn = info->args; fn->p[1]; fn=fn->p[1])
820 fn = fn->p[1] = fml_node_alloc (fml);
822 fn->p[0] = token.atom;
825 assert (token.kind == 'g');
826 info->body = token.sub;
829 fml_cmd_lex (&list, &token);
830 assert (token.kind == 't');
831 info = fml_sym_lookup (fml->sym_tab, token.tokenbuf);
833 info = fml_sym_add (fml->sym_tab, token.tokenbuf);
834 info->kind = FML_BINARY;
836 fml_cmd_lex (&list, &token);
837 assert (token.kind == 't');
838 info->args = fn = fml_node_alloc (fml);
839 fn->p[0] = token.atom;
842 fml_cmd_lex (&list, &token);
843 assert (token.kind == 't');
844 fn = fn->p[1] = fml_node_alloc (fml);
845 fn->p[0] = token.atom;
848 fml_cmd_lex (&list, &token);
849 assert (token.kind == 'g');
850 info->body = token.sub;
855 if (token.separate && !first)
856 (*fml->write_func) (' ');
858 fml_emit_expr (fml, &list, &token);
862 rv = fml_exec_foreach (info, fml, &list, &token);
867 rv = fml_exec_if (info, fml, &list, &token);
872 fml_exec_set (info, fml, &list, &token);
876 rv = fml_exec_while (info, fml, &list, &token);
881 fml_cmd_lex (&list, &token);
883 if (token.kind == 'g')
885 return_value = fml_sub0 (fml, token.sub);
886 fml_cmd_lex (&list, &token);
889 return_value = fml_sub2 (fml, &list, &token);
893 printf ("return of:");
894 fml_pr_list (return_value);
899 printf ("unknown token: `%s'", token.tokenbuf);
900 fml_cmd_lex (&list, &token);
905 printf ("<unknown>");
909 if (token.separate && !first)
910 (*fml->write_func) (' ');
912 fml_emit_expr (fml, &list, &token);
916 fml_cmd_lex (&list, &token);
918 fml_del_token (&token, fml);
922 void fml_exec (Fml fml)
925 fml_exec_group (fml->list, fml);