Added model summary and R keyword
[pspp] / src / vars-atr.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 #include "var.h"
22 #include "error.h"
23 #include <stdlib.h>
24 #include "alloc.h"
25 #include "command.h"
26 #include "dictionary.h"
27 #include "do-ifP.h"
28 #include "expressions/public.h"
29 #include "file-handle.h"
30 #include "hash.h"
31 #include "lexer.h"
32 #include "misc.h"
33 #include "str.h"
34 #include "value-labels.h"
35 #include "vfm.h"
36
37 #include "gettext.h"
38 #define _(msgid) gettext (msgid)
39
40 #include "debug-print.h"
41
42 /* Assign auxiliary data AUX to variable V, which must not
43    already have auxiliary data.  Before V's auxiliary data is
44    cleared, AUX_DTOR(V) will be called. */
45 void *
46 var_attach_aux (struct variable *v,
47                 void *aux, void (*aux_dtor) (struct variable *)) 
48 {
49   assert (v->aux == NULL);
50   assert (aux != NULL);
51   v->aux = aux;
52   v->aux_dtor = aux_dtor;
53   return aux;
54 }
55
56 /* Remove auxiliary data, if any, from V, and returns it, without
57    calling any associated destructor. */
58 void *
59 var_detach_aux (struct variable *v) 
60 {
61   void *aux = v->aux;
62   assert (aux != NULL);
63   v->aux = NULL;
64   return aux;
65 }
66
67 /* Clears auxiliary data, if any, from V, and calls any
68    associated destructor. */
69 void
70 var_clear_aux (struct variable *v) 
71 {
72   assert (v != NULL);
73   if (v->aux != NULL) 
74     {
75       if (v->aux_dtor != NULL)
76         v->aux_dtor (v);
77       v->aux = NULL;
78     }
79 }
80
81 /* This function is appropriate for use an auxiliary data
82    destructor (passed as AUX_DTOR to var_attach_aux()) for the
83    case where the auxiliary data should be passed to free(). */
84 void
85 var_dtor_free (struct variable *v) 
86 {
87   free (v->aux);
88 }
89
90 /* Compares A and B, which both have the given WIDTH, and returns
91    a strcmp()-type result. */
92 int
93 compare_values (const union value *a, const union value *b, int width) 
94 {
95   if (width == 0) 
96     return a->f < b->f ? -1 : a->f > b->f;
97   else
98     return memcmp (a->s, b->s, min(MAX_SHORT_STRING, width));
99 }
100
101 /* Create a hash of v */
102 unsigned 
103 hash_value(const union value  *v, int width)
104 {
105   unsigned id_hash;
106
107   if ( 0 == width ) 
108     id_hash = hsh_hash_double (v->f);
109   else
110     id_hash = hsh_hash_bytes (v->s, min(MAX_SHORT_STRING, width));
111
112   return id_hash;
113 }
114
115
116
117 /* Discards all the current state in preparation for a data-input
118    command like DATA LIST or GET. */
119 void
120 discard_variables (void)
121 {
122   dict_clear (default_dict);
123   default_handle = NULL;
124
125   n_lag = 0;
126   
127   if (vfm_source != NULL)
128     {
129       free_case_source (vfm_source);
130       vfm_source = NULL;
131     }
132
133   cancel_transformations ();
134
135   ctl_stack = NULL;
136
137   expr_free (process_if_expr);
138   process_if_expr = NULL;
139
140   cancel_temporary ();
141
142   pgm_state = STATE_INIT;
143 }
144 \f
145 /* Returns true if NAME is an acceptable name for a variable,
146    false otherwise.  If ISSUE_ERROR is true, issues an
147    explanatory error message on failure. */
148 bool
149 var_is_valid_name (const char *name, bool issue_error) 
150 {
151   size_t length, i;
152   
153   assert (name != NULL);
154
155   length = strlen (name);
156   if (length < 1) 
157     {
158       if (issue_error)
159         msg (SE, _("Variable name cannot be empty string."));
160       return false;
161     }
162   else if (length > LONG_NAME_LEN) 
163     {
164       if (issue_error)
165         msg (SE, _("Variable name %s exceeds %d-character limit."),
166              name, (int) LONG_NAME_LEN);
167       return false;
168     }
169
170   for (i = 0; i < length; i++)
171     if (!CHAR_IS_IDN (name[i])) 
172       {
173         if (issue_error)
174           msg (SE, _("Character `%c' (in %s) may not appear in "
175                      "a variable name."),
176                name[i], name);
177         return false;
178       }
179         
180   if (!CHAR_IS_ID1 (name[0]))
181     {
182       if (issue_error)
183         msg (SE, _("Character `%c' (in %s), may not appear "
184                    "as the first character in a variable name."),
185              name[0], name);
186       return false;
187     }
188
189   if (lex_id_to_token (name, strlen (name)) != T_ID) 
190     {
191       if (issue_error)
192         msg (SE, _("%s may not be used as a variable name because it "
193                    "is a reserved word."), name);
194       return false;
195     }
196
197   return true;
198 }
199
200 /* A hsh_compare_func that orders variables A and B by their
201    names. */
202 int
203 compare_var_names (const void *a_, const void *b_, void *foo UNUSED) 
204 {
205   const struct variable *a = a_;
206   const struct variable *b = b_;
207
208   return strcasecmp (a->name, b->name);
209 }
210
211 /* A hsh_hash_func that hashes variable V based on its name. */
212 unsigned
213 hash_var_name (const void *v_, void *foo UNUSED) 
214 {
215   const struct variable *v = v_;
216
217   return hsh_hash_case_string (v->name);
218 }
219
220 /* A hsh_compare_func that orders pointers to variables A and B
221    by their names. */
222 int
223 compare_var_ptr_names (const void *a_, const void *b_, void *foo UNUSED) 
224 {
225   struct variable *const *a = a_;
226   struct variable *const *b = b_;
227
228   return strcasecmp ((*a)->name, (*b)->name);
229 }
230
231 /* A hsh_hash_func that hashes pointer to variable V based on its
232    name. */
233 unsigned
234 hash_var_ptr_name (const void *v_, void *foo UNUSED) 
235 {
236   struct variable *const *v = v_;
237
238   return hsh_hash_case_string ((*v)->name);
239 }
240 \f
241 /* Sets V's short_name to SHORT_NAME, truncating it to
242    SHORT_NAME_LEN characters and converting it to uppercase in
243    the process. */
244 void
245 var_set_short_name (struct variable *v, const char *short_name) 
246 {
247   assert (v != NULL);
248   assert (short_name[0] == '\0' || var_is_valid_name (short_name, false));
249   
250   str_copy_trunc (v->short_name, sizeof v->short_name, short_name);
251   str_uppercase (v->short_name);
252 }
253
254 /* Clears V's short name. */
255 void
256 var_clear_short_name (struct variable *v) 
257 {
258   assert (v != NULL);
259
260   v->short_name[0] = '\0';
261 }
262
263 /* Sets V's short name to BASE, followed by a suffix of the form
264    _A, _B, _C, ..., _AA, _AB, etc. according to the value of
265    SUFFIX.  Truncates BASE as necessary to fit. */
266 void
267 var_set_short_name_suffix (struct variable *v, const char *base, int suffix)
268 {
269   char string[SHORT_NAME_LEN + 1];
270   char *start, *end;
271   int len, ofs;
272
273   assert (v != NULL);
274   assert (suffix >= 0);
275   assert (strlen (v->short_name) > 0);
276
277   /* Set base name. */
278   var_set_short_name (v, base);
279
280   /* Compose suffix_string. */
281   start = end = string + sizeof string - 1;
282   *end = '\0';
283   do 
284     {
285       *--start = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"[suffix % 26];
286       if (start <= string + 1)
287         msg (SE, _("Variable suffix too large."));
288       suffix /= 26;
289     }
290   while (suffix > 0);
291   *--start = '_';
292
293   /* Append suffix_string to V's short name. */
294   len = end - start;
295   if (len + strlen (v->short_name) > SHORT_NAME_LEN)
296     ofs = SHORT_NAME_LEN - len;
297   else
298     ofs = strlen (v->short_name);
299   strcpy (v->short_name + ofs, start);
300 }