/*
+ * Copyright (c) 1995, the EUROPAGATE consortium (see below).
+ *
+ * The EUROPAGATE consortium members are:
+ *
+ * University College Dublin
+ * Danmarks Teknologiske Videnscenter
+ * An Chomhairle Leabharlanna
+ * Consejo Superior de Investigaciones Cientificas
+ *
+ * Permission to use, copy, modify, distribute, and sell this software and
+ * its documentation, in whole or in part, for any purpose, is hereby granted,
+ * provided that:
+ *
+ * 1. This copyright and permission notice appear in all copies of the
+ * software and its documentation. Notices of copyright or attribution
+ * which appear at the beginning of any file must remain unchanged.
+ *
+ * 2. The names of EUROPAGATE or the project partners may not be used to
+ * endorse or promote products derived from this software without specific
+ * prior written permission.
+ *
+ * 3. Users of this software (implementors and gateway operators) agree to
+ * inform the EUROPAGATE consortium of their use of the software. This
+ * information will be used to evaluate the EUROPAGATE project and the
+ * software, and to plan further developments. The consortium may use
+ * the information in later publications.
+ *
+ * 4. Users of this software agree to make their best efforts, when
+ * documenting their use of the software, to acknowledge the EUROPAGATE
+ * consortium, and the role played by the software in their work.
+ *
+ * THIS SOFTWARE IS PROVIDED "AS IS" AND WITHOUT WARRANTY OF ANY KIND,
+ * EXPRESS, IMPLIED, OR OTHERWISE, INCLUDING WITHOUT LIMITATION, ANY
+ * WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE.
+ * IN NO EVENT SHALL THE EUROPAGATE CONSORTIUM OR ITS MEMBERS BE LIABLE
+ * FOR ANY SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL DAMAGES OF
+ * ANY KIND, OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA
+ * OR PROFITS, WHETHER OR NOT ADVISED OF THE POSSIBILITY OF DAMAGE, AND
+ * ON ANY THEORY OF LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE
+ * USE OR PERFORMANCE OF THIS SOFTWARE.
+ *
+ */
+/*
* FML interpreter. Europagate, 1995
*
* $Log: fml.c,v $
- * Revision 1.5 1995/02/09 14:33:36 adam
+ * Revision 1.16 1995/05/16 09:39:32 adam
+ * LICENSE.
+ *
+ * Revision 1.15 1995/02/27 09:01:20 adam
+ * Regular expression support. Argument passing by name option. New FML
+ * function strlen.
+ *
+ * Revision 1.14 1995/02/23 08:32:04 adam
+ * Changed header.
+ *
+ * Revision 1.12 1995/02/22 15:20:13 adam
+ * Bug fix in fml_exec_space.
+ *
+ * Revision 1.11 1995/02/22 08:50:49 adam
+ * Definition of CPP changed. Output function can be customized.
+ *
+ * Revision 1.10 1995/02/21 17:46:08 adam
+ * Bug fix in fml_sub0.
+ *
+ * Revision 1.9 1995/02/21 14:00:03 adam
+ * Minor changes.
+ *
+ * Revision 1.8 1995/02/10 18:15:52 adam
+ * FML function 'strcmp' implemented. This function can be used to
+ * test for existence of MARC fields.
+ *
+ * Revision 1.7 1995/02/10 15:50:54 adam
+ * MARC interface implemented. Minor bugs fixed. fmltest can
+ * be used to format single MARC records. New function '\list'
+ * implemented.
+ *
+ * Revision 1.6 1995/02/09 16:06:06 adam
+ * FML can be called from the outside multiple times by the functions:
+ * fml_exec_call and fml_exec_call_str.
+ * An interactive parameter (-i) to fmltest starts a shell-like
+ * interface to FML by using the fml_exec_call_str function.
+ *
+ * Revision 1.5 1995/02/09 14:33:36 adam
* Split source fml.c and define relevant build-in functions in separate
* files. New operators mult, div, not, llen implemented.
*
return getchar ();
}
+static void default_write_func (int c)
+{
+ putchar (c);
+}
+
static void default_err_handle (int no)
{
fprintf (stderr, "Error: %d\n", no);
fml->white_chars = " \t\f\r\n";
fml->read_func = default_read_func;
fml->err_handle = default_err_handle;
+ fml->write_func = default_write_func;
fml->list = NULL;
fml->sym_tab = fml_sym_open ();
fml_list_init (fml);
fml_arit_init (fml);
fml_rel_init (fml);
+ fml_str_init (fml);
sym_info = fml_sym_add (fml->sym_tab, "s");
sym_info->kind = FML_CPREFIX;
void fml_cmd_lex (struct fml_node **np, struct token *tp)
{
+ fml_cmd_lex_s (np, tp, 1);
+}
+
+void fml_cmd_lex_s (struct fml_node **np, struct token *tp, int esc_stop)
+{
char *cp;
char *dst;
if (!*np)
}
while (*cp)
{
- if (*cp == tp->escape_char)
+ if (*cp == tp->escape_char && esc_stop)
{
*dst = '\0';
tp->offset = cp - tp->atombuf;
return fn;
}
-static struct fml_node *fml_exec_group (struct fml_node *list, Fml fml);
-
void fml_lr_values (Fml fml, struct fml_node *l, int *left_val,
struct fml_node *r, int *right_val)
{
struct token *tp)
{
fml_cmd_lex (lp, tp);
- putchar ('_');
+ if (fml->debug & 1)
+ (*fml->write_func) ('_');
+ else
+ (*fml->write_func) (' ');
return NULL;
}
struct token *tp)
{
fml_cmd_lex (lp, tp);
- putchar ('\n');
+ (*fml->write_func) ('\n');
return NULL;
}
struct fml_node *fn;
struct fml_sym_info *arg_info;
struct fml_node *return_value;
- static char arg[128];
+ static char arg_name[128];
if (fml->debug & 1)
{
fml_cmd_lex (lp, tp);
for (fn = info->args; fn; fn = fn->p[1])
{
-
assert (fn->is_atom);
- fml_atom_strx (fn->p[0], arg, 127);
+ fml_atom_strx (fn->p[0], arg_name, 127);
if (fml->debug & 1)
{
pr_indent (1);
- printf ("%s=", arg);
+ printf ("%s=", arg_name);
}
- arg_info = fml_sym_add_local (fml->sym_tab, arg);
- arg_info->kind = FML_VAR;
-
- if (tp->kind == 'g')
+ if (*arg_name == fml->escape_char)
{
- arg_info->body = fml_sub0 (fml, tp->sub);
+ arg_info = fml_sym_add_local (fml->sym_tab, 1+arg_name);
+ arg_info->kind = FML_CODE;
+
+ if (tp->kind == 'g')
+ arg_info->body = tp->sub;
+ else
+ arg_info->body = NULL;
+ if (fml->debug & 1)
+ {
+ fml_pr_list (arg_info->body);
+ pr_indent (-1);
+ }
fml_cmd_lex (lp, tp);
}
else
- arg_info->body = fml_sub2 (fml, lp, tp);
- if (fml->debug & 1)
{
- fml_pr_list (arg_info->body);
- pr_indent (-1);
+ arg_info = fml_sym_add_local (fml->sym_tab, arg_name);
+ arg_info->kind = FML_VAR;
+
+ if (tp->kind == 'g')
+ {
+ arg_info->body = fml_sub0 (fml, tp->sub);
+ fml_cmd_lex (lp, tp);
+ }
+ else
+ arg_info->body = fml_sub2 (fml, lp, tp);
+ if (fml->debug & 1)
+ {
+ fml_pr_list (arg_info->body);
+ pr_indent (-1);
+ }
}
}
return_value = fml_exec_group (info->body, fml);
}
-static void fml_emit (struct fml_node *list)
+static void fml_emit (Fml fml, struct fml_node *list)
{
int s = 0;
while (list)
{
struct fml_atom *a;
if (s)
- printf (" ");
+ (*fml->write_func) (' ');
s++;
for (a = list->p[0]; a; a=a->next)
- printf ("%s", a->buf);
+ {
+ int i = 0;
+ while (i < FML_ATOM_BUF && a->buf[i])
+ (*fml->write_func) (a->buf[i++]);
+ }
}
else
- fml_emit (list->p[0]);
+ fml_emit (fml, list->p[0]);
list = list->p[1];
}
}
if (tp->kind == 'e')
{
info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
- assert (info);
+ if (!info)
+ {
+ printf ("<<unknown %s in expression>>", tp->tokenbuf);
+ getchar ();
+ return NULL;
+ }
switch (info->kind)
{
case FML_VAR:
fn = fml_node_copy (fml, info->body);
fml_cmd_lex (lp, tp);
break;
+ case FML_CODE:
+ fn = fml_node_copy (fml, info->body);
+ fml_cmd_lex (lp, tp);
+ break;
case FML_PREFIX:
fn = fml_exec_prefix (info, fml, lp, tp);
break;
case FML_CPREFIX:
fn = (*info->prefix) (fml, lp, tp);
- fml_cmd_lex (lp, tp);
break;
default:
fml_cmd_lex (lp, tp);
if (!list)
return NULL;
fml_init_token (&token, fml);
- assert (list);
fml_cmd_lex (&list, &token);
fn1 = fn = fml_sub1 (fml, &list, &token);
+ if (!fn)
+ {
+ fml_del_token (&token, fml);
+ return fn;
+ }
if (fn->p[1] && token.kind != '\0')
{
fn1 = fml_node_alloc (fml);
}
else
{
- fml_node_delete (fml, info->body);
- info->body = NULL;
+ if (info_var->kind == FML_VAR)
+ fml_node_delete (fml, info_var->body);
+ info_var->body = NULL;
}
if (fml->debug & 1)
{
struct fml_node *fn;
fn = fml_sub1 (fml, lp, tp);
- fml_emit (fn);
+ fml_emit (fml, fn);
fml_node_delete (fml, fn);
}
-static struct fml_node *fml_exec_group (struct fml_node *list, Fml fml)
+struct fml_node *fml_exec_group (struct fml_node *list, Fml fml)
{
struct token token;
struct fml_sym_info *info;
while (1)
{
fml_cmd_lex (&list, &token);
- if (token.kind != 't')
+ if (token.kind != 't' && token.kind != 'e')
break;
if (!info->args)
{
case FML_PREFIX:
case FML_CPREFIX:
if (token.separate && !first)
- putchar (' ');
+ (*fml->write_func) (' ');
first = 1;
fml_emit_expr (fml, &list, &token);
fml_node_stat (fml);
pr_indent (-1);
}
continue;
+ case FML_CODE:
+ fml_exec_group (info->body, fml);
+ break;
default:
- printf ("unknown token: `%s'", token.tokenbuf);
+ printf ("<unknown token: `%s'>", token.tokenbuf);
fml_cmd_lex (&list, &token);
}
}
else
{
- printf ("<unknown>");
+ printf ("<unknown %s>", token.tokenbuf);
}
break;
case 't':
-#if 0
- printf ("<token.tokenbuf=%s>", token.tokenbuf);
-#endif
if (token.separate && !first)
- putchar (' ');
+ (*fml->write_func) (' ');
first = 0;
fml_emit_expr (fml, &list, &token);
fml_node_stat (fml);
fml_node_stat (fml);
fml_exec_group (fml->list, fml);
if (fml->debug & 1)
- printf ("\n");
+ putchar ('\n');
}
projects / egate.git / blobdiff