Split source fml.c and define relevant build-in functions in separate

files. New operators mult, div, not, llen implemented.

diff --git a/fml/.depend b/fml/.depend
index 947f7ae..08acf8b 100644 (file)
--- a/fml/.depend
+++ b/fml/.depend
@@ -3,10 +3,25 @@ fml.o : fml.c /usr/include/assert.h /usr/include/stdlib.h /usr/include/features.
   /usr/include/errno.h /usr/include/linux/errno.h /usr/lib/gcc-lib/i486-linux/2.5.8/include/float.h \
   /usr/include/alloca.h /usr/include/stdio.h /usr/include/libio.h /usr/include/_G_config.h \
   fmlp.h fml.h 
+fmlarit.o : fmlarit.c /usr/include/assert.h /usr/include/stdlib.h /usr/include/features.h \
+  /usr/include/sys/cdefs.h /usr/lib/gcc-lib/i486-linux/2.5.8/include/stddef.h \
+  /usr/include/errno.h /usr/include/linux/errno.h /usr/lib/gcc-lib/i486-linux/2.5.8/include/float.h \
+  /usr/include/alloca.h /usr/include/stdio.h /usr/include/libio.h /usr/include/_G_config.h \
+  fmlp.h fml.h 
+fmllist.o : fmllist.c /usr/include/assert.h /usr/include/stdlib.h /usr/include/features.h \
+  /usr/include/sys/cdefs.h /usr/lib/gcc-lib/i486-linux/2.5.8/include/stddef.h \
+  /usr/include/errno.h /usr/include/linux/errno.h /usr/lib/gcc-lib/i486-linux/2.5.8/include/float.h \
+  /usr/include/alloca.h /usr/include/stdio.h /usr/include/libio.h /usr/include/_G_config.h \
+  fmlp.h fml.h 
 fmlmem.o : fmlmem.c /usr/include/stdio.h /usr/include/features.h /usr/include/sys/cdefs.h \
   /usr/include/libio.h /usr/include/_G_config.h /usr/include/stdlib.h /usr/lib/gcc-lib/i486-linux/2.5.8/include/stddef.h \
   /usr/include/errno.h /usr/include/linux/errno.h /usr/lib/gcc-lib/i486-linux/2.5.8/include/float.h \
   /usr/include/alloca.h /usr/include/string.h /usr/include/assert.h fmlp.h fml.h 
+fmlrel.o : fmlrel.c /usr/include/assert.h /usr/include/stdlib.h /usr/include/features.h \
+  /usr/include/sys/cdefs.h /usr/lib/gcc-lib/i486-linux/2.5.8/include/stddef.h \
+  /usr/include/errno.h /usr/include/linux/errno.h /usr/lib/gcc-lib/i486-linux/2.5.8/include/float.h \
+  /usr/include/alloca.h /usr/include/stdio.h /usr/include/libio.h /usr/include/_G_config.h \
+  fmlp.h fml.h 
 fmlsym.o : fmlsym.c /usr/include/stdio.h /usr/include/features.h /usr/include/sys/cdefs.h \
   /usr/include/libio.h /usr/include/_G_config.h /usr/include/stdlib.h /usr/lib/gcc-lib/i486-linux/2.5.8/include/stddef.h \
   /usr/include/errno.h /usr/include/linux/errno.h /usr/lib/gcc-lib/i486-linux/2.5.8/include/float.h \

diff --git a/fml/Makefile b/fml/Makefile
index 519ef31..b9b95e2 100644 (file)
--- a/fml/Makefile
+++ b/fml/Makefile
@@ -1,6 +1,6 @@
 # FML interpreter. Europagate, 1995
 #
-# $Id: Makefile,v 1.1 1995/02/06 13:48:09 adam Exp $
+# $Id: Makefile,v 1.2 1995/02/09 14:33:36 adam Exp $
 
 SHELL=/bin/sh
 INCLUDE=-I../include
