Minor changes.
[egate.git] / fml / fmlrel.c
1 /*
2  * FML interpreter. Europagate, 1995
3  *
4  * $Log: 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 }