Continue reforming procedure execution. In this phase, move
[pspp-builds.git] / src / language / lexer / variable-parser.c
1 /* PSPP - computes sample statistics.
2    Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
3    Written by Ben Pfaff <blp@gnu.org>.
4
5    This program is free software; you can redistribute it and/or
6    modify it under the terms of the GNU General Public License as
7    published by the Free Software Foundation; either version 2 of the
8    License, or (at your option) any later version.
9
10    This program is distributed in the hope that it will be useful, but
11    WITHOUT ANY WARRANTY; without even the implied warranty of
12    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
13    General Public License for more details.
14
15    You should have received a copy of the GNU General Public License
16    along with this program; if not, write to the Free Software
17    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
18    02110-1301, USA. */
19
20 #include <config.h>
21
22 #include <ctype.h>
23 #include <stdbool.h>
24 #include <stdlib.h>
25
26 #include "lexer.h"
27 #include <data/dictionary.h>
28 #include <data/procedure.h>
29 #include <data/variable.h>
30 #include <libpspp/alloc.h>
31 #include <libpspp/bit-vector.h>
32 #include <libpspp/hash.h>
33 #include <libpspp/message.h>
34 #include <libpspp/misc.h>
35 #include <libpspp/pool.h>
36 #include <libpspp/str.h>
37
38 #include "gettext.h"
39 #define _(msgid) gettext (msgid)
40
41 /* Parses a name as a variable within VS.  Sets *IDX to the
42    variable's index and returns true if successful.  On failure
43    emits an error message and returns false. */
44 static bool
45 parse_vs_variable_idx (const struct var_set *vs, size_t *idx)
46 {
47   assert (idx != NULL);
48   
49   if (token != T_ID)
50     {
51       lex_error (_("expecting variable name"));
52       return false;
53     }
54   else if (var_set_lookup_var_idx (vs, tokid, idx)) 
55     {
56       lex_get ();
57       return true;
58     }
59   else 
60     {
61       msg (SE, _("%s is not a variable name."), tokid);
62       return false;
63     }
64 }
65
66 /* Parses a name as a variable within VS and returns the variable
67    if successful.  On failure emits an error message and returns
68    a null pointer. */
69 static struct variable *
70 parse_vs_variable (const struct var_set *vs)
71 {
72   size_t idx;
73   return parse_vs_variable_idx (vs, &idx) ? var_set_get_var (vs, idx) : NULL;
74 }
75
76 /* Parses a variable name in dictionary D and returns the
77    variable if successful.  On failure emits an error message and
78    returns a null pointer. */
79 struct variable *
80 parse_dict_variable (const struct dictionary *d) 
81 {
82   struct var_set *vs = var_set_create_from_dict (d);
83   struct variable *var = parse_vs_variable (vs);
84   var_set_destroy (vs);
85   return var;
86 }
87
88 /* Parses a variable name in default_dict and returns the
89    variable if successful.  On failure emits an error message and
90    returns a null pointer. */
91 struct variable *
92 parse_variable (void)
93 {
94   return parse_dict_variable (default_dict);
95 }
96
97
98 /* Parses a set of variables from dictionary D given options
99    OPTS.  Resulting list of variables stored in *VAR and the
100    number of variables into *CNT.  Returns nonzero only if
101    successful. */
102 int
103 parse_variables (const struct dictionary *d, struct variable ***var,
104                  size_t *cnt, int opts) 
105 {
106   struct var_set *vs;
107   int success;
108
109   assert (d != NULL);
110   assert (var != NULL);
111   assert (cnt != NULL);
112
113   vs = var_set_create_from_dict (d);
114   success = parse_var_set_vars (vs, var, cnt, opts);
115   if ( success == 0 )
116      free ( *var ) ;
117   var_set_destroy (vs);
118   return success;
119 }
120
121 /* Parses a variable name from VS.  If successful, sets *IDX to
122    the variable's index in VS, *CLASS to the variable's
123    dictionary class, and returns nonzero.  Returns zero on
124    failure. */
125 static int
126 parse_var_idx_class (const struct var_set *vs, size_t *idx,
127                      enum dict_class *class)
128 {
129   if (!parse_vs_variable_idx (vs, idx))
130     return 0;
131
132   *class = dict_class_from_id (var_set_get_var (vs, *idx)->name);
133   return 1;
134 }
135
136 /* Add the variable from VS with index IDX to the list of
137    variables V that has *NV elements and room for *MV.
138    Uses and updates INCLUDED to avoid duplicates if indicated by
139    PV_OPTS, which also affects what variables are allowed in
140    appropriate ways. */
141 static void
142 add_variable (struct variable ***v, size_t *nv, size_t *mv,
143               char *included, int pv_opts,
144               const struct var_set *vs, size_t idx)
145 {
146   struct variable *add = var_set_get_var (vs, idx);
147
148   if ((pv_opts & PV_NUMERIC) && add->type != NUMERIC) 
149     msg (SW, _("%s is not a numeric variable.  It will not be "
150                "included in the variable list."), add->name);
151   else if ((pv_opts & PV_STRING) && add->type != ALPHA) 
152     msg (SE, _("%s is not a string variable.  It will not be "
153                "included in the variable list."), add->name);
154   else if ((pv_opts & PV_NO_SCRATCH)
155            && dict_class_from_id (add->name) == DC_SCRATCH)
156     msg (SE, _("Scratch variables (such as %s) are not allowed "
157                "here."), add->name);
158   else if ((pv_opts & PV_SAME_TYPE) && *nv && add->type != (*v)[0]->type) 
159     msg (SE, _("%s and %s are not the same type.  All variables in "
160                "this variable list must be of the same type.  %s "
161                "will be omitted from list."),
162          (*v)[0]->name, add->name, add->name);
163   else if ((pv_opts & PV_NO_DUPLICATE) && included[idx]) 
164     msg (SE, _("Variable %s appears twice in variable list."), add->name);
165   else 
166     {
167       if (*nv >= *mv)
168         {
169           *mv = 2 * (*nv + 1);
170           *v = xnrealloc (*v, *mv, sizeof **v);
171         }
172
173       if ((pv_opts & PV_DUPLICATE) || !included[idx])
174         {
175           (*v)[(*nv)++] = add;
176           if (!(pv_opts & PV_DUPLICATE))
177             included[idx] = 1;
178         }
179     }
180 }
181
182 /* Adds the variables in VS with indexes FIRST_IDX through
183    LAST_IDX, inclusive, to the list of variables V that has *NV
184    elements and room for *MV.  Uses and updates INCLUDED to avoid
185    duplicates if indicated by PV_OPTS, which also affects what
186    variables are allowed in appropriate ways. */
187 static void
188 add_variables (struct variable ***v, size_t *nv, size_t *mv, char *included,
189                int pv_opts,
190                const struct var_set *vs, int first_idx, int last_idx,
191                enum dict_class class) 
192 {
193   size_t i;
194   
195   for (i = first_idx; i <= last_idx; i++)
196     if (dict_class_from_id (var_set_get_var (vs, i)->name) == class)
197       add_variable (v, nv, mv, included, pv_opts, vs, i);
198 }
199
200 /* Note that if parse_variables() returns 0, *v is free()'d.
201    Conversely, if parse_variables() returns non-zero, then *nv is
202    nonzero and *v is non-NULL. */
203 int
204 parse_var_set_vars (const struct var_set *vs, 
205                     struct variable ***v, size_t *nv,
206                     int pv_opts)
207 {
208   size_t mv;
209   char *included;
210
211   assert (vs != NULL);
212   assert (v != NULL);
213   assert (nv != NULL);
214
215   /* At most one of PV_NUMERIC, PV_STRING, PV_SAME_TYPE may be
216      specified. */
217   assert ((((pv_opts & PV_NUMERIC) != 0)
218            + ((pv_opts & PV_STRING) != 0)
219            + ((pv_opts & PV_SAME_TYPE) != 0)) <= 1);
220
221   /* PV_DUPLICATE and PV_NO_DUPLICATE are incompatible. */
222   assert (!(pv_opts & PV_DUPLICATE) || !(pv_opts & PV_NO_DUPLICATE));
223
224   if (!(pv_opts & PV_APPEND))
225     {
226       *v = NULL;
227       *nv = 0;
228       mv = 0;
229     }
230   else
231     mv = *nv;
232
233   if (!(pv_opts & PV_DUPLICATE))
234     {
235       size_t i;
236       
237       included = xcalloc (var_set_get_cnt (vs), sizeof *included);
238       for (i = 0; i < *nv; i++)
239         included[(*v)[i]->index] = 1;
240     }
241   else
242     included = NULL;
243
244   if (lex_match (T_ALL))
245     add_variables (v, nv, &mv, included, pv_opts,
246                    vs, 0, var_set_get_cnt (vs) - 1, DC_ORDINARY);
247   else 
248     {
249       do
250         {
251           enum dict_class class;
252           size_t first_idx;
253           
254           if (!parse_var_idx_class (vs, &first_idx, &class))
255             goto fail;
256
257           if (!lex_match (T_TO))
258             add_variable (v, nv, &mv, included, pv_opts, vs, first_idx);
259           else 
260             {
261               size_t last_idx;
262               enum dict_class last_class;
263               struct variable *first_var, *last_var;
264
265               if (!parse_var_idx_class (vs, &last_idx, &last_class))
266                 goto fail;
267
268               first_var = var_set_get_var (vs, first_idx);
269               last_var = var_set_get_var (vs, last_idx);
270
271               if (last_idx < first_idx)
272                 {
273                   msg (SE, _("%s TO %s is not valid syntax since %s "
274                              "precedes %s in the dictionary."),
275                        first_var->name, last_var->name,
276                        first_var->name, last_var->name);
277                   goto fail;
278                 }
279
280               if (class != last_class)
281                 {
282                   msg (SE, _("When using the TO keyword to specify several "
283                              "variables, both variables must be from "
284                              "the same variable dictionaries, of either "
285                              "ordinary, scratch, or system variables.  "
286                              "%s is a %s variable, whereas %s is %s."),
287                        first_var->name, dict_class_to_name (class),
288                        last_var->name, dict_class_to_name (last_class));
289                   goto fail;
290                 }
291
292               add_variables (v, nv, &mv, included, pv_opts,
293                              vs, first_idx, last_idx, class);
294             }
295           if (pv_opts & PV_SINGLE)
296             break;
297           lex_match (',');
298         }
299       while (token == T_ID && var_set_lookup_var (vs, tokid) != NULL);
300     }
301   
302   if (*nv == 0)
303     goto fail;
304
305   free (included);
306   return 1;
307
308 fail:
309   free (included);
310   free (*v);
311   *v = NULL;
312   *nv = 0;
313   return 0;
314 }
315
316 /* Extracts a numeric suffix from variable name S, copying it
317    into string R.  Sets *D to the length of R and *N to its
318    value. */
319 static int
320 extract_num (char *s, char *r, int *n, int *d)
321 {
322   char *cp;
323
324   /* Find first digit. */
325   cp = s + strlen (s) - 1;
326   while (isdigit ((unsigned char) *cp) && cp > s)
327     cp--;
328   cp++;
329
330   /* Extract root. */
331   strncpy (r, s, cp - s);
332   r[cp - s] = 0;
333
334   /* Count initial zeros. */
335   *n = *d = 0;
336   while (*cp == '0')
337     {
338       (*d)++;
339       cp++;
340     }
341
342   /* Extract value. */
343   while (isdigit ((unsigned char) *cp))
344     {
345       (*d)++;
346       *n = (*n * 10) + (*cp - '0');
347       cp++;
348     }
349
350   /* Sanity check. */
351   if (*n == 0 && *d == 0)
352     {
353       msg (SE, _("incorrect use of TO convention"));
354       return 0;
355     }
356   return 1;
357 }
358
359 /* Parses a list of variable names according to the DATA LIST version
360    of the TO convention.  */
361 int
362 parse_DATA_LIST_vars (char ***names, size_t *nnames, int pv_opts)
363 {
364   int n1, n2;
365   int d1, d2;
366   int n;
367   size_t nvar, mvar;
368   char name1[LONG_NAME_LEN + 1], name2[LONG_NAME_LEN + 1];
369   char root1[LONG_NAME_LEN + 1], root2[LONG_NAME_LEN + 1];
370   int success = 0;
371
372   assert (names != NULL);
373   assert (nnames != NULL);
374   assert ((pv_opts & ~(PV_APPEND | PV_SINGLE
375                        | PV_NO_SCRATCH | PV_NO_DUPLICATE)) == 0);
376   /* FIXME: PV_NO_DUPLICATE is not implemented. */
377
378   if (pv_opts & PV_APPEND)
379     nvar = mvar = *nnames;
380   else
381     {
382       nvar = mvar = 0;
383       *names = NULL;
384     }
385
386   do
387     {
388       if (token != T_ID)
389         {
390           lex_error ("expecting variable name");
391           goto fail;
392         }
393       if (dict_class_from_id (tokid) == DC_SCRATCH
394           && (pv_opts & PV_NO_SCRATCH))
395         {
396           msg (SE, _("Scratch variables not allowed here."));
397           goto fail;
398         }
399       strcpy (name1, tokid);
400       lex_get ();
401       if (token == T_TO)
402         {
403           lex_get ();
404           if (token != T_ID)
405             {
406               lex_error ("expecting variable name");
407               goto fail;
408             }
409           strcpy (name2, tokid);
410           lex_get ();
411
412           if (!extract_num (name1, root1, &n1, &d1)
413               || !extract_num (name2, root2, &n2, &d2))
414             goto fail;
415
416           if (strcasecmp (root1, root2))
417             {
418               msg (SE, _("Prefixes don't match in use of TO convention."));
419               goto fail;
420             }
421           if (n1 > n2)
422             {
423               msg (SE, _("Bad bounds in use of TO convention."));
424               goto fail;
425             }
426           if (d2 > d1)
427             d2 = d1;
428
429           if (mvar < nvar + (n2 - n1 + 1))
430             {
431               mvar += ROUND_UP (n2 - n1 + 1, 16);
432               *names = xnrealloc (*names, mvar, sizeof **names);
433             }
434
435           for (n = n1; n <= n2; n++)
436             {
437               char name[LONG_NAME_LEN + 1];
438               sprintf (name, "%s%0*d", root1, d1, n);
439               (*names)[nvar] = xstrdup (name);
440               nvar++;
441             }
442         }
443       else
444         {
445           if (nvar >= mvar)
446             {
447               mvar += 16;
448               *names = xnrealloc (*names, mvar, sizeof **names);
449             }
450           (*names)[nvar++] = xstrdup (name1);
451         }
452
453       lex_match (',');
454
455       if (pv_opts & PV_SINGLE)
456         break;
457     }
458   while (token == T_ID);
459   success = 1;
460
461 fail:
462   *nnames = nvar;
463   if (!success)
464     {
465       int i;
466       for (i = 0; i < nvar; i++)
467         free ((*names)[i]);
468       free (*names);
469       *names = NULL;
470       *nnames = 0;
471     }
472   return success;
473 }
474
475 /* Parses a list of variables where some of the variables may be
476    existing and the rest are to be created.  Same args as
477    parse_DATA_LIST_vars(). */
478 int
479 parse_mixed_vars (char ***names, size_t *nnames, int pv_opts)
480 {
481   size_t i;
482
483   assert (names != NULL);
484   assert (nnames != NULL);
485   assert ((pv_opts & ~PV_APPEND) == 0);
486
487   if (!(pv_opts & PV_APPEND))
488     {
489       *names = NULL;
490       *nnames = 0;
491     }
492   while (token == T_ID || token == T_ALL)
493     {
494       if (token == T_ALL || dict_lookup_var (default_dict, tokid) != NULL)
495         {
496           struct variable **v;
497           size_t nv;
498
499           if (!parse_variables (default_dict, &v, &nv, PV_NONE))
500             goto fail;
501           *names = xnrealloc (*names, *nnames + nv, sizeof **names);
502           for (i = 0; i < nv; i++)
503             (*names)[*nnames + i] = xstrdup (v[i]->name);
504           free (v);
505           *nnames += nv;
506         }
507       else if (!parse_DATA_LIST_vars (names, nnames, PV_APPEND))
508         goto fail;
509     }
510   return 1;
511
512 fail:
513   for (i = 0; i < *nnames; i++)
514     free ((*names)[i]);
515   free (*names);
516   *names = NULL;
517   *nnames = 0;
518   return 0;
519 }
520
521 /* Parses a list of variables where some of the variables may be
522    existing and the rest are to be created.  Same args as
523    parse_DATA_LIST_vars(), except that all allocations are taken
524    from the given POOL. */
525 int
526 parse_mixed_vars_pool (struct pool *pool,
527                        char ***names, size_t *nnames, int pv_opts)
528 {
529   int retval = parse_mixed_vars (names, nnames, pv_opts);
530   if (retval)
531     {
532       size_t i;
533
534       for (i = 0; i < *nnames; i++)
535         pool_register (pool, free, (*names)[i]);
536       pool_register (pool, free, *names);
537     }
538   return retval;
539 }
540
541 \f
542 /* A set of variables. */
543 struct var_set 
544   {
545     size_t (*get_cnt) (const struct var_set *);
546     struct variable *(*get_var) (const struct var_set *, size_t idx);
547     bool (*lookup_var_idx) (const struct var_set *, const char *, size_t *);
548     void (*destroy) (struct var_set *);
549     void *aux;
550   };
551
552 /* Returns the number of variables in VS. */
553 size_t
554 var_set_get_cnt (const struct var_set *vs) 
555 {
556   assert (vs != NULL);
557
558   return vs->get_cnt (vs);
559 }
560
561 /* Return variable with index IDX in VS.
562    IDX must be less than the number of variables in VS. */
563 struct variable *
564 var_set_get_var (const struct var_set *vs, size_t idx) 
565 {
566   assert (vs != NULL);
567   assert (idx < var_set_get_cnt (vs));
568
569   return vs->get_var (vs, idx);
570 }
571
572 /* Returns the variable in VS named NAME, or a null pointer if VS
573    contains no variable with that name. */
574 struct variable *
575 var_set_lookup_var (const struct var_set *vs, const char *name) 
576 {
577   size_t idx;
578   return (var_set_lookup_var_idx (vs, name, &idx)
579           ? var_set_get_var (vs, idx)
580           : NULL);
581 }
582
583 /* If VS contains a variable named NAME, sets *IDX to its index
584    and returns true.  Otherwise, returns false. */
585 bool
586 var_set_lookup_var_idx (const struct var_set *vs, const char *name,
587                         size_t *idx)
588 {
589   assert (vs != NULL);
590   assert (name != NULL);
591   assert (strlen (name) <= LONG_NAME_LEN);
592
593   return vs->lookup_var_idx (vs, name, idx);
594 }
595
596 /* Destroys VS. */
597 void
598 var_set_destroy (struct var_set *vs) 
599 {
600   if (vs != NULL)
601     vs->destroy (vs);
602 }
603 \f
604 /* Returns the number of variables in VS. */
605 static size_t
606 dict_var_set_get_cnt (const struct var_set *vs) 
607 {
608   struct dictionary *d = vs->aux;
609
610   return dict_get_var_cnt (d);
611 }
612
613 /* Return variable with index IDX in VS.
614    IDX must be less than the number of variables in VS. */
615 static struct variable *
616 dict_var_set_get_var (const struct var_set *vs, size_t idx) 
617 {
618   struct dictionary *d = vs->aux;
619
620   return dict_get_var (d, idx);
621 }
622
623 /* If VS contains a variable named NAME, sets *IDX to its index
624    and returns true.  Otherwise, returns false. */
625 static bool
626 dict_var_set_lookup_var_idx (const struct var_set *vs, const char *name,
627                              size_t *idx) 
628 {
629   struct dictionary *d = vs->aux;
630   struct variable *v = dict_lookup_var (d, name);
631   if (v != NULL) 
632     {
633       *idx = v->index;
634       return true;
635     }
636   else
637     return false;
638 }
639
640 /* Destroys VS. */
641 static void
642 dict_var_set_destroy (struct var_set *vs) 
643 {
644   free (vs);
645 }
646
647 /* Returns a variable set based on D. */
648 struct var_set *
649 var_set_create_from_dict (const struct dictionary *d) 
650 {
651   struct var_set *vs = xmalloc (sizeof *vs);
652   vs->get_cnt = dict_var_set_get_cnt;
653   vs->get_var = dict_var_set_get_var;
654   vs->lookup_var_idx = dict_var_set_lookup_var_idx;
655   vs->destroy = dict_var_set_destroy;
656   vs->aux = (void *) d;
657   return vs;
658 }
659 \f
660 /* A variable set based on an array. */
661 struct array_var_set 
662   {
663     struct variable *const *var;/* Array of variables. */
664     size_t var_cnt;             /* Number of elements in var. */
665     struct hsh_table *name_tab; /* Hash from variable names to variables. */
666   };
667
668 /* Returns the number of variables in VS. */
669 static size_t
670 array_var_set_get_cnt (const struct var_set *vs) 
671 {
672   struct array_var_set *avs = vs->aux;
673
674   return avs->var_cnt;
675 }
676
677 /* Return variable with index IDX in VS.
678    IDX must be less than the number of variables in VS. */
679 static struct variable *
680 array_var_set_get_var (const struct var_set *vs, size_t idx) 
681 {
682   struct array_var_set *avs = vs->aux;
683
684   return (struct variable *) avs->var[idx];
685 }
686
687 /* If VS contains a variable named NAME, sets *IDX to its index
688    and returns true.  Otherwise, returns false. */
689 static bool
690 array_var_set_lookup_var_idx (const struct var_set *vs, const char *name,
691                               size_t *idx) 
692 {
693   struct array_var_set *avs = vs->aux;
694   struct variable v, *vp, *const *vpp;
695
696   strcpy (v.name, name);
697   vp = &v;
698   vpp = hsh_find (avs->name_tab, &vp);
699   if (vpp != NULL) 
700     {
701       *idx = vpp - avs->var;
702       return true;
703     }
704   else
705     return false;
706 }
707
708 /* Destroys VS. */
709 static void
710 array_var_set_destroy (struct var_set *vs) 
711 {
712   struct array_var_set *avs = vs->aux;
713
714   hsh_destroy (avs->name_tab);
715   free (avs);
716   free (vs);
717 }
718
719 /* Returns a variable set based on the VAR_CNT variables in
720    VAR. */
721 struct var_set *
722 var_set_create_from_array (struct variable *const *var, size_t var_cnt) 
723 {
724   struct var_set *vs;
725   struct array_var_set *avs;
726   size_t i;
727
728   vs = xmalloc (sizeof *vs);
729   vs->get_cnt = array_var_set_get_cnt;
730   vs->get_var = array_var_set_get_var;
731   vs->lookup_var_idx = array_var_set_lookup_var_idx;
732   vs->destroy = array_var_set_destroy;
733   vs->aux = avs = xmalloc (sizeof *avs);
734   avs->var = var;
735   avs->var_cnt = var_cnt;
736   avs->name_tab = hsh_create (2 * var_cnt,
737                               compare_var_ptr_names, hash_var_ptr_name, NULL,
738                               NULL);
739   for (i = 0; i < var_cnt; i++)
740     if (hsh_insert (avs->name_tab, (void *) &var[i]) != NULL) 
741       {
742         var_set_destroy (vs);
743         return NULL;
744       }
745   
746   return vs;
747 }