fml/fmllist.c

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