fml/fmllist.c

   1 /*
   2  * FML interpreter. Europagate, 1995
   3  *
   4  * $Log: fmllist.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_indx (Fml fml, struct fml_node *l,
  18                                        struct fml_node *r)
  19 {
  20     struct fml_node *list = l;
  21     struct fml_node *fn;
  22     int indx;
  23
  24     if (!l || !r || !r->is_atom)
  25     {
  26         fml_node_delete (fml, l);
  27         fml_node_delete (fml, r);
  28         return NULL;
  29     }
  30     indx = fml_atom_val (r->p[0]);
  31     fml_node_delete (fml, r);
  32     while (--indx >= 1 && list)
  33         list = list->p[1];
  34     if (!list)
  35         fn = NULL;
  36     else if (list->is_atom)
  37     {
  38         fn = fml_node_alloc (fml);
  39         fn->is_atom = 1;
  40         fn->p[0] = list->p[0];
  41         list->is_atom = 0;
  42         list->p[0] = NULL;
  43     }
  44     else
  45     {
  46         fn = list->p[0];
  47         list->p[0] = NULL;
  48     }
  49     fml_node_delete (fml, l);
  50     return fn;
  51 }
  52
  53 static struct fml_node *fml_exec_len (Fml fml, struct fml_node **lp,
  54                                       struct token *tp)
  55 {
  56     struct fml_node *fn;
  57     int len = 0;
  58     char arg[32];
  59
  60     fml_cmd_lex (lp, tp);
  61     if (tp->kind == 'g')
  62     {
  63         for (fn = tp->sub; fn; fn = fn->p[1])
  64             len++;
  65     }
  66     else if (tp->kind == 'e')
  67     {
  68         struct fml_sym_info *info;
  69
  70         info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
  71         assert (info);
  72         for (fn = info->body; fn; fn = fn->p[1])
  73             len++;
  74     }
  75     else
  76         len = 1;
  77
  78     sprintf (arg, "%d", len);
  79     fn = fml_node_alloc (fml);
  80     fn->is_atom = 1;
  81     fn->p[0] = fml_atom_alloc (fml, arg);
  82     fml_cmd_lex (lp, tp);
  83     return fn;
  84 }
  85
  86 void fml_list_init (Fml fml)
  87 {
  88     struct fml_sym_info *sym_info;
  89
  90     sym_info = fml_sym_add (fml->sym_tab, "index");
  91     sym_info->kind = FML_CBINARY;
  92     sym_info->binary = fml_exec_indx;
  93
  94     sym_info = fml_sym_add (fml->sym_tab, "llen");
  95     sym_info->kind = FML_CPREFIX;
  96     sym_info->prefix = fml_exec_len;
  97 }