2 * FML interpreter. Europagate, 1995
5 * Revision 1.9 1995/02/21 14:00:03 adam
8 * Revision 1.8 1995/02/10 18:15:52 adam
9 * FML function 'strcmp' implemented. This function can be used to
10 * test for existence of MARC fields.
12 * Revision 1.7 1995/02/10 15:50:54 adam
13 * MARC interface implemented. Minor bugs fixed. fmltest can
14 * be used to format single MARC records. New function '\list'
17 * Revision 1.6 1995/02/09 16:06:06 adam
18 * FML can be called from the outside multiple times by the functions:
19 * fml_exec_call and fml_exec_call_str.
20 * An interactive parameter (-i) to fmltest starts a shell-like
21 * interface to FML by using the fml_exec_call_str function.
23 * Revision 1.5 1995/02/09 14:33:36 adam
24 * Split source fml.c and define relevant build-in functions in separate
25 * files. New operators mult, div, not, llen implemented.
27 * Revision 1.4 1995/02/09 13:07:14 adam
28 * Nodes are freed now. Many bugs fixed.
30 * Revision 1.3 1995/02/07 16:09:23 adam
31 * The \ character is no longer INCLUDED when terminating a token.
32 * Major changes in tokenization routines. Bug fixes in expressions
33 * with lists (fml_sub0).
35 * Revision 1.2 1995/02/06 15:23:25 adam
36 * Added some more relational operators (le,ne,ge). Added increment
37 * and decrement operators. Function index changed, so that first
38 * element is 1 - not 0. Function fml_atom_val edited.
40 * Revision 1.1.1.1 1995/02/06 13:48:10 adam
41 * First version of the FML interpreter. It's slow and memory isn't
42 * freed properly. In particular, the FML nodes aren't released yet.
51 static int default_read_func (void)
56 static void default_err_handle (int no)
58 fprintf (stderr, "Error: %d\n", no);
61 static struct fml_node *fml_sub0 (Fml fml, struct fml_node *list);
62 static struct fml_node *fml_sub1 (Fml fml, struct fml_node **lp,
64 static struct fml_node *fml_sub2 (Fml fml, struct fml_node **lp,
66 static struct fml_node *fml_exec_space (Fml fml, struct fml_node **lp,
68 static struct fml_node *fml_exec_nl (Fml fml, struct fml_node **lp,
71 static int indent = 0;
73 static void pr_indent (int n)
96 struct fml_sym_info *sym_info;
98 Fml fml = malloc (sizeof(*fml));
103 fml->escape_char = '\\';
104 fml->comment_char = '#';
106 fml->white_chars = " \t\f\r\n";
107 fml->read_func = default_read_func;
108 fml->err_handle = default_err_handle;
111 fml->sym_tab = fml_sym_open ();
112 fml->atom_free_list = NULL;
113 fml->node_free_list = NULL;
116 sym_info = fml_sym_add (fml->sym_tab, "func");
117 sym_info->kind = FML_FUNC;
118 sym_info = fml_sym_add (fml->sym_tab, "bin");
119 sym_info->kind = FML_BIN;
120 sym_info = fml_sym_add (fml->sym_tab, "if");
121 sym_info->kind = FML_IF;
122 sym_info = fml_sym_add (fml->sym_tab, "else");
123 sym_info->kind = FML_ELSE;
124 sym_info = fml_sym_add (fml->sym_tab, "foreach");
125 sym_info->kind = FML_FOREACH;
126 sym_info = fml_sym_add (fml->sym_tab, "set");
127 sym_info->kind = FML_SET;
128 sym_info = fml_sym_add (fml->sym_tab, "while");
129 sym_info->kind = FML_WHILE;
130 sym_info = fml_sym_add (fml->sym_tab, "return");
131 sym_info->kind = FML_RETURN;
138 sym_info = fml_sym_add (fml->sym_tab, "s");
139 sym_info->kind = FML_CPREFIX;
140 sym_info->prefix = fml_exec_space;
141 sym_info = fml_sym_add (fml->sym_tab, " ");
142 sym_info->kind = FML_CPREFIX;
143 sym_info->prefix = fml_exec_space;
144 sym_info = fml_sym_add (fml->sym_tab, "n");
145 sym_info->kind = FML_CPREFIX;
146 sym_info->prefix = fml_exec_nl;
151 static Fml fml_pop_handler = NULL;
152 static void pop_handler (struct fml_sym_info *info)
154 assert (fml_pop_handler);
158 fml_node_delete (fml_pop_handler, info->body);
162 static void fml_do_pop (Fml fml)
164 fml_pop_handler = fml;
165 fml_sym_pop (fml->sym_tab, pop_handler);
168 int fml_preprocess (Fml fml)
170 fml->list = fml_tokenize (fml);
175 void fml_init_token (struct token *tp, Fml fml)
177 tp->maxbuf = FML_ATOM_BUF*2;
179 tp->atombuf = tp->sbuf;
180 tp->tokenbuf = tp->sbuf + tp->maxbuf;
181 tp->escape_char = fml->escape_char;
184 void fml_del_token (struct token *tp, Fml fml)
186 if (tp->maxbuf != FML_ATOM_BUF*2)
190 void fml_cmd_lex (struct fml_node **np, struct token *tp)
204 tp->atom = (*np)->p[0];
206 fml_atom_str (tp->atom, tp->atombuf);
209 int l = fml_atom_str (tp->atom, NULL);
210 if (l >= tp->maxbuf-1)
212 if (tp->maxbuf != FML_ATOM_BUF*2)
215 tp->atombuf = malloc (tp->maxbuf*2);
216 tp->tokenbuf = tp->atombuf + tp->maxbuf;
218 fml_atom_str (tp->atom, tp->atombuf);
223 tp->sub = (*np)->p[0];
231 cp = tp->atombuf + tp->offset;
233 if (*cp == tp->escape_char)
251 if (*cp == tp->escape_char)
254 tp->offset = cp - tp->atombuf;
264 struct fml_node *fml_expr_term (Fml fml, struct fml_node **lp,
270 fn = fml_sub0 (fml, tp->sub);
271 fml_cmd_lex (lp, tp);
274 fn = fml_sub2 (fml, lp, tp);
278 void fml_lr_values (Fml fml, struct fml_node *l, int *left_val,
279 struct fml_node *r, int *right_val)
282 *left_val = fml_atom_val (l->p[0]);
286 *right_val = fml_atom_val (r->p[0]);
289 fml_node_delete (fml, l);
290 fml_node_delete (fml, r);
293 static struct fml_node *fml_exec_space (Fml fml, struct fml_node **lp,
296 fml_cmd_lex (lp, tp);
304 static struct fml_node *fml_exec_nl (Fml fml, struct fml_node **lp,
307 fml_cmd_lex (lp, tp);
312 static struct fml_node *fml_exec_prefix (struct fml_sym_info *info, Fml fml,
313 struct fml_node **lp,
317 struct fml_sym_info *arg_info;
318 struct fml_node *return_value;
319 static char arg[128];
324 printf ("exec_prefix ");
326 fml_sym_push (fml->sym_tab);
327 fml_cmd_lex (lp, tp);
328 for (fn = info->args; fn; fn = fn->p[1])
331 assert (fn->is_atom);
332 fml_atom_strx (fn->p[0], arg, 127);
338 arg_info = fml_sym_add_local (fml->sym_tab, arg);
339 arg_info->kind = FML_VAR;
343 arg_info->body = fml_sub0 (fml, tp->sub);
344 fml_cmd_lex (lp, tp);
347 arg_info->body = fml_sub2 (fml, lp, tp);
350 fml_pr_list (arg_info->body);
354 return_value = fml_exec_group (info->body, fml);
365 static void fml_emit (struct fml_node *list)
376 for (a = list->p[0]; a; a=a->next)
377 printf ("%.*s", FML_ATOM_BUF, a->buf);
380 fml_emit (list->p[0]);
386 static struct fml_node *fml_sub2 (Fml fml, struct fml_node **lp,
390 struct fml_sym_info *info;
393 info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
398 fn = fml_node_copy (fml, info->body);
399 fml_cmd_lex (lp, tp);
402 fn = fml_exec_prefix (info, fml, lp, tp);
405 fn = (*info->prefix) (fml, lp, tp);
408 fml_cmd_lex (lp, tp);
412 else if (tp->kind == 'g')
415 fn = fml_sub0 (fml, tp->sub);
418 fml_cmd_lex (lp, tp);
420 else if (tp->kind == 't')
422 fn = fml_node_alloc (fml);
424 fn->p[0] = fml_atom_alloc (fml, tp->tokenbuf);
425 fml_cmd_lex (lp, tp);
432 static struct fml_node *fml_sub1 (Fml fml, struct fml_node **lp,
435 struct fml_node *f1, *f2, *fn;
436 struct fml_sym_info *info;
438 f1 = fml_sub2 (fml, lp, tp);
439 while (tp->kind == 'e')
441 info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
444 fprintf (stderr, "cannot locate `%s'", tp->tokenbuf);
447 if (info->kind == FML_CBINARY)
449 fml_cmd_lex (lp, tp);
450 f2 = fml_sub2 (fml, lp, tp);
451 fn = (*info->binary) (fml, f1, f2);
455 else if (info->kind == FML_BINARY)
457 struct fml_sym_info *arg_info;
463 printf ("exec binary %s", tp->tokenbuf);
465 fml_cmd_lex (lp, tp);
466 f2 = fml_sub2 (fml, lp, tp);
467 fml_sym_push (fml->sym_tab);
469 fml_atom_strx (info->args->p[0], arg, 127);
470 arg_info = fml_sym_add_local (fml->sym_tab, arg);
471 arg_info->kind = FML_VAR;
478 fml_atom_strx ( ((struct fml_node *) info->args->p[1])->p[0],
480 arg_info = fml_sym_add_local (fml->sym_tab, arg);
481 arg_info->kind = FML_VAR;
489 f1 = fml_exec_group (info->body, fml);
504 static struct fml_node *fml_sub0 (Fml fml, struct fml_node *list)
507 struct fml_node *fn, *fn1;
509 fml_init_token (&token, fml);
511 fml_cmd_lex (&list, &token);
512 fn = fml_sub1 (fml, &list, &token);
513 if (token.kind == '\0')
515 fml_del_token (&token, fml);
518 fn1 = fml_node_alloc (fml);
521 while (token.kind != '\0')
523 fn1 = fn1->p[1] = fml_node_alloc (fml);
524 fn1->p[0] = fml_sub1 (fml, &list, &token);
526 fml_del_token (&token, fml);
530 static struct fml_node *fml_sub0 (Fml fml, struct fml_node *list)
533 struct fml_node *fn, *fn0, *fn1;
537 fml_init_token (&token, fml);
538 fml_cmd_lex (&list, &token);
539 fn1 = fn = fml_sub1 (fml, &list, &token);
540 if (fn->p[1] && token.kind != '\0')
542 fn1 = fml_node_alloc (fml);
546 while (token.kind != '\0')
548 fn = fml_sub1 (fml, &list, &token);
551 fn1 = fn1->p[1] = fml_node_alloc (fml);
556 fn1 = fn1->p[1] = fn;
559 fml_del_token (&token, fml);
564 static struct fml_node *fml_exec_foreach (struct fml_sym_info *info, Fml fml,
565 struct fml_node **lp,
568 struct fml_sym_info *info_var;
569 struct fml_node *fn, *body;
570 struct fml_node *return_value = NULL, *rv;
572 fml_cmd_lex (lp, tp);
573 assert (tp->kind == 't');
575 info_var = fml_sym_lookup_local (fml->sym_tab, tp->tokenbuf);
578 info_var = fml_sym_add_local (fml->sym_tab, tp->tokenbuf);
579 info_var->body = NULL;
580 info_var->kind = FML_VAR;
584 if (info_var->kind == FML_VAR)
585 fml_node_delete (fml, info_var->body);
586 info_var->body = NULL;
591 printf ("[foreach %s ", tp->tokenbuf);
593 fml_cmd_lex (lp, tp);
594 assert (tp->kind == 'g');
595 fn = fml_sub0 (fml, tp->sub);
597 fml_cmd_lex (lp, tp);
598 assert (tp->kind == 'g');
603 struct fml_node *fn1;
610 info_var->body = fn->p[0];
614 printf ("[foreach loop var=");
615 fml_pr_list (info_var->body);
618 rv = fml_exec_group (body, fml);
621 fml_node_delete (fml, fn);
624 info_var->body = NULL;
630 static struct fml_node *fml_exec_if (struct fml_sym_info *info, Fml fml,
631 struct fml_node **lp, struct token *tp)
633 struct fml_node *fn, *body;
634 struct fml_node *rv, *return_value = NULL;
636 fml_cmd_lex (lp, tp);
637 assert (tp->kind == 'g');
638 fn = fml_sub0 (fml, tp->sub);
639 fml_cmd_lex (lp, tp);
640 assert (tp->kind == 'g');
643 rv = fml_exec_group (tp->sub, fml);
647 fml_cmd_lex (lp, tp);
650 info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
651 if (info->kind == FML_ELSE)
653 fml_cmd_lex (lp, tp);
654 assert (tp->kind == 'g');
658 rv = fml_exec_group (body, fml);
662 fml_cmd_lex (lp, tp);
665 fml_node_delete (fml, fn);
669 static struct fml_node *fml_exec_while (struct fml_sym_info *info, Fml fml,
670 struct fml_node **lp, struct token *tp)
672 struct fml_node *fn, *body;
673 struct fml_node *return_value = NULL;
675 fml_cmd_lex (lp, tp);
676 assert (tp->kind == 'g');
679 fml_cmd_lex (lp, tp);
680 assert (tp->kind == 'g');
685 struct fml_node *fn_expr;
689 fn_expr = fml_sub0 (fml, fn);
692 fml_node_delete (fml, fn_expr);
693 rv = fml_exec_group (body, fml);
700 static void fml_exec_set (struct fml_sym_info *info, Fml fml,
701 struct fml_node **lp, struct token *tp)
704 struct fml_sym_info *info_var;
706 fml_cmd_lex (lp, tp);
707 info_var = fml_sym_lookup_local (fml->sym_tab, tp->tokenbuf);
710 info_var = fml_sym_add_local (fml->sym_tab, tp->tokenbuf);
711 info_var->body = NULL;
716 printf ("set %s ", tp->tokenbuf);
718 info_var->kind = FML_VAR;
719 fml_cmd_lex (lp, tp);
723 fn = fml_sub0 (fml, tp->sub);
724 fml_cmd_lex (lp, tp);
727 fn = fml_sub2 (fml, lp, tp);
728 fml_node_delete (fml, info_var->body);
732 fml_pr_list (info_var->body);
737 static void fml_emit_expr (Fml fml, struct fml_node **lp, struct token *tp)
741 fn = fml_sub1 (fml, lp, tp);
743 fml_node_delete (fml, fn);
746 struct fml_node *fml_exec_group (struct fml_node *list, Fml fml)
749 struct fml_sym_info *info;
751 struct fml_node *return_value = NULL, *rv;
755 fml_init_token (&token, fml);
756 fml_cmd_lex (&list, &token);
762 rv = fml_exec_group (token.sub, fml);
767 info = fml_sym_lookup (fml->sym_tab, token.tokenbuf);
775 fml_cmd_lex (&list, &token);
776 assert (token.kind == 't');
777 info = fml_sym_lookup (fml->sym_tab, token.tokenbuf);
779 info = fml_sym_add (fml->sym_tab, token.tokenbuf);
780 info->kind = FML_PREFIX;
784 fml_cmd_lex (&list, &token);
785 if (token.kind != 't')
789 info->args = fn = fml_node_alloc (fml);
793 for (fn = info->args; fn->p[1]; fn=fn->p[1])
795 fn = fn->p[1] = fml_node_alloc (fml);
797 fn->p[0] = token.atom;
800 assert (token.kind == 'g');
801 info->body = token.sub;
804 fml_cmd_lex (&list, &token);
805 assert (token.kind == 't');
806 info = fml_sym_lookup (fml->sym_tab, token.tokenbuf);
808 info = fml_sym_add (fml->sym_tab, token.tokenbuf);
809 info->kind = FML_BINARY;
811 fml_cmd_lex (&list, &token);
812 assert (token.kind == 't');
813 info->args = fn = fml_node_alloc (fml);
814 fn->p[0] = token.atom;
817 fml_cmd_lex (&list, &token);
818 assert (token.kind == 't');
819 fn = fn->p[1] = fml_node_alloc (fml);
820 fn->p[0] = token.atom;
823 fml_cmd_lex (&list, &token);
824 assert (token.kind == 'g');
825 info->body = token.sub;
830 if (token.separate && !first)
833 fml_emit_expr (fml, &list, &token);
837 rv = fml_exec_foreach (info, fml, &list, &token);
842 rv = fml_exec_if (info, fml, &list, &token);
847 fml_exec_set (info, fml, &list, &token);
851 rv = fml_exec_while (info, fml, &list, &token);
856 fml_cmd_lex (&list, &token);
858 if (token.kind == 'g')
860 return_value = fml_sub0 (fml, token.sub);
861 fml_cmd_lex (&list, &token);
864 return_value = fml_sub2 (fml, &list, &token);
868 printf ("return of:");
869 fml_pr_list (return_value);
874 printf ("unknown token: `%s'", token.tokenbuf);
875 fml_cmd_lex (&list, &token);
880 printf ("<unknown>");
884 if (token.separate && !first)
887 fml_emit_expr (fml, &list, &token);
891 fml_cmd_lex (&list, &token);
893 fml_del_token (&token, fml);
897 void fml_exec (Fml fml)
900 fml_exec_group (fml->list, fml);