@@ -8,7 +8,7 @@ TPROG1=fmltest
 CFLAGS=-g -Wall -pedantic 
 DEFS=$(INCLUDE)
 LIB=fml.a 
-PO = fmltoken.o fmlmem.o fml.o fmlsym.o
+PO = fmltoken.o fmlmem.o fml.o fmlsym.o fmlrel.o fmlarit.o fmllist.o
 CPP=cc -E
 CC=gcc
 

diff --git a/fml/fml.c b/fml/fml.c
index 9a2c6ca..b2eb160 100644 (file)
--- a/fml/fml.c
+++ b/fml/fml.c
@@ -2,7 +2,11 @@
  * FML interpreter. Europagate, 1995
  *
  * $Log: fml.c,v $
- * Revision 1.4  1995/02/09 13:07:14  adam
+ * 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
@@ -41,38 +45,10 @@ static struct fml_node *fml_sub1 (Fml fml, struct fml_node **lp,
                                   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;
 
@@ -136,50 +112,9 @@ Fml fml_open (void)
     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);
 
     sym_info = fml_sym_add (fml->sym_tab, "s");
     sym_info->kind = FML_CPREFIX;
@@ -218,7 +153,7 @@ int fml_preprocess (Fml fml)
 }
 
 
-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;
@@ -227,13 +162,13 @@ static void fml_init_token (struct token *tp, Fml fml)
     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;
@@ -307,9 +242,23 @@ static void fml_cmd_lex (struct fml_node **np, struct token *tp)
     *np = (*np)->p[1];
 }
 
+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 struct fml_node *fml_exec_group (struct fml_node *list, Fml fml);
 
-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)
@@ -324,204 +273,10 @@ static void fml_lr_values (Fml fml, struct fml_node *l, int *left_val,
     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)
 {
+    fml_cmd_lex (lp, tp);
     putchar ('_');
     return NULL;
 }
@@ -529,58 +284,8 @@ static struct fml_node *fml_exec_space (Fml fml, struct fml_node **lp,
 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);
-        }
-    }
+    putchar ('\n');
     return NULL;
 }
 
@@ -1180,5 +885,3 @@ void fml_exec (Fml fml)
     if (fml->debug & 1)
         printf ("\n");
 }
-
-

diff --git a/fml/fmlarit.c b/fml/fmlarit.c
new file mode 100644 (file)
index 0000000..95dbd18
--- /dev/null
+++ b/fml/fmlarit.c
@@ -0,0 +1,130 @@
+/*
+ * FML interpreter. Europagate, 1995
+ *
+ * $Log: fmlarit.c,v $
+ * Revision 1.1  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.
+ *
+ */
+
+#include <assert.h>
+#include <stdlib.h>
+#include <stdio.h>
+
+#include "fmlp.h"
+
+static struct fml_node *fml_exec_plus (Fml fml, struct fml_node *l,
+                                       struct fml_node *r)
+{
+    int left_val, right_val;
+
+    fml_lr_values (fml, l, &left_val, r, &right_val);
+    return fml_mk_node_val (fml, left_val + right_val);
+}
+
+static struct fml_node *fml_exec_minus (Fml fml, struct fml_node *l,
+                                       struct fml_node *r)
+{
+    int left_val, right_val;
+
+    fml_lr_values (fml, l, &left_val, r, &right_val);
+    return fml_mk_node_val (fml, left_val - right_val);
+}
+
+static struct fml_node *fml_exec_mult (Fml fml, struct fml_node *l,
+                                       struct fml_node *r)
+{
+    int left_val, right_val;
+
+    fml_lr_values (fml, l, &left_val, r, &right_val);
+    return fml_mk_node_val (fml, left_val * right_val);
+}
+
+static struct fml_node *fml_exec_div (Fml fml, struct fml_node *l,
+                                       struct fml_node *r)
+{
+    int left_val, right_val;
+
+    fml_lr_values (fml, l, &left_val, r, &right_val);
+    return fml_mk_node_val (fml, left_val / right_val);
+}
+
+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);
+        }
+    }
+    fml_cmd_lex (lp, tp);
+    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_cmd_lex (lp, tp);
+    return NULL;
+}
+
+void fml_arit_init (Fml fml)
+{
+    struct fml_sym_info *sym_info;
+
+    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, "mult");
+    sym_info->kind = FML_CBINARY;
+    sym_info->binary = fml_exec_mult;
+    sym_info = fml_sym_add (fml->sym_tab, "div");
+    sym_info->kind = FML_CBINARY;
+    sym_info->binary = fml_exec_div;
+
+    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;
+}

