fml/fmlarit.c

   1 /*
   2  * FML interpreter. Europagate, 1995
   3  *
   4  * 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 }