GNU regex location can be specified.

[egate.git] / fml / fml.c

diff --git a/fml/fml.c b/fml/fml.c
index 4eabb90..db3831a 100644 (file)
--- a/fml/fml.c
+++ b/fml/fml.c
@@ -2,7 +2,20 @@
  * FML interpreter. Europagate, 1995
  *
  * $Log: fml.c,v $
- * Revision 1.10  1995/02/21 17:46:08  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
+ * 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
@@ -56,6 +69,11 @@ static int default_read_func (void)
     return getchar ();
 }
 
+static void default_write_func (int c)
+{
+    putchar (c);
+}
+
 static void default_err_handle (int no)
 {
     fprintf (stderr, "Error: %d\n", no);
@@ -109,6 +127,7 @@ Fml fml_open (void)
     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 ();
@@ -192,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)
@@ -251,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;
@@ -297,10 +321,10 @@ static struct fml_node *fml_exec_space (Fml fml, struct fml_node **lp,
                                         struct token *tp)
 {
     fml_cmd_lex (lp, tp);
-    if (fml->debug & 1)
-        putchar ('_');
+    if (fml->debug & 1) 
+        (*fml->write_func) ('_');
     else
-        putchar (' ');
+        (*fml->write_func) (' ');
     return NULL;
 }
 
@@ -308,7 +332,7 @@ static struct fml_node *fml_exec_nl (Fml fml, struct fml_node **lp,
                                      struct token *tp)
 {
     fml_cmd_lex (lp, tp);
-    putchar ('\n');
+    (*fml->write_func) ('\n');
     return NULL;
 }
 
@@ -319,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)
     {
@@ -330,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);
@@ -365,7 +407,7 @@ static struct fml_node *fml_exec_prefix (struct fml_sym_info *info, Fml fml,
 }
 
 
-static void fml_emit (struct fml_node *list)
+static void fml_emit (Fml fml, struct fml_node *list)
 {
     int s = 0;
     while (list)
@@ -374,13 +416,17 @@ static void fml_emit (struct fml_node *list)
         {
             struct fml_atom *a;
             if (s)
-                printf (" ");
+                (*fml->write_func) (' ');
             s++;
             for (a = list->p[0]; a; a=a->next)
-                printf ("%.*s", FML_ATOM_BUF, 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];
     }
 }
@@ -394,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 ("<<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;
@@ -747,7 +802,7 @@ static void fml_emit_expr (Fml fml, struct fml_node **lp, struct token *tp)
     struct fml_node *fn;
 
     fn = fml_sub1 (fml, lp, tp);
-    fml_emit (fn);
+    fml_emit (fml, fn);
     fml_node_delete (fml, fn);
 }
 
@@ -790,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)
                         {
@@ -836,7 +891,7 @@ struct fml_node *fml_exec_group (struct fml_node *list, Fml fml)
                 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);
@@ -878,19 +933,22 @@ 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 ("<unknown token: `%s'>", token.tokenbuf);
                     fml_cmd_lex (&list, &token);
                 }
             }
             else
             {
-                printf ("<unknown>");
+                printf ("<unknown %s>", token.tokenbuf);
             }
             break;
         case 't':
             if (token.separate && !first)
-                putchar (' ');
+                (*fml->write_func) (' ');
             first = 0;
             fml_emit_expr (fml, &list, &token);
             fml_node_stat (fml);