diff --git a/fml/fmllist.c b/fml/fmllist.c
new file mode 100644 (file)
index 0000000..2d8b7ce
--- /dev/null
+++ b/fml/fmllist.c
@@ -0,0 +1,97 @@
+/*
+ * FML interpreter. Europagate, 1995
+ *
+ * $Log: fmllist.c,v $
+ * Revision 1.1  1995/02/09 14:33:37  adam
+ * Split source fml.c and define relevant build-in functions in separate
+ * files. New operators mult, div, not, llen implemented.
+ *
+ */
+
+#include <assert.h>
+#include <stdlib.h>
+#include <stdio.h>
+
+#include "fmlp.h"
+
+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_len (Fml fml, struct fml_node **lp, 
+                                      struct token *tp)
+{
+    struct fml_node *fn;
+    int len = 0;
+    char arg[32];
+
+    fml_cmd_lex (lp, tp);
+    if (tp->kind == 'g')
+    {
+        for (fn = tp->sub; fn; fn = fn->p[1])
+            len++;
+    }
+    else if (tp->kind == 'e')
+    {
+        struct fml_sym_info *info;
+
+        info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
+        assert (info);
+        for (fn = info->body; fn; fn = fn->p[1])
+            len++;
+    }
+    else 
+        len = 1;
+
+    sprintf (arg, "%d", len);
+    fn = fml_node_alloc (fml);
+    fn->is_atom = 1;
+    fn->p[0] = fml_atom_alloc (fml, arg);
+    fml_cmd_lex (lp, tp);
+    return fn;
+}
+
+void fml_list_init (Fml fml)
+{
+    struct fml_sym_info *sym_info;
+
+    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, "llen");
+    sym_info->kind = FML_CPREFIX;
+    sym_info->prefix = fml_exec_len;
+}

diff --git a/fml/fmlmem.c b/fml/fmlmem.c
index 7d12da0..5ec4a7b 100644 (file)
--- a/fml/fmlmem.c
+++ b/fml/fmlmem.c
@@ -2,7 +2,11 @@
  * FML interpreter. Europagate, 1995
  *
  * $Log: fmlmem.c,v $
- * Revision 1.3  1995/02/09 13:07:15  adam
+ * Revision 1.4  1995/02/09 14:33:37  adam
+ * Split source fml.c and define relevant build-in functions in separate
+ * files. New operators mult, div, not, llen implemented.
+ *
+ * Revision 1.3  1995/02/09  13:07:15  adam
  * Nodes are freed now. Many bugs fixed.
  *
  * Revision 1.2  1995/02/06  15:23:26  adam
@@ -171,7 +175,6 @@ void fml_atom_strx (struct fml_atom *a, char *str, int max)
     str[len+FML_ATOM_BUF-1] = '\0';
 }
 
-
 int fml_atom_val (struct fml_atom *a)
 {
     static char arg[256];
@@ -182,6 +185,18 @@ int fml_atom_val (struct fml_atom *a)
     return atoi (arg);
 }
 
