* FML interpreter. Europagate, 1995
*
* $Log: fml.c,v $
- * Revision 1.4 1995/02/09 13:07:14 adam
+ * 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.
+ *
+ * Revision 1.4 1995/02/09 13:07:14 adam
* Nodes are freed now. Many bugs fixed.
*
* Revision 1.3 1995/02/07 16:09:23 adam
return getchar ();
}
+static void default_write_func (int c)
+{
+ putchar (c);
+}
+
static void default_err_handle (int no)
{
fprintf (stderr, "Error: %d\n", no);
struct token *tp);
static struct fml_node *fml_sub2 (Fml fml, struct fml_node **lp,
struct token *tp);
-
static struct fml_node *fml_exec_space (Fml fml, struct fml_node **lp,
struct token *tp);
static struct fml_node *fml_exec_nl (Fml fml, struct fml_node **lp,
struct token *tp);
-static struct fml_node *fml_exec_incr (Fml fml, struct fml_node **lp,
- struct token *tp);
-static struct fml_node *fml_exec_decr (Fml fml, struct fml_node **lp,
- struct token *tp);
-
-static struct fml_node *fml_exec_plus (Fml fml, struct fml_node *l,
- struct fml_node *r);
-static struct fml_node *fml_exec_minus (Fml fml, struct fml_node *l,
- struct fml_node *r);
-static struct fml_node *fml_exec_gt (Fml fml, struct fml_node *l,
- struct fml_node *r);
-static struct fml_node *fml_exec_lt (Fml fml, struct fml_node *l,
- struct fml_node *r);
-static struct fml_node *fml_exec_eq (Fml fml, struct fml_node *l,
- struct fml_node *r);
-static struct fml_node *fml_exec_ge (Fml fml, struct fml_node *l,
- struct fml_node *r);
-static struct fml_node *fml_exec_le (Fml fml, struct fml_node *l,
- struct fml_node *r);
-static struct fml_node *fml_exec_ne (Fml fml, struct fml_node *l,
- struct fml_node *r);
-static struct fml_node *fml_exec_and (Fml fml, struct fml_node *l,
- struct fml_node *r);
-static struct fml_node *fml_exec_or (Fml fml, struct fml_node *l,
- struct fml_node *r);
-static struct fml_node *fml_exec_indx (Fml fml, struct fml_node *l,
- struct fml_node *r);
static int indent = 0;
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 ();
sym_info = fml_sym_add (fml->sym_tab, "return");
sym_info->kind = FML_RETURN;
-
- sym_info = fml_sym_add (fml->sym_tab, "and");
- sym_info->kind = FML_CBINARY;
- sym_info->binary = fml_exec_and;
- sym_info = fml_sym_add (fml->sym_tab, "or");
- sym_info->kind = FML_CBINARY;
- sym_info->binary = fml_exec_or;
- sym_info = fml_sym_add (fml->sym_tab, "index");
- sym_info->kind = FML_CBINARY;
- sym_info->binary = fml_exec_indx;
-
- sym_info = fml_sym_add (fml->sym_tab, "plus");
- sym_info->kind = FML_CBINARY;
- sym_info->binary = fml_exec_plus;
- sym_info = fml_sym_add (fml->sym_tab, "minus");
- sym_info->kind = FML_CBINARY;
- sym_info->binary = fml_exec_minus;
-
- sym_info = fml_sym_add (fml->sym_tab, "gt");
- sym_info->kind = FML_CBINARY;
- sym_info->binary = fml_exec_gt;
- sym_info = fml_sym_add (fml->sym_tab, "lt");
- sym_info->kind = FML_CBINARY;
- sym_info->binary = fml_exec_lt;
- sym_info = fml_sym_add (fml->sym_tab, "eq");
- sym_info->kind = FML_CBINARY;
- sym_info->binary = fml_exec_eq;
-
- sym_info = fml_sym_add (fml->sym_tab, "ge");
- sym_info->kind = FML_CBINARY;
- sym_info->binary = fml_exec_ge;
- sym_info = fml_sym_add (fml->sym_tab, "le");
- sym_info->kind = FML_CBINARY;
- sym_info->binary = fml_exec_le;
- sym_info = fml_sym_add (fml->sym_tab, "ne");
- sym_info->kind = FML_CBINARY;
- sym_info->binary = fml_exec_ne;
-
- sym_info = fml_sym_add (fml->sym_tab, "incr");
- sym_info->kind = FML_CPREFIX;
- sym_info->prefix = fml_exec_incr;
- sym_info = fml_sym_add (fml->sym_tab, "decr");
- sym_info->kind = FML_CPREFIX;
- sym_info->prefix = fml_exec_decr;
+ 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;
}
-static void fml_init_token (struct token *tp, Fml fml)
+void fml_init_token (struct token *tp, Fml fml)
{
tp->maxbuf = FML_ATOM_BUF*2;
tp->offset = 0;
tp->escape_char = fml->escape_char;
}
-static void fml_del_token (struct token *tp, Fml fml)
+void fml_del_token (struct token *tp, Fml fml)
{
if (tp->maxbuf != FML_ATOM_BUF*2)
free (tp->atombuf);
}
-static void fml_cmd_lex (struct fml_node **np, struct token *tp)
+void fml_cmd_lex (struct fml_node **np, struct token *tp)
{
char *cp;
char *dst;
*np = (*np)->p[1];
}
-static struct fml_node *fml_exec_group (struct fml_node *list, Fml fml);
+struct fml_node *fml_expr_term (Fml fml, struct fml_node **lp,
+ struct token *tp)
+{
+ struct fml_node *fn;
+ if (tp->kind == 'g')
+ {
+ fn = fml_sub0 (fml, tp->sub);
+ fml_cmd_lex (lp, tp);
+ }
+ else
+ fn = fml_sub2 (fml, lp, tp);
+ return fn;
+}
-static void fml_lr_values (Fml fml, struct fml_node *l, int *left_val,
+void fml_lr_values (Fml fml, struct fml_node *l, int *left_val,
struct fml_node *r, int *right_val)
{
if (l && l->is_atom)
fml_node_delete (fml, r);
}
-static struct fml_node *fml_exec_and (Fml fml, struct fml_node *l,
- struct fml_node *r)
-{
- if (l && r)
- {
- fml_node_delete (fml, l);
- return r;
- }
- fml_node_delete (fml, l);
- fml_node_delete (fml, r);
- return NULL;
-}
-
-static struct fml_node *fml_exec_or (Fml fml, struct fml_node *l,
- struct fml_node *r)
-{
- if (r)
- {
- fml_node_delete (fml, l);
- return r;
- }
- return l;
-}
-
-static struct fml_node *fml_exec_indx (Fml fml, struct fml_node *l,
- struct fml_node *r)
-{
- struct fml_node *list = l;
- struct fml_node *fn;
- int indx;
-
- if (!l || !r || !r->is_atom)
- {
- fml_node_delete (fml, l);
- fml_node_delete (fml, r);
- return NULL;
- }
- indx = fml_atom_val (r->p[0]);
- fml_node_delete (fml, r);
- while (--indx >= 1 && list)
- list = list->p[1];
- if (!list)
- fn = NULL;
- else if (list->is_atom)
- {
- fn = fml_node_alloc (fml);
- fn->is_atom = 1;
- fn->p[0] = list->p[0];
- list->is_atom = 0;
- list->p[0] = NULL;
- }
- else
- {
- fn = list->p[0];
- list->p[0] = NULL;
- }
- fml_node_delete (fml, l);
- return fn;
-}
-
-static struct fml_node *fml_exec_plus (Fml fml, struct fml_node *l,
- struct fml_node *r)
-{
- int left_val, right_val;
- char arg[20];
- struct fml_node *fn;
-
- fml_lr_values (fml, l, &left_val, r, &right_val);
- sprintf (arg, "%d", left_val + right_val);
- fn = fml_node_alloc (fml);
- fn->is_atom = 1;
- fn->p[0] = fml_atom_alloc (fml, arg);
- return fn;
-}
-
-static struct fml_node *fml_exec_minus (Fml fml, struct fml_node *l,
- struct fml_node *r)
-{
- int left_val, right_val;
- char arg[20];
- struct fml_node *fn;
-
- fml_lr_values (fml, l, &left_val, r, &right_val);
- sprintf (arg, "%d", left_val - right_val);
- fn = fml_node_alloc (fml);
- fn->is_atom = 1;
- fn->p[0] = fml_atom_alloc (fml, arg);
- return fn;
-}
-
-
-static struct fml_node *fml_exec_gt (Fml fml, struct fml_node *l,
- struct fml_node *r)
-{
- int left_val, right_val;
- struct fml_node *fn;
- fml_lr_values (fml, l, &left_val, r, &right_val);
- if (left_val > right_val)
- {
- fn = fml_node_alloc (fml);
- fn->is_atom = 1;
- fn->p[0] = fml_atom_alloc (fml, "1");
- }
- else
- fn = NULL;
- return fn;
-}
-
-
-static struct fml_node *fml_exec_lt (Fml fml, struct fml_node *l,
- struct fml_node *r)
-{
- int left_val, right_val;
- struct fml_node *fn;
- fml_lr_values (fml, l, &left_val, r, &right_val);
- if (left_val < right_val)
- {
- fn = fml_node_alloc (fml);
- fn->is_atom = 1;
- fn->p[0] = fml_atom_alloc (fml, "1");
- }
- else
- fn = NULL;
- return fn;
-}
-
-static struct fml_node *fml_exec_eq (Fml fml, struct fml_node *l,
- struct fml_node *r)
-{
- int left_val, right_val;
- struct fml_node *fn;
- fml_lr_values (fml, l, &left_val, r, &right_val);
- if (left_val == right_val)
- {
- fn = fml_node_alloc (fml);
- fn->is_atom = 1;
- fn->p[0] = fml_atom_alloc (fml, "1");
- }
- else
- fn = NULL;
- return fn;
-}
-
-static struct fml_node *fml_exec_ne (Fml fml, struct fml_node *l,
- struct fml_node *r)
-{
- int left_val, right_val;
- struct fml_node *fn;
- fml_lr_values (fml, l, &left_val, r, &right_val);
- if (left_val != right_val)
- {
- fn = fml_node_alloc (fml);
- fn->is_atom = 1;
- fn->p[0] = fml_atom_alloc (fml, "1");
- }
- else
- fn = NULL;
- return fn;
-}
-
-static struct fml_node *fml_exec_le (Fml fml, struct fml_node *l,
- struct fml_node *r)
-{
- int left_val, right_val;
- struct fml_node *fn;
- fml_lr_values (fml, l, &left_val, r, &right_val);
- if (left_val <= right_val)
- {
- fn = fml_node_alloc (fml);
- fn->is_atom = 1;
- fn->p[0] = fml_atom_alloc (fml, "1");
- }
- else
- fn = NULL;
- return fn;
-}
-
-static struct fml_node *fml_exec_ge (Fml fml, struct fml_node *l,
- struct fml_node *r)
-{
- int left_val, right_val;
- struct fml_node *fn;
- fml_lr_values (fml, l, &left_val, r, &right_val);
- if (left_val >= right_val)
- {
- fn = fml_node_alloc (fml);
- fn->is_atom = 1;
- fn->p[0] = fml_atom_alloc (fml, "1");
- }
- else
- fn = NULL;
- return fn;
-}
-
-
static struct fml_node *fml_exec_space (Fml fml, struct fml_node **lp,
struct token *tp)
{
- putchar ('_');
+ fml_cmd_lex (lp, tp);
+ if (fml->debug & 1)
+ (*fml->write_func) ('_');
+ else
+ (*fml->write_func) (' ');
+ putchar (' ');
return NULL;
}
static struct fml_node *fml_exec_nl (Fml fml, struct fml_node **lp,
struct token *tp)
{
- putchar ('\n');
- return NULL;
-}
-
-static struct fml_node *fml_exec_incr (Fml fml, struct fml_node **lp,
- struct token *tp)
-{
- struct fml_node *fn = NULL;
- struct fml_sym_info *info;
- fml_cmd_lex (lp, tp);
- if (tp->kind == 'e')
- {
- info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
- assert (info);
- if (info->kind == FML_VAR && info->body && info->body->is_atom)
- {
- char arg[128];
- int val;
-
- val = fml_atom_val (info->body->p[0]);
- fml_node_delete (fml, info->body);
- sprintf (arg, "%d", val+1);
- info->body = fn = fml_node_alloc (fml);
- fn->is_atom = 1;
- fn->p[0] = fml_atom_alloc (fml, arg);
- }
- }
- return NULL;
-}
-
-static struct fml_node *fml_exec_decr (Fml fml, struct fml_node **lp,
- struct token *tp)
-{
- struct fml_node *fn = NULL;
- struct fml_sym_info *info;
fml_cmd_lex (lp, tp);
- if (tp->kind == 'e')
- {
- info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
- assert (info);
- if (info->kind == FML_VAR && info->body && info->body->is_atom)
- {
- char arg[128];
- int val;
-
- val = fml_atom_val (info->body->p[0]);
- sprintf (arg, "%d", val-1);
- info->body = fn = fml_node_alloc (fml);
- fn->is_atom = 1;
- fn->p[0] = fml_atom_alloc (fml, arg);
- }
- }
+ (*fml->write_func) ('\n');
return NULL;
}
}
-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];
}
}
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;
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);
}
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