fml/fmlarit.c

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