Split source fml.c and define relevant build-in functions in separate
[egate.git] / fml / fmlrel.c
diff --git a/fml/fmlrel.c b/fml/fmlrel.c
new file mode 100644 (file)
index 0000000..26ccc52
--- /dev/null
@@ -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;
+}