From: Adam Dickmeiss Date: Mon, 27 Feb 1995 09:01:20 +0000 (+0000) Subject: Regular expression support. Argument passing by name option. New FML X-Git-Url: http://lists.indexdata.com/cgi-bin?a=commitdiff_plain;h=22157698623135d4e8a4910eea084c96b46773db;p=egate.git Regular expression support. Argument passing by name option. New FML function strlen. --- diff --git a/fml/Makefile b/fml/Makefile index 882a2c6..64a38f3 100644 --- a/fml/Makefile +++ b/fml/Makefile @@ -1,13 +1,13 @@ # 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 diff --git a/fml/fml.c b/fml/fml.c index c80c3bf..db3831a 100644 --- a/fml/fml.c +++ b/fml/fml.c @@ -2,7 +2,11 @@ * 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 @@ -207,6 +211,11 @@ void fml_del_token (struct token *tp, Fml fml) 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) @@ -266,7 +275,7 @@ void fml_cmd_lex (struct fml_node **np, struct token *tp) } while (*cp) { - if (*cp == tp->escape_char) + if (*cp == tp->escape_char && esc_stop) { *dst = '\0'; tp->offset = cp - tp->atombuf; @@ -316,7 +325,6 @@ static struct fml_node *fml_exec_space (Fml fml, struct fml_node **lp, (*fml->write_func) ('_'); else (*fml->write_func) (' '); - putchar (' '); return NULL; } @@ -335,7 +343,7 @@ static struct fml_node *fml_exec_prefix (struct fml_sym_info *info, Fml fml, 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) { @@ -346,28 +354,46 @@ static struct fml_node *fml_exec_prefix (struct fml_sym_info *info, Fml fml, 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); @@ -414,13 +440,22 @@ static struct fml_node *fml_sub2 (Fml fml, struct fml_node **lp, if (tp->kind == 'e') { info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf); - assert (info); + if (!info) + { + printf ("<>", 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; @@ -810,7 +845,7 @@ struct fml_node *fml_exec_group (struct fml_node *list, Fml fml) while (1) { fml_cmd_lex (&list, &token); - if (token.kind != 't') + if (token.kind != 't' && token.kind != 'e') break; if (!info->args) { @@ -898,14 +933,17 @@ struct fml_node *fml_exec_group (struct fml_node *list, Fml fml) pr_indent (-1); } continue; + case FML_CODE: + fml_exec_group (info->body, fml); + break; default: - printf ("unknown token: `%s'", token.tokenbuf); + printf ("", token.tokenbuf); fml_cmd_lex (&list, &token); } } else { - printf (""); + printf ("", token.tokenbuf); } break; case 't': diff --git a/fml/fmlmem.c b/fml/fmlmem.c index 3300b20..eabd8ad 100644 --- a/fml/fmlmem.c +++ b/fml/fmlmem.c @@ -2,7 +2,11 @@ * 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 @@ -188,6 +192,21 @@ void fml_atom_strx (struct fml_atom *a, char *str, int max) 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]; diff --git a/fml/fmlp.h b/fml/fmlp.h index d926466..f8c9c7a 100644 --- a/fml/fmlp.h +++ b/fml/fmlp.h @@ -2,7 +2,11 @@ * 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 @@ -64,6 +68,7 @@ struct fml_node *fml_tokenize (Fml fml); 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); @@ -123,6 +128,7 @@ void fml_node_stat (Fml fml); #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); @@ -131,6 +137,7 @@ void fml_str_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, diff --git a/fml/fmlstr.c b/fml/fmlstr.c index b28f69a..c8810a0 100644 --- a/fml/fmlstr.c +++ b/fml/fmlstr.c @@ -2,7 +2,11 @@ * 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 @@ -17,6 +21,130 @@ #include "fmlp.h" +#if USE_GNU_REGEX +#include +#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) { @@ -37,6 +165,8 @@ static struct fml_node *fml_exec_strcmp (Fml fml, struct fml_node **lp, 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); @@ -50,4 +180,12 @@ void fml_str_init (Fml fml) 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 } diff --git a/fml/lists.fml b/fml/lists.fml index 1d82185..2febf65 100644 --- a/fml/lists.fml +++ b/fml/lists.fml @@ -1,6 +1,6 @@ # 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: @@ -15,4 +15,5 @@ Number of days in every month:\n \incr \i } \n -\foreach ost { {feta ost} brie danbo } { \ost\ } +\foreach ost { {feta ost} brie danbo } { \ost\ strlen of \ost\ is +\strlen \ost\ } diff --git a/fml/marc2.fml b/fml/marc2.fml new file mode 100644 index 0000000..5e9d78d --- /dev/null +++ b/fml/marc2.fml @@ -0,0 +1,73 @@ +# 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} } + } } +} +} diff --git a/fml/marc3.fml b/fml/marc3.fml new file mode 100644 index 0000000..6bb5341 --- /dev/null +++ b/fml/marc3.fml @@ -0,0 +1,72 @@ +# 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} } + } } +} +}