fml/fmllist.c

   1 /*
   2  * Copyright (c) 1995, the EUROPAGATE consortium (see below).
   3  *
   4  * The EUROPAGATE consortium members are:
   5  *
   6  *    University College Dublin
   7  *    Danmarks Teknologiske Videnscenter
   8  *    An Chomhairle Leabharlanna
   9  *    Consejo Superior de Investigaciones Cientificas
  10  *
  11  * Permission to use, copy, modify, distribute, and sell this software and
  12  * its documentation, in whole or in part, for any purpose, is hereby granted,
  13  * provided that:
  14  *
  15  * 1. This copyright and permission notice appear in all copies of the
  16  * software and its documentation. Notices of copyright or attribution
  17  * which appear at the beginning of any file must remain unchanged.
  18  *
  19  * 2. The names of EUROPAGATE or the project partners may not be used to
  20  * endorse or promote products derived from this software without specific
  21  * prior written permission.
  22  *
  23  * 3. Users of this software (implementors and gateway operators) agree to
  24  * inform the EUROPAGATE consortium of their use of the software. This
  25  * information will be used to evaluate the EUROPAGATE project and the
  26  * software, and to plan further developments. The consortium may use
  27  * the information in later publications.
  28  *
  29  * 4. Users of this software agree to make their best efforts, when
  30  * documenting their use of the software, to acknowledge the EUROPAGATE
  31  * consortium, and the role played by the software in their work.
  32  *
  33  * THIS SOFTWARE IS PROVIDED "AS IS" AND WITHOUT WARRANTY OF ANY KIND,
  34  * EXPRESS, IMPLIED, OR OTHERWISE, INCLUDING WITHOUT LIMITATION, ANY
  35  * WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE.
  36  * IN NO EVENT SHALL THE EUROPAGATE CONSORTIUM OR ITS MEMBERS BE LIABLE
  37  * FOR ANY SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL DAMAGES OF
  38  * ANY KIND, OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA
  39  * OR PROFITS, WHETHER OR NOT ADVISED OF THE POSSIBILITY OF DAMAGE, AND
  40  * ON ANY THEORY OF LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE
  41  * USE OR PERFORMANCE OF THIS SOFTWARE.
  42  *
  43  */
  44 /*
  45  * FML interpreter. Europagate, 1995
  46  *
  47  * $Log: fmllist.c,v $
  48  * Revision 1.5  1995/05/16 09:39:33  adam
  49  * LICENSE.
  50  *
  51  * Revision 1.4  1995/02/23  08:32:05  adam
  52  * Changed header.
  53  *
  54  * Revision 1.2  1995/02/10  15:50:55  adam
  55  * MARC interface implemented. Minor bugs fixed. fmltest can
  56  * be used to format single MARC records. New function '\list'
  57  * implemented.
  58  *
  59  * Revision 1.1  1995/02/09  14:33:37  adam
  60  * Split source fml.c and define relevant build-in functions in separate
  61  * files. New operators mult, div, not, llen implemented.
  62  *
  63  */
  64
  65 #include <assert.h>
  66 #include <stdlib.h>
  67 #include <stdio.h>
  68
  69 #include "fmlp.h"
  70
  71 static struct fml_node *fml_exec_indx (Fml fml, struct fml_node *l,
  72                                        struct fml_node *r)
  73 {
  74     struct fml_node *list = l;
  75     struct fml_node *fn;
  76     int indx;
  77
  78     if (!l || !r || !r->is_atom)
  79     {
  80         fml_node_delete (fml, l);
  81         fml_node_delete (fml, r);
  82         return NULL;
  83     }
  84     indx = fml_atom_val (r->p[0]);
  85     fml_node_delete (fml, r);
  86     while (--indx >= 1 && list)
  87         list = list->p[1];
  88     if (!list)
  89         fn = NULL;
  90     else if (list->is_atom)
  91     {
  92         fn = fml_node_alloc (fml);
  93         fn->is_atom = 1;
  94         fn->p[0] = list->p[0];
  95         list->is_atom = 0;
  96         list->p[0] = NULL;
  97     }
  98     else
  99     {
 100         fn = list->p[0];
 101         list->p[0] = NULL;
 102     }
 103     fml_node_delete (fml, l);
 104     return fn;
 105 }
 106
 107 static struct fml_node *fml_exec_len (Fml fml, struct fml_node **lp,
 108                                       struct token *tp)
 109 {
 110     struct fml_node *fn;
 111     int len = 0;
 112     char arg[32];
 113
 114     fml_cmd_lex (lp, tp);
 115     if (tp->kind == 'g')
 116     {
 117         for (fn = tp->sub; fn; fn = fn->p[1])
 118             len++;
 119     }
 120     else if (tp->kind == 'e')
 121     {
 122         struct fml_sym_info *info;
 123
 124         info = fml_sym_lookup (fml->sym_tab, tp->tokenbuf);
 125         assert (info);
 126         for (fn = info->body; fn; fn = fn->p[1])
 127             len++;
 128     }
 129     else
 130         len = 1;
 131
 132     sprintf (arg, "%d", len);
 133     fn = fml_node_alloc (fml);
 134     fn->is_atom = 1;
 135     fn->p[0] = fml_atom_alloc (fml, arg);
 136     fml_cmd_lex (lp, tp);
 137     return fn;
 138 }
 139
 140 static struct fml_node *fml_exec_list (Fml fml, struct fml_node **lp,
 141                                        struct token *tp)
 142 {
 143     struct fml_node *fn = NULL;
 144
 145     fml_cmd_lex (lp, tp);
 146     if (tp->kind == 'g')
 147         fn = fml_node_copy (fml, tp->sub);
 148     else
 149     {
 150         fn = fml_node_alloc (fml);
 151         fn->is_atom = 1;
 152         fn->p[0] = fml_atom_alloc (fml, tp->tokenbuf);
 153     }
 154     fml_cmd_lex (lp, tp);
 155     return fn;
 156 }
 157
 158 void fml_list_init (Fml fml)
 159 {
 160     struct fml_sym_info *sym_info;
 161
 162     sym_info = fml_sym_add (fml->sym_tab, "index");
 163     sym_info->kind = FML_CBINARY;
 164     sym_info->binary = fml_exec_indx;
 165
 166     sym_info = fml_sym_add (fml->sym_tab, "llen");
 167     sym_info->kind = FML_CPREFIX;
 168     sym_info->prefix = fml_exec_len;
 169
 170     sym_info = fml_sym_add (fml->sym_tab, "list");
 171     sym_info->kind = FML_CPREFIX;
 172     sym_info->prefix = fml_exec_list;
 173 }