function strlen.
# FML interpreter. Europagate, 1995
#
-# $Id: Makefile,v 1.11 1995/02/23 08:32:03 adam Exp $
+# $Id: Makefile,v 1.12 1995/02/27 09:01:20 adam Exp $
SHELL=/bin/sh
INCLUDE=-I../include -I.
TPROG1=fmltest
-CFLAGS=-g -Wall -pedantic
+CFLAGS=-g -Wall -pedantic
CPP=$(CC) -E
-DEFS=$(INCLUDE)
+DEFS=$(INCLUDE) -DUSE_GNU_REGEX=1
LIB=../lib/fml.a
PO = fmltoken.o fmlmem.o fml.o fmlsym.o fmlrel.o fmlarit.o fmllist.o \
fmlcall.o fmlcalls.o fmlmarc.o fmlstr.o
* FML interpreter. Europagate, 1995
*
* $Log: fml.c,v $
- * Revision 1.14 1995/02/23 08:32:04 adam
+ * 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
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;
(*fml->write_func) ('_');
else
(*fml->write_func) (' ');
- putchar (' ');
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);
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;
while (1)
{
fml_cmd_lex (&list, &token);
- if (token.kind != 't')
+ if (token.kind != 't' && token.kind != 'e')
break;
if (!info->args)
{
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':
* FML interpreter. Europagate, 1995
*
* $Log: fmlmem.c,v $
- * Revision 1.8 1995/02/23 08:32:05 adam
+ * Revision 1.9 1995/02/27 09:01:20 adam
+ * Regular expression support. Argument passing by name option. New FML
+ * function strlen.
+ *
+ * Revision 1.8 1995/02/23 08:32:05 adam
* Changed header.
*
* Revision 1.6 1995/02/10 18:15:52 adam
str[len+FML_ATOM_BUF-1] = '\0';
}
+int fml_atom_len (struct fml_atom *a)
+{
+ int len = 0;
+ if (a)
+ {
+ while (a->next)
+ {
+ len += FML_ATOM_BUF;
+ a = a->next;
+ }
+ len += strlen (a->buf);
+ }
+ return len;
+}
+
int fml_atom_val (struct fml_atom *a)
{
static char arg[256];
* FML interpreter. Europagate, 1995
*
* $Log: fmlp.h,v $
- * Revision 1.10 1995/02/23 08:32:06 adam
+ * Revision 1.11 1995/02/27 09:01:21 adam
+ * Regular expression support. Argument passing by name option. New FML
+ * function strlen.
+ *
+ * Revision 1.10 1995/02/23 08:32:06 adam
* Changed header.
*
* Revision 1.8 1995/02/10 18:15:52 adam
struct fml_node *fml_node_alloc (Fml fml);
struct fml_atom *fml_atom_alloc (Fml fml, char *str);
int fml_atom_str (struct fml_atom *a, char *str);
+int fml_atom_len (struct fml_atom *a);
void fml_atom_strx (struct fml_atom *a, char *str, int max);
int fml_atom_val (struct fml_atom *a);
void fml_node_delete (Fml fml, struct fml_node *fn);
#define FML_CPREFIX 11
#define FML_BINARY 12
#define FML_BIN 13
+#define FML_CODE 14
void fml_rel_init (Fml fml);
void fml_arit_init (Fml fml);
void fml_lr_values (Fml fml, struct fml_node *l, int *left_val,
struct fml_node *r, int *right_val);
void fml_cmd_lex (struct fml_node **np, struct token *tp);
+void fml_cmd_lex_s (struct fml_node **np, struct token *tp, int esc_stop);
void fml_init_token (struct token *tp, Fml fml);
void fml_del_token (struct token *tp, Fml fml);
struct fml_node *fml_expr_term (Fml fml, struct fml_node **lp,
* FML interpreter. Europagate, 1995
*
* $Log: fmlstr.c,v $
- * Revision 1.3 1995/02/23 08:32:06 adam
+ * Revision 1.4 1995/02/27 09:01:21 adam
+ * Regular expression support. Argument passing by name option. New FML
+ * function strlen.
+ *
+ * Revision 1.3 1995/02/23 08:32:06 adam
* Changed header.
*
* Revision 1.1 1995/02/10 18:15:53 adam
#include "fmlp.h"
+#if USE_GNU_REGEX
+#include <regex.h>
+#endif
+
+#if USE_GNU_REGEX
+struct reg_cache {
+ struct re_pattern_buffer buf;
+ char *pattern;
+ struct reg_cache *next;
+};
+
+static int no_in_use = 0;
+static struct reg_cache *reg_cache_list = NULL;
+
+struct reg_cache *fml_reg_compile (const char *pattern)
+{
+ struct reg_cache *list, *last = NULL;
+ for (list = reg_cache_list; list; list = list->next)
+ {
+ if (!strcmp (pattern, list->pattern))
+ return list;
+ last = list;
+ }
+ if (no_in_use >= 20)
+ {
+ for (list = reg_cache_list; list->next->next; list = list->next)
+ ;
+ free (list->next->pattern);
+ regfree (&list->next->buf);
+ free (list->next);
+ list->next = NULL;
+ }
+ else
+ no_in_use++;
+ list = malloc (sizeof (*list));
+ assert (list);
+ list->next = reg_cache_list;
+ reg_cache_list = list;
+ list->pattern = malloc (strlen(pattern)+1);
+ assert (list->pattern);
+ strcpy (list->pattern, pattern);
+
+ re_syntax_options = RE_SYNTAX_GREP;
+ list->buf.translate = NULL;
+ list->buf.fastmap = NULL;
+ list->buf.buffer = NULL;
+ list->buf.allocated = 0;
+ re_compile_pattern (pattern, strlen(pattern), &list->buf);
+ return list;
+}
+
+static int fml_reg_match (struct reg_cache *reg_pat, const char *str)
+{
+ int ret, len = strlen (str);
+
+ ret = re_match (®_pat->buf, str, len, 0, NULL);
+ if (ret == len)
+ return 1;
+ return 0;
+}
+
+#endif
+
+static struct fml_node *fml_exec_match (Fml fml, struct fml_node **lp,
+ struct token *tp)
+{
+ struct reg_cache *reg;
+ struct fml_node *fn;
+ const char *cp;
+ char pattern[128];
+ char sstring[128];
+
+ fml_cmd_lex (lp, tp);
+ if (tp->kind == 't')
+ {
+ cp = tp->tokenbuf;
+ fml_cmd_lex (lp, tp);
+ }
+ else
+ {
+ fn = fml_expr_term (fml, lp, tp);
+ if (!fn->is_atom)
+ {
+ fml_node_delete (fml, fn);
+ return NULL;
+ }
+ fml_atom_str (fn->p[0], pattern);
+ fml_node_delete (fml, fn);
+ cp = pattern;
+ }
+ reg = fml_reg_compile (cp);
+ fn = fml_expr_term (fml, lp, tp);
+ if (!fn->is_atom)
+ {
+ fml_node_delete (fml, fn);
+ return NULL;
+ }
+ fml_atom_str (fn->p[0], sstring);
+ fml_node_delete (fml, fn);
+ if (fml_reg_match (reg, sstring))
+ return fml_mk_node_val (fml, 1);
+ return NULL;
+}
+
+static struct fml_node *fml_exec_strlen (Fml fml, struct fml_node **lp,
+ struct token *tp)
+{
+ struct fml_node *fn;
+ int len = 0;
+
+ fml_cmd_lex (lp, tp);
+ fn = fml_expr_term (fml, lp, tp);
+ while (fn)
+ {
+ if (fn->is_atom)
+ len += fml_atom_len (fn->p[0]);
+ fn = fn->p[1];
+ if (fn)
+ len++;
+ }
+ fml_node_delete (fml, fn);
+ return fml_mk_node_val (fml, len);
+}
+
static struct fml_node *fml_exec_strcmp (Fml fml, struct fml_node **lp,
struct token *tp)
{
arg = "1";
else
arg = "-1";
+ fml_node_delete (fml, fn1);
+ fml_node_delete (fml, fn2);
fn = fml_node_alloc (fml);
fn->is_atom = 1;
fn->p[0] = fml_atom_alloc (fml, arg);
sym_info = fml_sym_add (fml->sym_tab, "strcmp");
sym_info->kind = FML_CPREFIX;
sym_info->prefix = fml_exec_strcmp;
+ sym_info = fml_sym_add (fml->sym_tab, "strlen");
+ sym_info->kind = FML_CPREFIX;
+ sym_info->prefix = fml_exec_strlen;
+#if USE_GNU_REGEX
+ sym_info = fml_sym_add (fml->sym_tab, "match");
+ sym_info->kind = FML_CPREFIX;
+ sym_info->prefix = fml_exec_match;
+#endif
}
# FML list inspection
#
-# $Id: lists.fml,v 1.5 1995/02/23 08:32:07 adam Exp $
+# $Id: lists.fml,v 1.6 1995/02/27 09:01:21 adam Exp $
\set months {Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec}
\set days {31 28 31 30 31 30 31 31 30 31 30 31}
Number of months:
\incr \i
}
\n
-\foreach ost { {feta ost} brie danbo } { \ost\ }
+\foreach ost { {feta ost} brie danbo } { \ost\ strlen of \ost\ is
+\strlen \ost\ }
--- /dev/null
+# FML marc rutines - with passing of code.
+#
+# $Id: marc2.fml,v 1.1 1995/02/27 09:01:21 adam Exp $
+\func case tag indicator identifier \code {
+ \if {{\strcmp \tag \line\index 1}\eq 0} {
+ \if {{\strcmp \indicator \line\index 2}\eq 0} {
+ \foreach field {\line \index 3} {
+ \if{{\strcmp \identifier \field\index 1}\eq 0}
+ {
+ \set info {\field \index 2}
+ \code
+ }
+ }
+ } }
+}
+
+\func marc rec \code {
+ \foreach line {\rec} {\code}
+}
+
+\func testfmt record {
+ \marc {\record} {
+ \case 245 00 a { 24500a: \info\n }
+ \case 100 00 b { 10000b: \info\n }
+ \case 101 00 x { }
+ \case 102 00 x { }
+ \case 103 00 x { }
+ \case 104 00 x { }
+ \case 105 00 x { }
+ \case 106 00 x { }
+ }
+}
+
+\foreach i {1 2 3 4 5 6 7 8 9 10}
+{
+\testfmt \list {
+ { 008 00 {
+ { b {a b c d e f} }
+ { c {a b c d e f} }
+ } }
+ { 100 00 {
+ { b {Felt 100-b} }
+ { c {felt 100-c} }
+ } }
+ { 245 00 {
+ { a {Felt 245-x} }
+ } }
+ { 260 00 {
+ { b {Felt 100-b} }
+ { c {felt 100-c} }
+ } }
+ { 970 00 {
+ { b {Felt 100-b} }
+ { c {felt 100-c} }
+ } }
+ { 971 00 {
+ { b {Felt 100-b} }
+ { c {felt 100-c} }
+ } }
+ { 972 00 {
+ { b {Felt 100-b} }
+ { c {felt 100-c} }
+ } }
+ { 973 00 {
+ { b {Felt 100-b} }
+ { c {felt 100-c} }
+ } }
+ { 974 00 {
+ { b {Felt 100-b} }
+ { c {felt 100-c} }
+ } }
+}
+}
--- /dev/null
+# FML marc rutines - with passing of code and regular expressions
+#
+# $Id: marc3.fml,v 1.1 1995/02/27 09:01:21 adam Exp $
+\func case tag indicator identifier \code {
+ \if {\match \tag {\line\index 1}} {
+ \if {\match \indicator {\line\index 2}} {
+ \foreach field {\line \index 3} {
+ \if{\match \identifier \field\index 1} {
+ \set info {\field \index 2}
+ \code
+ }
+ }
+ } }
+}
+
+\func marc rec \code {
+ \foreach line {\rec} {\code}
+}
+
+\func testfmt record {
+ \marc {\record} {
+ \case 245 00 a { 245 00 a: \info\n }
+ \case 100 00 [bc] { 100 00 [bc]: \info\n }
+ \case 101 00 x { }
+ \case 102 00 x { }
+ \case 103 00 x { }
+ \case 104 00 x { }
+ \case 105 00 x { }
+ \case 106 00 x { }
+ }
+}
+
+\foreach i {1 2 3 4 5 6 7 8 9 10}
+{
+\testfmt \list {
+ { 008 00 {
+ { b {a b c d e f} }
+ { c {a b c d e f} }
+ } }
+ { 100 00 {
+ { b {Felt 100-b} }
+ { c {felt 100-c} }
+ } }
+ { 245 00 {
+ { a {Felt 245-x} }
+ } }
+ { 260 00 {
+ { b {Felt 100-b} }
+ { c {felt 100-c} }
+ } }
+ { 970 00 {
+ { b {Felt 100-b} }
+ { c {felt 100-c} }
+ } }
+ { 971 00 {
+ { b {Felt 100-b} }
+ { c {felt 100-c} }
+ } }
+ { 972 00 {
+ { b {Felt 100-b} }
+ { c {felt 100-c} }
+ } }
+ { 973 00 {
+ { b {Felt 100-b} }
+ { c {felt 100-c} }
+ } }
+ { 974 00 {
+ { b {Felt 100-b} }
+ { c {felt 100-c} }
+ } }
+}
+}
projects / egate.git / commitdiff