+struct fml_node *fml_mk_node_val (Fml fml, int val)
+{
+    static char arg[64];
+    struct fml_node *fn;
+
+    sprintf (arg, "%d", val);
+    fn = fml_node_alloc (fml);
+    fn->is_atom = 1;
+    fn->p[0] = fml_atom_alloc (fml, arg);
+    return fn;
+}
+
 void fml_node_delete (Fml fml, struct fml_node *fn)
 {
     struct fml_node *f1;

diff --git a/fml/fmlp.h b/fml/fmlp.h
index 8af3fcc..4a77ccf 100644 (file)
--- a/fml/fmlp.h
+++ b/fml/fmlp.h
@@ -2,7 +2,11 @@
  * FML interpreter. Europagate, 1995
  *
  * $Log: fmlp.h,v $
- * Revision 1.3  1995/02/09 13:07:15  adam
+ * Revision 1.4  1995/02/09 14:33:37  adam
+ * Split source fml.c and define relevant build-in functions in separate
+ * files. New operators mult, div, not, llen implemented.
+ *
+ * Revision 1.3  1995/02/09  13:07:15  adam
  * Nodes are freed now. Many bugs fixed.
  *
  * Revision 1.2  1995/02/07  16:09:23  adam
@@ -41,6 +45,7 @@ int fml_atom_val (struct fml_atom *a);
 struct fml_node *fml_mk_list (Fml fml, struct fml_node *fn);
 void fml_node_delete (Fml fml, struct fml_node *fn);
 struct fml_node *fml_node_copy (Fml fml, struct fml_node *fn);
+struct fml_node *fml_mk_node_val (Fml fml, int val);
 
 struct token {
     int             kind;
@@ -95,4 +100,13 @@ void fml_node_stat (Fml fml);
 #define FML_BINARY  12
 #define FML_BIN     13
 
-
+void fml_rel_init (Fml fml);
+void fml_arit_init (Fml fml);
+void fml_list_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_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, 
+                                struct token *tp);

diff --git a/fml/fmlrel.c b/fml/fmlrel.c
new file mode 100644 (file)
index 0000000..26ccc52
--- /dev/null
+++ b/fml/fmlrel.c
@@ -0,0 +1,195 @@
+/*
+ * FML interpreter. Europagate, 1995
+ *
+ * $Log: fmlrel.c,v $
+ * Revision 1.1  1995/02/09 14:33:37  adam
+ * Split source fml.c and define relevant build-in functions in separate
+ * files. New operators mult, div, not, llen implemented.
+ *
+ */
+
+#include <assert.h>
+#include <stdlib.h>
+#include <stdio.h>
+
+#include "fmlp.h"
+
+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_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_not (Fml fml, struct fml_node **lp, 
+                                      struct token *tp)
+{
+    struct fml_node *fn;
+    fml_cmd_lex (lp, tp);
+
+    fn = fml_expr_term (fml, lp, tp);
+    if (fn)
+    {
+        fml_node_delete (fml, fn);
+        return NULL;
+    }
+    fn = fml_node_alloc (fml);
+    fn->is_atom = 1;
+    fn->p[0] = fml_atom_alloc (fml, "1");
+    return fn;
+}
+
+void fml_rel_init (Fml fml)
+{
+    struct fml_sym_info *sym_info;
+
+    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, "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, "not");
+    sym_info->kind = FML_CPREFIX;
+    sym_info->prefix = fml_exec_not;
+}

diff --git a/fml/lists.fml b/fml/lists.fml
index 217179e..6bef8fa 100644 (file)
--- a/fml/lists.fml
+++ b/fml/lists.fml
@@ -1,13 +1,14 @@
 # FML list inspection
 #
-# $Id: lists.fml,v 1.2 1995/02/09 13:07:15 adam Exp $
+# $Id: lists.fml,v 1.3 1995/02/09 14:33:38 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: 
 \foreach m {\months}
   {Month: \m\n}
 \set i 1
 Number of days in every month:\n
-\while {\i \le 12}
+\while {\i \le \llen \months}
 {      
        \months \index \i : \ \days \index \i
        \if {\i \eq 6} {\n} \else {,\ }