Added some more relational operators (le,ne,ge). Added increment

and decrement operators. Function index changed, so that first
element is 1 - not 0. Function fml_atom_val edited.

diff --git a/fml/fml.c b/fml/fml.c
index 445e8ce..2da1b32 100644 (file)
--- a/fml/fml.c
+++ b/fml/fml.c
@@ -2,8 +2,14 @@
  * FML interpreter. Europagate, 1995
  *
  * $Log: fml.c,v $
- * Revision 1.1  1995/02/06 13:48:09  adam
- * Initial revision
+ * Revision 1.2  1995/02/06 15:23:25  adam
+ * Added some more relational operators (le,ne,ge). Added increment
+ * and decrement operators. Function index changed, so that first
+ * element is 1 - not 0. Function fml_atom_val edited.
+ *
+ * Revision 1.1.1.1  1995/02/06  13:48:10  adam
+ * First version of the FML interpreter. It's slow and memory isn't
+ * freed properly. In particular, the FML nodes aren't released yet.
  *
  */
 #include <assert.h>
@@ -26,6 +32,10 @@ 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);
 #if 0
 static struct fml_node *fml_sub_bad (Fml fml, struct fml_node *list);
 #endif
@@ -41,6 +51,12 @@ 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,
@@ -138,6 +154,23 @@ Fml fml_open (void)
     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;
+
     sym_info = fml_sym_add (fml->sym_tab, "s");
     sym_info->kind = FML_CPREFIX;
     sym_info->prefix = fml_exec_space;
@@ -294,19 +327,12 @@ static struct fml_node *fml_exec_group (struct fml_node *list, Fml fml);
 static void fml_lr_values (struct fml_node *l, int *left_val,
                            struct fml_node *r, int *right_val)
 {
-    static char arg[128];
     if (l->is_atom)
-    {
-        fml_atom_strx (l->p[0], arg, 127);
-        *left_val = atoi (arg);
-    }
+        *left_val = fml_atom_val (l->p[0]);
     else
         *left_val = 0;
     if (r->is_atom)
-    {
-        fml_atom_strx (r->p[0], arg, 127);
-        *right_val = atoi (arg);
-    }
+        *right_val = fml_atom_val (r->p[0]);
     else
         *right_val = 0;
 }
@@ -337,7 +363,7 @@ static struct fml_node *fml_exec_indx (Fml fml, struct fml_node *l,
     if (!l || !r || !r->is_atom)
         return NULL;
     indx = fml_atom_val (r->p[0]);
-    while (--indx >= 0 && list)
+    while (--indx >= 1 && list)
         list = list->p[1];
     if (!list)
         return NULL;
@@ -435,6 +461,57 @@ static struct fml_node *fml_exec_eq (Fml fml, struct fml_node *l,
     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 (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 (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 (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)
@@ -449,6 +526,57 @@ static struct fml_node *fml_exec_nl (Fml fml, struct fml_node **lp,
     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);
+        }
+    }
+    return NULL;
+}
+
 static struct fml_node *fml_exec_prefix (struct fml_sym_info *info, Fml fml,
                                          struct fml_node **lp,
                                          struct token *tp)
@@ -850,14 +978,6 @@ static void fml_emit_expr (Fml fml, struct fml_node **lp, struct token *tp)
 
     fn = fml_sub1 (fml, lp, tp);
     fml_emit (fn);
-#if 0
-    if (fn && fn->is_atom)
-    {
-        char arg[128];
-        fml_atom_strx (fn->p[0], arg, 127);
-        printf ("%s", arg);
-    }
-#endif
 }
 
 static struct fml_node *fml_exec_group (struct fml_node *list, Fml fml)

diff --git a/fml/fmlmem.c b/fml/fmlmem.c
index 4bc4c56..65c1650 100644 (file)
--- a/fml/fmlmem.c
+++ b/fml/fmlmem.c
@@ -2,8 +2,14 @@
  * FML interpreter. Europagate, 1995
  *
  * $Log: fmlmem.c,v $
- * Revision 1.1  1995/02/06 13:48:09  adam
- * Initial revision
+ * Revision 1.2  1995/02/06 15:23:26  adam
+ * Added some more relational operators (le,ne,ge). Added increment
+ * and decrement operators. Function index changed, so that first
+ * element is 1 - not 0. Function fml_atom_val edited.
+ *
+ * Revision 1.1.1.1  1995/02/06  13:48:10  adam
+ * First version of the FML interpreter. It's slow and memory isn't
+ * freed properly. In particular, the FML nodes aren't released yet.
  *
  */
 #include <stdio.h>
@@ -156,10 +162,15 @@ 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];
     assert (a);
-    return atoi (a->buf);
+    if (!a->next)
+        return atoi (a->buf);
+    fml_atom_strx (a, arg, 200);
+    return atoi (arg);
 }
 
 void fml_node_delete (Fml fml, struct fml_node *fn)