Minor changes.
[egate.git] / fml / fmlarit.c
1 /*
2  * FML interpreter. Europagate, 1995
3  *
4  * $Log: fmlarit.c,v $
5  * Revision 1.1  1995/02/09 14:33:36  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_plus (Fml fml, struct fml_node *l,
18                                        struct fml_node *r)
19 {
20     int left_val, right_val;
21
22     fml_lr_values (fml, l, &left_val, r, &right_val);
23     return fml_mk_node_val (fml, left_val + right_val);
24 }
25
26 static struct fml_node *fml_exec_minus (Fml fml, struct fml_node *l,
27                                        struct fml_node *r)
28 {
29     int left_val, right_val;
30
31     fml_lr_values (fml, l, &left_val, r, &right_val);
32     return fml_mk_node_val (fml, left_val - right_val);
33 }
34
35 static struct fml_node *fml_exec_mult (Fml fml, struct fml_node *l,
36                                        struct fml_node *r)
37 {
38     int left_val, right_val;
39
40     fml_lr_values (fml, l, &left_val, r, &right_val);
41     return fml_mk_node_val (fml, left_val * right_val);
42 }
43
44 static struct fml_node *fml_exec_div (Fml fml, struct fml_node *l,
45                                        struct fml_node *r)
46 {
47     int left_val, right_val;
48
49     fml_lr_values (fml, l, &left_val, r, &right_val);
50     return fml_mk_node_val (fml, left_val / right_val);
51 }
52
53 static struct fml_node *fml_exec_incr (Fml fml, struct fml_node **lp, 
54                                        struct token *tp)
55 {
56     struct fml_node *fn = NULL;
57     struct fml_sym_info *info;
58     fml_cmd_lex (lp, tp);
59     if (tp->kind == 'e')
60     {
61         info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
62         assert (info);
63         if (info->kind == FML_VAR && info->body && info->body->is_atom)
64         {
65             char arg[128];
66             int val;
67             
68             val = fml_atom_val (info->body->p[0]);
69             fml_node_delete (fml, info->body);
70             sprintf (arg, "%d", val+1);
71             info->body = fn = fml_node_alloc (fml);
72             fn->is_atom = 1;
73             fn->p[0] = fml_atom_alloc (fml, arg);
74         }
75     }
76     fml_cmd_lex (lp, tp);
77     return NULL;
78 }
79
80 static struct fml_node *fml_exec_decr (Fml fml, struct fml_node **lp, 
81                                        struct token *tp)
82 {
83     struct fml_node *fn = NULL;
84     struct fml_sym_info *info;
85     fml_cmd_lex (lp, tp);
86     if (tp->kind == 'e')
87     {
88         info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
89         assert (info);
90         if (info->kind == FML_VAR && info->body && info->body->is_atom)
91         {
92             char arg[128];
93             int val;
94             
95             val = fml_atom_val (info->body->p[0]);
96             sprintf (arg, "%d", val-1);
97             info->body = fn = fml_node_alloc (fml);
98             fn->is_atom = 1;
99             fn->p[0] = fml_atom_alloc (fml, arg);
100         }
101     }
102     fml_cmd_lex (lp, tp);
103     return NULL;
104 }
105
106 void fml_arit_init (Fml fml)
107 {
108     struct fml_sym_info *sym_info;
109
110     sym_info = fml_sym_add (fml->sym_tab, "plus");
111     sym_info->kind = FML_CBINARY;
112     sym_info->binary = fml_exec_plus;
113     sym_info = fml_sym_add (fml->sym_tab, "minus");
114     sym_info->kind = FML_CBINARY;
115     sym_info->binary = fml_exec_minus;
116
117     sym_info = fml_sym_add (fml->sym_tab, "mult");
118     sym_info->kind = FML_CBINARY;
119     sym_info->binary = fml_exec_mult;
120     sym_info = fml_sym_add (fml->sym_tab, "div");
121     sym_info->kind = FML_CBINARY;
122     sym_info->binary = fml_exec_div;
123
124     sym_info = fml_sym_add (fml->sym_tab, "incr");
125     sym_info->kind = FML_CPREFIX;
126     sym_info->prefix = fml_exec_incr;
127     sym_info = fml_sym_add (fml->sym_tab, "decr");
128     sym_info->kind = FML_CPREFIX;
129     sym_info->prefix = fml_exec_decr;
130 }