Minor changes.
[egate.git] / fml / fmllist.c
1 /*
2  * FML interpreter. Europagate, 1995
3  *
4  * $Log: 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 }