1 /* PSPP - computes sample statistics.
2 Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
3 Written by Ben Pfaff <blp@gnu.org>.
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.
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.
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., 59 Temple Place - Suite 330, Boston, MA
36 /* Target of a COMPUTE or IF assignment, either a variable or a
38 static struct lvalue *lvalue_parse (void);
39 static int lvalue_get_type (const struct lvalue *);
40 static int lvalue_is_vector (const struct lvalue *);
41 static void lvalue_finalize (struct lvalue *,
42 struct compute_trns *);
43 static void lvalue_destroy (struct lvalue *);
45 /* COMPUTE and IF transformation. */
50 /* Test expression (IF only). */
51 struct expression *test; /* Test expression. */
53 /* Variable lvalue, if variable != NULL. */
54 struct variable *variable; /* Destination variable, if any. */
55 int fv; /* `value' index of destination variable. */
56 int width; /* Lvalue string width; 0=numeric. */
58 /* Vector lvalue, if vector != NULL. */
59 const struct vector *vector; /* Destination vector, if any. */
60 struct expression *element; /* Destination vector element expr. */
63 struct expression *rvalue; /* Rvalue expression. */
66 static int parse_rvalue_expression (struct compute_trns *,
67 const struct lvalue *);
68 static struct compute_trns *compute_trns_create (void);
69 static void compute_trns_free (struct trns_header *);
76 struct lvalue *lvalue = NULL;
77 struct compute_trns *compute = NULL;
79 lvalue = lvalue_parse ();
83 compute = compute_trns_create ();
85 if (!lex_force_match ('=') || !parse_rvalue_expression (compute, lvalue))
88 lvalue_finalize (lvalue, compute);
90 add_transformation (&compute->h);
95 lvalue_destroy (lvalue);
98 compute_trns_free (&compute->h);
104 /* Transformation functions. */
106 /* Handle COMPUTE or IF with numeric target variable. */
108 compute_num (struct trns_header *compute_, struct ccase *c,
111 struct compute_trns *compute = (struct compute_trns *) compute_;
113 if (compute->test == NULL
114 || expr_evaluate (compute->test, c, case_num, NULL) == 1.0)
116 expr_evaluate (compute->rvalue, c, case_num,
117 case_data_rw (c, compute->fv));
123 /* Handle COMPUTE or IF with numeric vector element target
126 compute_num_vec (struct trns_header *compute_, struct ccase *c,
129 struct compute_trns *compute = (struct compute_trns *) compute_;
131 if (compute->test == NULL
132 || expr_evaluate (compute->test, c, case_num, NULL) == 1.0)
134 /* Index into the vector. */
137 /* Rounded index value. */
140 expr_evaluate (compute->element, c, case_num, &index);
141 rindx = floor (index.f + EPSILON);
142 if (index.f == SYSMIS || rindx < 1 || rindx > compute->vector->cnt)
144 if (index.f == SYSMIS)
145 msg (SW, _("When executing COMPUTE: SYSMIS is not a valid value as "
146 "an index into vector %s."), compute->vector->name);
148 msg (SW, _("When executing COMPUTE: %g is not a valid value as "
149 "an index into vector %s."),
150 index.f, compute->vector->name);
153 expr_evaluate (compute->rvalue, c, case_num,
154 case_data_rw (c, compute->vector->var[rindx - 1]->fv));
160 /* Handle COMPUTE or IF with string target variable. */
162 compute_str (struct trns_header *compute_, struct ccase *c,
165 struct compute_trns *compute = (struct compute_trns *) compute_;
167 if (compute->test == NULL
168 || expr_evaluate (compute->test, c, case_num, NULL) == 1.0)
170 /* Temporary storage for string expression return value. */
173 expr_evaluate (compute->rvalue, c, case_num, &v);
174 st_bare_pad_len_copy (case_data_rw (c, compute->fv)->s,
175 &v.c[1], compute->width, v.c[0]);
181 /* Handle COMPUTE or IF with string vector element target
184 compute_str_vec (struct trns_header *compute_, struct ccase *c,
187 struct compute_trns *compute = (struct compute_trns *) compute_;
189 if (compute->test == NULL
190 || expr_evaluate (compute->test, c, case_num, NULL) == 1.0)
192 /* Temporary storage for string expression return value. */
195 /* Index into the vector. */
198 /* Rounded index value. */
201 /* Variable reference by indexed vector. */
204 expr_evaluate (compute->element, c, case_num, &index);
205 rindx = floor (index.f + EPSILON);
206 if (index.f == SYSMIS || rindx < 1 || rindx > compute->vector->cnt)
208 if (index.f == SYSMIS)
209 msg (SW, _("When executing COMPUTE: SYSMIS is not a valid "
210 "value as an index into vector %s."),
211 compute->vector->name);
213 msg (SW, _("When executing COMPUTE: %g is not a valid value as "
214 "an index into vector %s."),
215 index.f, compute->vector->name);
219 expr_evaluate (compute->rvalue, c, case_num, &v);
220 vr = compute->vector->var[rindx - 1];
221 st_bare_pad_len_copy (case_data_rw (c, vr->fv)->s,
222 &v.c[1], vr->width, v.c[0]);
233 struct compute_trns *compute = NULL;
234 struct lvalue *lvalue = NULL;
236 compute = compute_trns_create ();
238 /* Test expression. */
239 compute->test = expr_parse (EXPR_BOOLEAN);
240 if (compute->test == NULL)
243 /* Lvalue variable. */
244 lvalue = lvalue_parse ();
248 /* Rvalue expression. */
249 if (!lex_force_match ('=') || !parse_rvalue_expression (compute, lvalue))
252 lvalue_finalize (lvalue, compute);
254 add_transformation (&compute->h);
259 lvalue_destroy (lvalue);
262 compute_trns_free (&compute->h);
268 /* Code common to COMPUTE and IF. */
270 /* Checks for type mismatches on transformation C. Also checks for
271 command terminator, sets the case-handling proc from the array
274 parse_rvalue_expression (struct compute_trns *compute,
275 const struct lvalue *lvalue)
277 int type = lvalue_get_type (lvalue);
278 int vector = lvalue_is_vector (lvalue);
280 assert (type == NUMERIC || type == ALPHA);
282 compute->rvalue = expr_parse (type == ALPHA ? EXPR_STRING : EXPR_NUMERIC);
283 if (compute->rvalue == NULL)
287 compute->h.proc = vector ? compute_num_vec : compute_num;
289 compute->h.proc = vector ? compute_str_vec : compute_str;
293 lex_error (_("expecting end of command"));
300 /* Returns a new struct compute_trns after initializing its fields. */
301 static struct compute_trns *
302 compute_trns_create (void)
304 struct compute_trns *compute = xmalloc (sizeof *compute);
305 compute->h.proc = NULL;
306 compute->h.free = compute_trns_free;
307 compute->test = NULL;
308 compute->variable = NULL;
309 compute->vector = NULL;
310 compute->element = NULL;
311 compute->rvalue = NULL;
315 /* Deletes all the fields in COMPUTE. */
317 compute_trns_free (struct trns_header *compute_)
319 struct compute_trns *compute = (struct compute_trns *) compute_;
321 expr_free (compute->test);
322 expr_free (compute->element);
323 expr_free (compute->rvalue);
326 /* COMPUTE or IF target variable or vector element. */
329 char var_name[9]; /* Destination variable name, or "". */
330 const struct vector *vector; /* Destination vector, if any, or NULL. */
331 struct expression *element; /* Destination vector element, or NULL. */
334 /* Parses the target variable or vector elector into a new
335 `struct lvalue', which is returned. */
336 static struct lvalue *
339 struct lvalue *lvalue;
341 lvalue = xmalloc (sizeof *lvalue);
342 lvalue->var_name[0] = '\0';
343 lvalue->vector = NULL;
344 lvalue->element = NULL;
346 if (!lex_force_id ())
349 if (lex_look_ahead () == '(')
352 lvalue->vector = dict_lookup_vector (default_dict, tokid);
353 if (lvalue->vector == NULL)
355 msg (SE, _("There is no vector named %s."), tokid);
359 /* Vector element. */
361 if (!lex_force_match ('('))
363 lvalue->element = expr_parse (EXPR_NUMERIC);
364 if (lvalue->element == NULL)
366 if (!lex_force_match (')'))
372 strncpy (lvalue->var_name, tokid, 8);
373 lvalue->var_name[8] = '\0';
379 lvalue_destroy (lvalue);
383 /* Returns the type (NUMERIC or ALPHA) of the target variable or
386 lvalue_get_type (const struct lvalue *lvalue)
388 if (lvalue->vector == NULL)
391 = dict_lookup_var (default_dict, lvalue->var_name);
398 return lvalue->vector->var[0]->type;
401 /* Returns nonzero if LVALUE has a vector as its target. */
403 lvalue_is_vector (const struct lvalue *lvalue)
405 return lvalue->vector != NULL;
408 /* Finalizes making LVALUE the target of COMPUTE, by creating the
409 target variable if necessary and setting fields in COMPUTE. */
411 lvalue_finalize (struct lvalue *lvalue,
412 struct compute_trns *compute)
414 if (lvalue->vector == NULL)
416 compute->variable = dict_lookup_var (default_dict, lvalue->var_name);
417 if (compute->variable == NULL)
418 compute->variable = dict_create_var_assert (default_dict,
419 lvalue->var_name, 0);
421 compute->fv = compute->variable->fv;
422 compute->width = compute->variable->width;
424 /* Goofy behavior, but compatible: Turn off LEAVE. */
425 if (dict_class_from_id (compute->variable->name) != DC_SCRATCH)
426 compute->variable->reinit = 1;
430 compute->vector = lvalue->vector;
431 compute->element = lvalue->element;
432 lvalue->element = NULL;
435 lvalue_destroy (lvalue);
438 /* Destroys LVALUE. */
440 lvalue_destroy (struct lvalue *lvalue)
442 expr_free (lvalue->element);