2 * Copyright (c) 1995, the EUROPAGATE consortium (see below).
4 * The EUROPAGATE consortium members are:
6 * University College Dublin
7 * Danmarks Teknologiske Videnscenter
8 * An Chomhairle Leabharlanna
9 * Consejo Superior de Investigaciones Cientificas
11 * Permission to use, copy, modify, distribute, and sell this software and
12 * its documentation, in whole or in part, for any purpose, is hereby granted,
15 * 1. This copyright and permission notice appear in all copies of the
16 * software and its documentation. Notices of copyright or attribution
17 * which appear at the beginning of any file must remain unchanged.
19 * 2. The names of EUROPAGATE or the project partners may not be used to
20 * endorse or promote products derived from this software without specific
21 * prior written permission.
23 * 3. Users of this software (implementors and gateway operators) agree to
24 * inform the EUROPAGATE consortium of their use of the software. This
25 * information will be used to evaluate the EUROPAGATE project and the
26 * software, and to plan further developments. The consortium may use
27 * the information in later publications.
29 * 4. Users of this software agree to make their best efforts, when
30 * documenting their use of the software, to acknowledge the EUROPAGATE
31 * consortium, and the role played by the software in their work.
33 * THIS SOFTWARE IS PROVIDED "AS IS" AND WITHOUT WARRANTY OF ANY KIND,
34 * EXPRESS, IMPLIED, OR OTHERWISE, INCLUDING WITHOUT LIMITATION, ANY
35 * WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE.
36 * IN NO EVENT SHALL THE EUROPAGATE CONSORTIUM OR ITS MEMBERS BE LIABLE
37 * FOR ANY SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL DAMAGES OF
38 * ANY KIND, OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA
39 * OR PROFITS, WHETHER OR NOT ADVISED OF THE POSSIBILITY OF DAMAGE, AND
40 * ON ANY THEORY OF LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE
41 * USE OR PERFORMANCE OF THIS SOFTWARE.
45 * FML interpreter. Europagate, 1995
48 * Revision 1.16 1995/05/16 09:39:32 adam
51 * Revision 1.15 1995/02/27 09:01:20 adam
52 * Regular expression support. Argument passing by name option. New FML
55 * Revision 1.14 1995/02/23 08:32:04 adam
58 * Revision 1.12 1995/02/22 15:20:13 adam
59 * Bug fix in fml_exec_space.
61 * Revision 1.11 1995/02/22 08:50:49 adam
62 * Definition of CPP changed. Output function can be customized.
64 * Revision 1.10 1995/02/21 17:46:08 adam
65 * Bug fix in fml_sub0.
67 * Revision 1.9 1995/02/21 14:00:03 adam
70 * Revision 1.8 1995/02/10 18:15:52 adam
71 * FML function 'strcmp' implemented. This function can be used to
72 * test for existence of MARC fields.
74 * Revision 1.7 1995/02/10 15:50:54 adam
75 * MARC interface implemented. Minor bugs fixed. fmltest can
76 * be used to format single MARC records. New function '\list'
79 * Revision 1.6 1995/02/09 16:06:06 adam
80 * FML can be called from the outside multiple times by the functions:
81 * fml_exec_call and fml_exec_call_str.
82 * An interactive parameter (-i) to fmltest starts a shell-like
83 * interface to FML by using the fml_exec_call_str function.
85 * Revision 1.5 1995/02/09 14:33:36 adam
86 * Split source fml.c and define relevant build-in functions in separate
87 * files. New operators mult, div, not, llen implemented.
89 * Revision 1.4 1995/02/09 13:07:14 adam
90 * Nodes are freed now. Many bugs fixed.
92 * Revision 1.3 1995/02/07 16:09:23 adam
93 * The \ character is no longer INCLUDED when terminating a token.
94 * Major changes in tokenization routines. Bug fixes in expressions
95 * with lists (fml_sub0).
97 * Revision 1.2 1995/02/06 15:23:25 adam
98 * Added some more relational operators (le,ne,ge). Added increment
99 * and decrement operators. Function index changed, so that first
100 * element is 1 - not 0. Function fml_atom_val edited.
102 * Revision 1.1.1.1 1995/02/06 13:48:10 adam
103 * First version of the FML interpreter. It's slow and memory isn't
104 * freed properly. In particular, the FML nodes aren't released yet.
113 static int default_read_func (void)
118 static void default_write_func (int c)
123 static void default_err_handle (int no)
125 fprintf (stderr, "Error: %d\n", no);
128 static struct fml_node *fml_sub0 (Fml fml, struct fml_node *list);
129 static struct fml_node *fml_sub1 (Fml fml, struct fml_node **lp,
131 static struct fml_node *fml_sub2 (Fml fml, struct fml_node **lp,
133 static struct fml_node *fml_exec_space (Fml fml, struct fml_node **lp,
135 static struct fml_node *fml_exec_nl (Fml fml, struct fml_node **lp,
138 static int indent = 0;
140 static void pr_indent (int n)
142 assert (indent >= 0);
163 struct fml_sym_info *sym_info;
165 Fml fml = malloc (sizeof(*fml));
170 fml->escape_char = '\\';
171 fml->comment_char = '#';
173 fml->white_chars = " \t\f\r\n";
174 fml->read_func = default_read_func;
175 fml->err_handle = default_err_handle;
176 fml->write_func = default_write_func;
179 fml->sym_tab = fml_sym_open ();
180 fml->atom_free_list = NULL;
181 fml->node_free_list = NULL;
184 sym_info = fml_sym_add (fml->sym_tab, "func");
185 sym_info->kind = FML_FUNC;
186 sym_info = fml_sym_add (fml->sym_tab, "bin");
187 sym_info->kind = FML_BIN;
188 sym_info = fml_sym_add (fml->sym_tab, "if");
189 sym_info->kind = FML_IF;
190 sym_info = fml_sym_add (fml->sym_tab, "else");
191 sym_info->kind = FML_ELSE;
192 sym_info = fml_sym_add (fml->sym_tab, "foreach");
193 sym_info->kind = FML_FOREACH;
194 sym_info = fml_sym_add (fml->sym_tab, "set");
195 sym_info->kind = FML_SET;
196 sym_info = fml_sym_add (fml->sym_tab, "while");
197 sym_info->kind = FML_WHILE;
198 sym_info = fml_sym_add (fml->sym_tab, "return");
199 sym_info->kind = FML_RETURN;
206 sym_info = fml_sym_add (fml->sym_tab, "s");
207 sym_info->kind = FML_CPREFIX;
208 sym_info->prefix = fml_exec_space;
209 sym_info = fml_sym_add (fml->sym_tab, " ");
210 sym_info->kind = FML_CPREFIX;
211 sym_info->prefix = fml_exec_space;
212 sym_info = fml_sym_add (fml->sym_tab, "n");
213 sym_info->kind = FML_CPREFIX;
214 sym_info->prefix = fml_exec_nl;
219 static Fml fml_pop_handler = NULL;
220 static void pop_handler (struct fml_sym_info *info)
222 assert (fml_pop_handler);
226 fml_node_delete (fml_pop_handler, info->body);
230 static void fml_do_pop (Fml fml)
232 fml_pop_handler = fml;
233 fml_sym_pop (fml->sym_tab, pop_handler);
236 int fml_preprocess (Fml fml)
238 fml->list = fml_tokenize (fml);
243 void fml_init_token (struct token *tp, Fml fml)
245 tp->maxbuf = FML_ATOM_BUF*2;
247 tp->atombuf = tp->sbuf;
248 tp->tokenbuf = tp->sbuf + tp->maxbuf;
249 tp->escape_char = fml->escape_char;
252 void fml_del_token (struct token *tp, Fml fml)
254 if (tp->maxbuf != FML_ATOM_BUF*2)
258 void fml_cmd_lex (struct fml_node **np, struct token *tp)
260 fml_cmd_lex_s (np, tp, 1);
263 void fml_cmd_lex_s (struct fml_node **np, struct token *tp, int esc_stop)
277 tp->atom = (*np)->p[0];
279 fml_atom_str (tp->atom, tp->atombuf);
282 int l = fml_atom_str (tp->atom, NULL);
283 if (l >= tp->maxbuf-1)
285 if (tp->maxbuf != FML_ATOM_BUF*2)
288 tp->atombuf = malloc (tp->maxbuf*2);
289 tp->tokenbuf = tp->atombuf + tp->maxbuf;
291 fml_atom_str (tp->atom, tp->atombuf);
296 tp->sub = (*np)->p[0];
304 cp = tp->atombuf + tp->offset;
306 if (*cp == tp->escape_char)
324 if (*cp == tp->escape_char && esc_stop)
327 tp->offset = cp - tp->atombuf;
337 struct fml_node *fml_expr_term (Fml fml, struct fml_node **lp,
343 fn = fml_sub0 (fml, tp->sub);
344 fml_cmd_lex (lp, tp);
347 fn = fml_sub2 (fml, lp, tp);
351 void fml_lr_values (Fml fml, struct fml_node *l, int *left_val,
352 struct fml_node *r, int *right_val)
355 *left_val = fml_atom_val (l->p[0]);
359 *right_val = fml_atom_val (r->p[0]);
362 fml_node_delete (fml, l);
363 fml_node_delete (fml, r);
366 static struct fml_node *fml_exec_space (Fml fml, struct fml_node **lp,
369 fml_cmd_lex (lp, tp);
371 (*fml->write_func) ('_');
373 (*fml->write_func) (' ');
377 static struct fml_node *fml_exec_nl (Fml fml, struct fml_node **lp,
380 fml_cmd_lex (lp, tp);
381 (*fml->write_func) ('\n');
385 static struct fml_node *fml_exec_prefix (struct fml_sym_info *info, Fml fml,
386 struct fml_node **lp,
390 struct fml_sym_info *arg_info;
391 struct fml_node *return_value;
392 static char arg_name[128];
397 printf ("exec_prefix ");
399 fml_sym_push (fml->sym_tab);
400 fml_cmd_lex (lp, tp);
401 for (fn = info->args; fn; fn = fn->p[1])
403 assert (fn->is_atom);
404 fml_atom_strx (fn->p[0], arg_name, 127);
408 printf ("%s=", arg_name);
410 if (*arg_name == fml->escape_char)
412 arg_info = fml_sym_add_local (fml->sym_tab, 1+arg_name);
413 arg_info->kind = FML_CODE;
416 arg_info->body = tp->sub;
418 arg_info->body = NULL;
421 fml_pr_list (arg_info->body);
424 fml_cmd_lex (lp, tp);
428 arg_info = fml_sym_add_local (fml->sym_tab, arg_name);
429 arg_info->kind = FML_VAR;
433 arg_info->body = fml_sub0 (fml, tp->sub);
434 fml_cmd_lex (lp, tp);
437 arg_info->body = fml_sub2 (fml, lp, tp);
440 fml_pr_list (arg_info->body);
445 return_value = fml_exec_group (info->body, fml);
456 static void fml_emit (Fml fml, struct fml_node *list)
465 (*fml->write_func) (' ');
467 for (a = list->p[0]; a; a=a->next)
470 while (i < FML_ATOM_BUF && a->buf[i])
471 (*fml->write_func) (a->buf[i++]);
475 fml_emit (fml, list->p[0]);
481 static struct fml_node *fml_sub2 (Fml fml, struct fml_node **lp,
485 struct fml_sym_info *info;
488 info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
491 printf ("<<unknown %s in expression>>", tp->tokenbuf);
498 fn = fml_node_copy (fml, info->body);
499 fml_cmd_lex (lp, tp);
502 fn = fml_node_copy (fml, info->body);
503 fml_cmd_lex (lp, tp);
506 fn = fml_exec_prefix (info, fml, lp, tp);
509 fn = (*info->prefix) (fml, lp, tp);
512 fml_cmd_lex (lp, tp);
516 else if (tp->kind == 'g')
519 fn = fml_sub0 (fml, tp->sub);
522 fml_cmd_lex (lp, tp);
524 else if (tp->kind == 't')
526 fn = fml_node_alloc (fml);
528 fn->p[0] = fml_atom_alloc (fml, tp->tokenbuf);
529 fml_cmd_lex (lp, tp);
536 static struct fml_node *fml_sub1 (Fml fml, struct fml_node **lp,
539 struct fml_node *f1, *f2, *fn;
540 struct fml_sym_info *info;
542 f1 = fml_sub2 (fml, lp, tp);
543 while (tp->kind == 'e')
545 info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
548 fprintf (stderr, "cannot locate `%s'", tp->tokenbuf);
551 if (info->kind == FML_CBINARY)
553 fml_cmd_lex (lp, tp);
554 f2 = fml_sub2 (fml, lp, tp);
555 fn = (*info->binary) (fml, f1, f2);
559 else if (info->kind == FML_BINARY)
561 struct fml_sym_info *arg_info;
567 printf ("exec binary %s", tp->tokenbuf);
569 fml_cmd_lex (lp, tp);
570 f2 = fml_sub2 (fml, lp, tp);
571 fml_sym_push (fml->sym_tab);
573 fml_atom_strx (info->args->p[0], arg, 127);
574 arg_info = fml_sym_add_local (fml->sym_tab, arg);
575 arg_info->kind = FML_VAR;
582 fml_atom_strx ( ((struct fml_node *) info->args->p[1])->p[0],
584 arg_info = fml_sym_add_local (fml->sym_tab, arg);
585 arg_info->kind = FML_VAR;
593 f1 = fml_exec_group (info->body, fml);
608 static struct fml_node *fml_sub0 (Fml fml, struct fml_node *list)
611 struct fml_node *fn, *fn1;
613 fml_init_token (&token, fml);
615 fml_cmd_lex (&list, &token);
616 fn = fml_sub1 (fml, &list, &token);
617 if (token.kind == '\0')
619 fml_del_token (&token, fml);
622 fn1 = fml_node_alloc (fml);
625 while (token.kind != '\0')
627 fn1 = fn1->p[1] = fml_node_alloc (fml);
628 fn1->p[0] = fml_sub1 (fml, &list, &token);
630 fml_del_token (&token, fml);
634 static struct fml_node *fml_sub0 (Fml fml, struct fml_node *list)
637 struct fml_node *fn, *fn0, *fn1;
641 fml_init_token (&token, fml);
642 fml_cmd_lex (&list, &token);
643 fn1 = fn = fml_sub1 (fml, &list, &token);
646 fml_del_token (&token, fml);
649 if (fn->p[1] && token.kind != '\0')
651 fn1 = fml_node_alloc (fml);
655 while (token.kind != '\0')
657 fn = fml_sub1 (fml, &list, &token);
660 fn1 = fn1->p[1] = fml_node_alloc (fml);
665 fn1 = fn1->p[1] = fn;
668 fml_del_token (&token, fml);
673 static struct fml_node *fml_exec_foreach (struct fml_sym_info *info, Fml fml,
674 struct fml_node **lp,
677 struct fml_sym_info *info_var;
678 struct fml_node *fn, *body;
679 struct fml_node *return_value = NULL, *rv;
681 fml_cmd_lex (lp, tp);
682 assert (tp->kind == 't');
684 info_var = fml_sym_lookup_local (fml->sym_tab, tp->tokenbuf);
687 info_var = fml_sym_add_local (fml->sym_tab, tp->tokenbuf);
688 info_var->body = NULL;
689 info_var->kind = FML_VAR;
693 if (info_var->kind == FML_VAR)
694 fml_node_delete (fml, info_var->body);
695 info_var->body = NULL;
700 printf ("[foreach %s ", tp->tokenbuf);
702 fml_cmd_lex (lp, tp);
703 assert (tp->kind == 'g');
704 fn = fml_sub0 (fml, tp->sub);
706 fml_cmd_lex (lp, tp);
707 assert (tp->kind == 'g');
712 struct fml_node *fn1;
719 info_var->body = fn->p[0];
723 printf ("[foreach loop var=");
724 fml_pr_list (info_var->body);
727 rv = fml_exec_group (body, fml);
730 fml_node_delete (fml, fn);
733 info_var->body = NULL;
739 static struct fml_node *fml_exec_if (struct fml_sym_info *info, Fml fml,
740 struct fml_node **lp, struct token *tp)
742 struct fml_node *fn, *body;
743 struct fml_node *rv, *return_value = NULL;
745 fml_cmd_lex (lp, tp);
746 assert (tp->kind == 'g');
747 fn = fml_sub0 (fml, tp->sub);
748 fml_cmd_lex (lp, tp);
749 assert (tp->kind == 'g');
752 rv = fml_exec_group (tp->sub, fml);
756 fml_cmd_lex (lp, tp);
759 info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
760 if (info->kind == FML_ELSE)
762 fml_cmd_lex (lp, tp);
763 assert (tp->kind == 'g');
767 rv = fml_exec_group (body, fml);
771 fml_cmd_lex (lp, tp);
774 fml_node_delete (fml, fn);
778 static struct fml_node *fml_exec_while (struct fml_sym_info *info, Fml fml,
779 struct fml_node **lp, struct token *tp)
781 struct fml_node *fn, *body;
782 struct fml_node *return_value = NULL;
784 fml_cmd_lex (lp, tp);
785 assert (tp->kind == 'g');
788 fml_cmd_lex (lp, tp);
789 assert (tp->kind == 'g');
794 struct fml_node *fn_expr;
798 fn_expr = fml_sub0 (fml, fn);
801 fml_node_delete (fml, fn_expr);
802 rv = fml_exec_group (body, fml);
809 static void fml_exec_set (struct fml_sym_info *info, Fml fml,
810 struct fml_node **lp, struct token *tp)
813 struct fml_sym_info *info_var;
815 fml_cmd_lex (lp, tp);
816 info_var = fml_sym_lookup_local (fml->sym_tab, tp->tokenbuf);
819 info_var = fml_sym_add_local (fml->sym_tab, tp->tokenbuf);
820 info_var->body = NULL;
825 printf ("set %s ", tp->tokenbuf);
827 info_var->kind = FML_VAR;
828 fml_cmd_lex (lp, tp);
832 fn = fml_sub0 (fml, tp->sub);
833 fml_cmd_lex (lp, tp);
836 fn = fml_sub2 (fml, lp, tp);
837 fml_node_delete (fml, info_var->body);
841 fml_pr_list (info_var->body);
846 static void fml_emit_expr (Fml fml, struct fml_node **lp, struct token *tp)
850 fn = fml_sub1 (fml, lp, tp);
852 fml_node_delete (fml, fn);
855 struct fml_node *fml_exec_group (struct fml_node *list, Fml fml)
858 struct fml_sym_info *info;
860 struct fml_node *return_value = NULL, *rv;
864 fml_init_token (&token, fml);
865 fml_cmd_lex (&list, &token);
871 rv = fml_exec_group (token.sub, fml);
876 info = fml_sym_lookup (fml->sym_tab, token.tokenbuf);
884 fml_cmd_lex (&list, &token);
885 assert (token.kind == 't');
886 info = fml_sym_lookup (fml->sym_tab, token.tokenbuf);
888 info = fml_sym_add (fml->sym_tab, token.tokenbuf);
889 info->kind = FML_PREFIX;
893 fml_cmd_lex (&list, &token);
894 if (token.kind != 't' && token.kind != 'e')
898 info->args = fn = fml_node_alloc (fml);
902 for (fn = info->args; fn->p[1]; fn=fn->p[1])
904 fn = fn->p[1] = fml_node_alloc (fml);
906 fn->p[0] = token.atom;
909 assert (token.kind == 'g');
910 info->body = token.sub;
913 fml_cmd_lex (&list, &token);
914 assert (token.kind == 't');
915 info = fml_sym_lookup (fml->sym_tab, token.tokenbuf);
917 info = fml_sym_add (fml->sym_tab, token.tokenbuf);
918 info->kind = FML_BINARY;
920 fml_cmd_lex (&list, &token);
921 assert (token.kind == 't');
922 info->args = fn = fml_node_alloc (fml);
923 fn->p[0] = token.atom;
926 fml_cmd_lex (&list, &token);
927 assert (token.kind == 't');
928 fn = fn->p[1] = fml_node_alloc (fml);
929 fn->p[0] = token.atom;
932 fml_cmd_lex (&list, &token);
933 assert (token.kind == 'g');
934 info->body = token.sub;
939 if (token.separate && !first)
940 (*fml->write_func) (' ');
942 fml_emit_expr (fml, &list, &token);
946 rv = fml_exec_foreach (info, fml, &list, &token);
951 rv = fml_exec_if (info, fml, &list, &token);
956 fml_exec_set (info, fml, &list, &token);
960 rv = fml_exec_while (info, fml, &list, &token);
965 fml_cmd_lex (&list, &token);
967 if (token.kind == 'g')
969 return_value = fml_sub0 (fml, token.sub);
970 fml_cmd_lex (&list, &token);
973 return_value = fml_sub2 (fml, &list, &token);
977 printf ("return of:");
978 fml_pr_list (return_value);
983 fml_exec_group (info->body, fml);
986 printf ("<unknown token: `%s'>", token.tokenbuf);
987 fml_cmd_lex (&list, &token);
992 printf ("<unknown %s>", token.tokenbuf);
996 if (token.separate && !first)
997 (*fml->write_func) (' ');
999 fml_emit_expr (fml, &list, &token);
1000 fml_node_stat (fml);
1003 fml_cmd_lex (&list, &token);
1005 fml_del_token (&token, fml);
1006 return return_value;
1009 void fml_exec (Fml fml)
1011 fml_node_stat (fml);
1012 fml_exec_group (fml->list, fml);