fml/fmlrel.c

   1 /*
   2  * FML interpreter. Europagate, 1995
   3  *
   4  * fmlrel.c,v
   5  * Revision 1.1  1995/02/09  14:33:37  adam
   6  * Split source fml.c and define relevant build-in functions in separate
   7  * files. New operators mult, div, not, llen implemented.
   8  *
   9  */
  10
  11 #include <assert.h>
  12 #include <stdlib.h>
  13 #include <stdio.h>
  14
  15 #include "fmlp.h"
  16
  17 static struct fml_node *fml_exec_gt (Fml fml, struct fml_node *l,
  18                                      struct fml_node *r)
  19 {
  20     int left_val, right_val;
  21     struct fml_node *fn;
  22     fml_lr_values (fml, l, &left_val, r, &right_val);
  23     if (left_val > right_val)
  24     {
  25         fn = fml_node_alloc (fml);
  26         fn->is_atom = 1;
  27         fn->p[0] = fml_atom_alloc (fml, "1");
  28     }
  29     else
  30         fn = NULL;
  31     return fn;
  32 }
  33
  34 static struct fml_node *fml_exec_lt (Fml fml, struct fml_node *l,
  35                                      struct fml_node *r)
  36 {
  37     int left_val, right_val;
  38     struct fml_node *fn;
  39     fml_lr_values (fml, l, &left_val, r, &right_val);
  40     if (left_val < right_val)
  41     {
  42         fn = fml_node_alloc (fml);
  43         fn->is_atom = 1;
  44         fn->p[0] = fml_atom_alloc (fml, "1");
  45     }
  46     else
  47         fn = NULL;
  48     return fn;
  49 }
  50
  51 static struct fml_node *fml_exec_eq (Fml fml, struct fml_node *l,
  52                                      struct fml_node *r)
  53 {
  54     int left_val, right_val;
  55     struct fml_node *fn;
  56     fml_lr_values (fml, l, &left_val, r, &right_val);
  57     if (left_val == right_val)
  58     {
  59         fn = fml_node_alloc (fml);
  60         fn->is_atom = 1;
  61         fn->p[0] = fml_atom_alloc (fml, "1");
  62     }
  63     else
  64         fn = NULL;
  65     return fn;
  66 }
  67
  68 static struct fml_node *fml_exec_ne (Fml fml, struct fml_node *l,
  69                                      struct fml_node *r)
  70 {
  71     int left_val, right_val;
  72     struct fml_node *fn;
  73     fml_lr_values (fml, l, &left_val, r, &right_val);
  74     if (left_val != right_val)
  75     {
  76         fn = fml_node_alloc (fml);
  77         fn->is_atom = 1;
  78         fn->p[0] = fml_atom_alloc (fml, "1");
  79     }
  80     else
  81         fn = NULL;
  82     return fn;
  83 }
  84
  85 static struct fml_node *fml_exec_le (Fml fml, struct fml_node *l,
  86                                      struct fml_node *r)
  87 {
  88     int left_val, right_val;
  89     struct fml_node *fn;
  90     fml_lr_values (fml, l, &left_val, r, &right_val);
  91     if (left_val <= right_val)
  92     {
  93         fn = fml_node_alloc (fml);
  94         fn->is_atom = 1;
  95         fn->p[0] = fml_atom_alloc (fml, "1");
  96     }
  97     else
  98         fn = NULL;
  99     return fn;
 100 }
 101
 102 static struct fml_node *fml_exec_ge (Fml fml, struct fml_node *l,
 103                                      struct fml_node *r)
 104 {
 105     int left_val, right_val;
 106     struct fml_node *fn;
 107     fml_lr_values (fml, l, &left_val, r, &right_val);
 108     if (left_val >= right_val)
 109     {
 110         fn = fml_node_alloc (fml);
 111         fn->is_atom = 1;
 112         fn->p[0] = fml_atom_alloc (fml, "1");
 113     }
 114     else
 115         fn = NULL;
 116     return fn;
 117 }
 118
 119 static struct fml_node *fml_exec_and (Fml fml, struct fml_node *l,
 120                                       struct fml_node *r)
 121 {
 122     if (l && r)
 123     {
 124         fml_node_delete (fml, l);
 125         return r;
 126     }
 127     fml_node_delete (fml, l);
 128     fml_node_delete (fml, r);
 129     return NULL;
 130 }
 131
 132 static struct fml_node *fml_exec_or (Fml fml, struct fml_node *l,
 133                                       struct fml_node *r)
 134 {
 135     if (r)
 136     {
 137         fml_node_delete (fml, l);
 138         return r;
 139     }
 140     return l;
 141 }
 142
 143 static struct fml_node *fml_exec_not (Fml fml, struct fml_node **lp,
 144                                       struct token *tp)
 145 {
 146     struct fml_node *fn;
 147     fml_cmd_lex (lp, tp);
 148
 149     fn = fml_expr_term (fml, lp, tp);
 150     if (fn)
 151     {
 152         fml_node_delete (fml, fn);
 153         return NULL;
 154     }
 155     fn = fml_node_alloc (fml);
 156     fn->is_atom = 1;
 157     fn->p[0] = fml_atom_alloc (fml, "1");
 158     return fn;
 159 }
 160
 161 void fml_rel_init (Fml fml)
 162 {
 163     struct fml_sym_info *sym_info;
 164
 165     sym_info = fml_sym_add (fml->sym_tab, "gt");
 166     sym_info->kind = FML_CBINARY;
 167     sym_info->binary = fml_exec_gt;
 168     sym_info = fml_sym_add (fml->sym_tab, "lt");
 169     sym_info->kind = FML_CBINARY;
 170     sym_info->binary = fml_exec_lt;
 171     sym_info = fml_sym_add (fml->sym_tab, "eq");
 172     sym_info->kind = FML_CBINARY;
 173     sym_info->binary = fml_exec_eq;
 174
 175     sym_info = fml_sym_add (fml->sym_tab, "ge");
 176     sym_info->kind = FML_CBINARY;
 177     sym_info->binary = fml_exec_ge;
 178     sym_info = fml_sym_add (fml->sym_tab, "le");
 179     sym_info->kind = FML_CBINARY;
 180     sym_info->binary = fml_exec_le;
 181     sym_info = fml_sym_add (fml->sym_tab, "ne");
 182     sym_info->kind = FML_CBINARY;
 183     sym_info->binary = fml_exec_ne;
 184
 185     sym_info = fml_sym_add (fml->sym_tab, "and");
 186     sym_info->kind = FML_CBINARY;
 187     sym_info->binary = fml_exec_and;
 188     sym_info = fml_sym_add (fml->sym_tab, "or");
 189     sym_info->kind = FML_CBINARY;
 190     sym_info->binary = fml_exec_or;
 191
 192     sym_info = fml_sym_add (fml->sym_tab, "not");
 193     sym_info->kind = FML_CPREFIX;
 194     sym_info->prefix = fml_exec_not;
 195 }