fml/fmllist.c

   1 /*
   2  * FML interpreter. Europagate, 1995
   3  *
   4  * fmllist.c,v
   5  * Revision 1.2  1995/02/10  15:50:55  adam
   6  * MARC interface implemented. Minor bugs fixed. fmltest can
   7  * be used to format single MARC records. New function '\list'
   8  * implemented.
   9  *
  10  * Revision 1.1  1995/02/09  14:33:37  adam
  11  * Split source fml.c and define relevant build-in functions in separate
  12  * files. New operators mult, div, not, llen implemented.
  13  *
  14  */
  15
  16 #include <assert.h>
  17 #include <stdlib.h>
  18 #include <stdio.h>
  19
  20 #include "fmlp.h"
  21
  22 static struct fml_node *fml_exec_indx (Fml fml, struct fml_node *l,
  23                                        struct fml_node *r)
  24 {
  25     struct fml_node *list = l;
  26     struct fml_node *fn;
  27     int indx;
  28
  29     if (!l || !r || !r->is_atom)
  30     {
  31         fml_node_delete (fml, l);
  32         fml_node_delete (fml, r);
  33         return NULL;
  34     }
  35     indx = fml_atom_val (r->p[0]);
  36     fml_node_delete (fml, r);
  37     while (--indx >= 1 && list)
  38         list = list->p[1];
  39     if (!list)
  40         fn = NULL;
  41     else if (list->is_atom)
  42     {
  43         fn = fml_node_alloc (fml);
  44         fn->is_atom = 1;
  45         fn->p[0] = list->p[0];
  46         list->is_atom = 0;
  47         list->p[0] = NULL;
  48     }
  49     else
  50     {
  51         fn = list->p[0];
  52         list->p[0] = NULL;
  53     }
  54     fml_node_delete (fml, l);
  55     return fn;
  56 }
  57
  58 static struct fml_node *fml_exec_len (Fml fml, struct fml_node **lp,
  59                                       struct token *tp)
  60 {
  61     struct fml_node *fn;
  62     int len = 0;
  63     char arg[32];
  64
  65     fml_cmd_lex (lp, tp);
  66     if (tp->kind == 'g')
  67     {
  68         for (fn = tp->sub; fn; fn = fn->p[1])
  69             len++;
  70     }
  71     else if (tp->kind == 'e')
  72     {
  73         struct fml_sym_info *info;
  74
  75         info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
  76         assert (info);
  77         for (fn = info->body; fn; fn = fn->p[1])
  78             len++;
  79     }
  80     else
  81         len = 1;
  82
  83     sprintf (arg, "%d", len);
  84     fn = fml_node_alloc (fml);
  85     fn->is_atom = 1;
  86     fn->p[0] = fml_atom_alloc (fml, arg);
  87     fml_cmd_lex (lp, tp);
  88     return fn;
  89 }
  90
  91 static struct fml_node *fml_exec_list (Fml fml, struct fml_node **lp,
  92                                        struct token *tp)
  93 {
  94     struct fml_node *fn = NULL;
  95
  96     fml_cmd_lex (lp, tp);
  97     if (tp->kind == 'g')
  98         fn = fml_node_copy (fml, tp->sub);
  99     else
 100     {
 101         fn = fml_node_alloc (fml);
 102         fn->is_atom = 1;
 103         fn->p[0] = fml_atom_alloc (fml, tp->tokenbuf);
 104     }
 105     fml_cmd_lex (lp, tp);
 106     return fn;
 107 }
 108
 109 void fml_list_init (Fml fml)
 110 {
 111     struct fml_sym_info *sym_info;
 112
 113     sym_info = fml_sym_add (fml->sym_tab, "index");
 114     sym_info->kind = FML_CBINARY;
 115     sym_info->binary = fml_exec_indx;
 116
 117     sym_info = fml_sym_add (fml->sym_tab, "llen");
 118     sym_info->kind = FML_CPREFIX;
 119     sym_info->prefix = fml_exec_len;
 120
 121     sym_info = fml_sym_add (fml->sym_tab, "list");
 122     sym_info->kind = FML_CPREFIX;
 123     sym_info->prefix = fml_exec_list;
 124 }