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
25 #include "algorithm.h"
39 /* Lowest precedence. */
40 static int parse_or (union any_node **n);
41 static int parse_and (union any_node **n);
42 static int parse_not (union any_node **n);
43 static int parse_rel (union any_node **n);
44 static int parse_add (union any_node **n);
45 static int parse_mul (union any_node **n);
46 static int parse_neg (union any_node **n);
47 static int parse_exp (union any_node **n);
48 static int parse_primary (union any_node **n);
49 static int parse_function (union any_node **n);
50 /* Highest precedence. */
52 /* Utility functions. */
53 static const char *expr_type_name (int type);
54 static const char *type_name (int type);
55 static void make_bool (union any_node **n);
56 static union any_node *allocate_nonterminal (int op, union any_node *n);
57 static union any_node *append_nonterminal_arg (union any_node *,
59 static int type_check (union any_node **n, int type, int flags);
61 static algo_compare_func compare_functions;
62 static void init_func_tab (void);
65 static void debug_print_tree (union any_node *, int);
69 static void debug_print_postfix (struct expression *);
72 /* Public functions. */
75 expr_free (struct expression *e)
90 expr_parse (int flags)
96 /* Make sure the table of functions is initialized. */
99 /* Parse the expression. */
100 type = parse_or (&n);
101 if (type == EX_ERROR)
104 /* Enforce type rules. */
105 if (!type_check (&n, type, flags))
111 /* Optimize the expression as best we can. */
112 n = (union any_node *) optimize_expression ((struct nonterm_node *) n);
114 /* Dump the tree-based expression to a postfix representation for
115 best evaluation speed, and destroy the tree. */
116 e = xmalloc (sizeof *e);
118 dump_expression (n, e);
121 /* If we're debugging or the user requested it, print the postfix
125 if (flags & PXP_DUMP)
127 debug_print_postfix (e);
134 type_check (union any_node **n, int type, int flags)
136 /* Enforce PXP_BOOLEAN flag. */
137 if (flags & PXP_BOOLEAN)
139 if (type == EX_STRING)
141 msg (SE, _("A string expression was supplied in a place "
142 "where a Boolean expression was expected."));
145 else if (type == EX_NUMERIC)
146 *n = allocate_nonterminal (OP_NUM_TO_BOOL, *n);
149 /* Enforce PXP_NUMERIC flag. */
150 if ((flags & PXP_NUMERIC) && (type != EX_NUMERIC))
152 msg (SE, _("A numeric expression was expected in a place "
153 "where one was not supplied."));
157 /* Enforce PXP_STRING flag. */
158 if ((flags & PXP_STRING) && (type != EX_STRING))
160 msg (SE, _("A string expression was expected in a place "
161 "where one was not supplied."));
168 /* Recursive-descent expression parser. */
170 /* Parses the OR level. */
172 parse_or (union any_node **n)
174 char typ[] = N_("The OR operator cannot take string operands.");
178 type = parse_and (n);
179 if (type == EX_ERROR || token != T_OR)
181 if (type == EX_STRING)
184 msg (SE, gettext (typ));
187 else if (type == EX_NUMERIC)
190 c = allocate_nonterminal (OP_OR, *n);
194 type = parse_and (n);
195 if (type == EX_ERROR)
197 else if (type == EX_STRING)
199 msg (SE, gettext (typ));
202 else if (type == EX_NUMERIC)
204 c = append_nonterminal_arg (c, *n);
217 /* Parses the AND level. */
219 parse_and (union any_node ** n)
221 static const char typ[]
222 = N_("The AND operator cannot take string operands.");
224 int type = parse_not (n);
226 if (type == EX_ERROR)
230 if (type == EX_STRING)
233 msg (SE, gettext (typ));
236 else if (type == EX_NUMERIC)
239 c = allocate_nonterminal (OP_AND, *n);
243 type = parse_not (n);
244 if (type == EX_ERROR)
246 else if (type == EX_STRING)
248 msg (SE, gettext (typ));
251 else if (type == EX_NUMERIC)
253 c = append_nonterminal_arg (c, *n);
266 /* Parses the NOT level. */
268 parse_not (union any_node ** n)
270 static const char typ[]
271 = N_("The NOT operator cannot take a string operand.");
275 while (lex_match (T_NOT))
277 type = parse_rel (n);
278 if (!not || type == EX_ERROR)
281 if (type == EX_STRING)
284 msg (SE, gettext (typ));
287 else if (type == EX_NUMERIC)
290 *n = allocate_nonterminal (OP_NOT, *n);
295 parse_rel (union any_node ** n)
297 static const char typ[]
298 = N_("Strings cannot be compared with numeric or Boolean "
299 "values with the relational operators "
302 int type = parse_add (n);
304 if (type == EX_ERROR)
308 if (token < T_EQ || token > T_NE)
315 c = allocate_nonterminal (token - T_EQ
316 + (type == EX_NUMERIC ? OP_EQ : OP_STRING_EQ),
323 if (t == EX_BOOLEAN && type == EX_NUMERIC)
324 make_bool (&c->nonterm.arg[0]);
325 else if (t == EX_NUMERIC && type == EX_BOOLEAN)
329 msg (SE, gettext (typ));
333 c = append_nonterminal_arg (c, *n);
338 if (token < T_EQ || token > T_NE)
350 /* Parses the addition and subtraction level. */
352 parse_add (union any_node **n)
354 static const char typ[]
355 = N_("The `+' and `-' operators may only be used with "
356 "numeric operands.");
361 type = parse_mul (n);
362 lex_negative_to_dash ();
363 if (type == EX_ERROR || (token != '+' && token != '-'))
365 if (type != EX_NUMERIC)
368 msg (SE, gettext (typ));
372 c = allocate_nonterminal (OP_PLUS, *n);
378 type = parse_mul (n);
379 if (type == EX_ERROR)
381 else if (type != EX_NUMERIC)
383 msg (SE, gettext (typ));
387 *n = allocate_nonterminal (OP_NEG, *n);
388 c = append_nonterminal_arg (c, *n);
390 lex_negative_to_dash ();
391 if (token != '+' && token != '-')
402 /* Parses the multiplication and division level. */
404 parse_mul (union any_node ** n)
406 static const char typ[]
407 = N_("The `*' and `/' operators may only be used with "
408 "numeric operands.");
414 type = parse_neg (n);
415 if (type == EX_ERROR || (token != '*' && token != '/'))
417 if (type != EX_NUMERIC)
420 msg (SE, gettext (typ));
424 c = allocate_nonterminal (OP_MUL, *n);
430 type = parse_neg (n);
431 if (type == EX_ERROR)
433 else if (type != EX_NUMERIC)
435 msg (SE, gettext (typ));
439 *n = allocate_nonterminal (OP_INV, *n);
440 c = append_nonterminal_arg (c, *n);
442 if (token != '*' && token != '/')
453 /* Parses the unary minus level. */
455 parse_neg (union any_node **n)
457 static const char typ[]
458 = N_("The unary minus (-) operator can only take a numeric operand.");
465 lex_negative_to_dash ();
466 if (!lex_match ('-'))
470 type = parse_exp (n);
471 if (!neg || type == EX_ERROR)
473 if (type != EX_NUMERIC)
476 msg (SE, gettext (typ));
480 *n = allocate_nonterminal (OP_NEG, *n);
485 parse_exp (union any_node **n)
487 static const char typ[]
488 = N_("Both operands to the ** operator must be numeric.");
493 type = parse_primary (n);
494 if (type == EX_ERROR || token != T_EXP)
496 if (type != EX_NUMERIC)
499 msg (SE, gettext (typ));
505 c = allocate_nonterminal (OP_POW, *n);
508 type = parse_primary (n);
509 if (type == EX_ERROR)
511 else if (type != EX_NUMERIC)
513 msg (SE, gettext (typ));
516 *n = append_nonterminal_arg (c, *n);
528 /* Parses system variables. */
530 parse_sysvar (union any_node **n)
532 if (!strcmp (tokid, "$CASENUM"))
534 *n = xmalloc (sizeof (struct casenum_node));
535 (*n)->casenum.type = OP_CASENUM;
542 if (!strcmp (tokid, "$SYSMIS"))
544 else if (!strcmp (tokid, "$JDATE"))
546 struct tm *time = localtime (&last_vfm_invocation);
547 d = yrmoda (time->tm_year + 1900, time->tm_mon + 1, time->tm_mday);
549 else if (!strcmp (tokid, "$DATE"))
551 static const char *months[12] =
553 "JAN", "FEB", "MAR", "APR", "MAY", "JUN",
554 "JUL", "AUG", "SEP", "OCT", "NOV", "DEC",
560 time = localtime (&last_vfm_invocation);
561 sprintf (temp_buf, "%02d %s %02d", abs (time->tm_mday) % 100,
562 months[abs (time->tm_mon) % 12], abs (time->tm_year) % 100);
564 *n = xmalloc (sizeof (struct str_con_node) + 8);
565 (*n)->str_con.type = OP_STR_CON;
566 (*n)->str_con.len = 9;
567 memcpy ((*n)->str_con.s, temp_buf, 9);
570 else if (!strcmp (tokid, "$TIME"))
573 time = localtime (&last_vfm_invocation);
574 d = (yrmoda (time->tm_year + 1900, time->tm_mon + 1,
575 time->tm_mday) * 60. * 60. * 24.
576 + time->tm_hour * 60 * 60.
580 else if (!strcmp (tokid, "$LENGTH"))
582 msg (SW, _("Use of $LENGTH is obsolete, returning default of 66."));
585 else if (!strcmp (tokid, "$WIDTH"))
587 msg (SW, _("Use of $WIDTH is obsolete, returning default of 131."));
592 msg (SE, _("Unknown system variable %s."), tokid);
596 *n = xmalloc (sizeof (struct num_con_node));
597 (*n)->num_con.type = OP_NUM_CON;
598 (*n)->num_con.value = d;
603 /* Parses numbers, varnames, etc. */
605 parse_primary (union any_node **n)
613 /* An identifier followed by a left parenthesis is a function
615 if (lex_look_ahead () == '(')
616 return parse_function (n);
618 /* $ at the beginning indicates a system variable. */
621 int type = parse_sysvar (n);
626 /* Otherwise, it must be a user variable. */
627 v = find_variable (tokid);
631 lex_error (_("expecting variable name"));
635 *n = xmalloc (sizeof (struct var_node));
636 (*n)->var.type = v->type == NUMERIC ? OP_NUM_VAR : OP_STR_VAR;
638 return v->type == NUMERIC ? EX_NUMERIC : EX_STRING;
642 *n = xmalloc (sizeof (struct num_con_node));
643 (*n)->num_con.type = OP_NUM_CON;
644 (*n)->num_con.value = tokval;
650 *n = xmalloc (sizeof (struct str_con_node) + ds_length (&tokstr) - 1);
651 (*n)->str_con.type = OP_STR_CON;
652 (*n)->str_con.len = ds_length (&tokstr);
653 memcpy ((*n)->str_con.s, ds_value (&tokstr), ds_length (&tokstr));
663 if (!lex_match (')'))
665 lex_error (_("expecting `)'"));
673 lex_error (_("in expression"));
678 /* Individual function parsing. */
684 int (*func) (struct function *, int, union any_node **);
688 static struct function func_tab[];
689 static int func_count;
691 static int get_num_args (struct function *, int, union any_node **);
694 unary_func (struct function * f, int x unused, union any_node ** n)
697 struct nonterm_node *c;
699 if (!get_num_args (f, 1, n))
705 divisor = 1 / 60. / 60. / 24.;
708 divisor = 1 / 60. / 60.;
710 case OP_CTIME_MINUTES:
714 divisor = 60. * 60. * 24.;
717 case OP_CTIME_SECONDS:
719 *n = (*n)->nonterm.arg[0];
726 /* Arrive here when we encounter an operation that is just a
727 glorified version of a multiplication or division. Converts the
728 operation directly into that multiplication. */
729 c = xmalloc (sizeof (struct nonterm_node) + sizeof (union any_node *));
732 c->arg[0] = (*n)->nonterm.arg[0];
733 c->arg[1] = xmalloc (sizeof (struct num_con_node));
734 c->arg[1]->num_con.type = OP_NUM_CON;
735 c->arg[1]->num_con.value = divisor;
737 *n = (union any_node *) c;
742 binary_func (struct function * f, int x unused, union any_node ** n)
744 if (!get_num_args (f, 2, n))
750 ternary_func (struct function * f, int x unused, union any_node ** n)
752 if (!get_num_args (f, 3, n))
758 MISSING_func (struct function * f, int x unused, union any_node ** n)
760 if (token == T_ID && is_varname (tokid) && lex_look_ahead () == ')')
762 struct var_node *c = xmalloc (sizeof *c);
763 c->v = parse_variable ();
764 c->type = c->v->type == ALPHA ? OP_STR_MIS : OP_NUM_SYS;
765 *n = (union any_node *) c;
768 if (!get_num_args (f, 1, n))
774 SYSMIS_func (struct function * f unused, int x unused, union any_node ** n)
778 if (token == T_ID && is_varname (tokid) && lex_look_ahead () == ')')
781 v = parse_variable ();
782 if (v->type == ALPHA)
784 struct num_con_node *c = xmalloc (sizeof *c);
785 c->type = OP_NUM_CON;
791 struct var_node *c = xmalloc (sizeof *c);
792 c->type = OP_NUM_SYS;
801 else if (t == EX_NUMERIC)
803 *n = allocate_nonterminal (OP_SYSMIS, *n);
806 else /* EX_STRING or EX_BOOLEAN */
808 /* Return constant `true' value. */
810 *n = xmalloc (sizeof (struct num_con_node));
811 (*n)->num_con.type = OP_NUM_CON;
812 (*n)->num_con.value = 1.0;
818 VALUE_func (struct function *f unused, int x unused, union any_node **n)
820 struct variable *v = parse_variable ();
824 *n = xmalloc (sizeof (struct var_node));
826 if (v->type == NUMERIC)
828 (*n)->var.type = OP_NUM_VAL;
833 (*n)->var.type = OP_STR_VAR;
839 LAG_func (struct function *f unused, int x unused, union any_node **n)
841 struct variable *v = parse_variable ();
848 if (!lex_integer_p () || lex_integer () <= 0 || lex_integer () > 1000)
850 msg (SE, _("Argument 2 to LAG must be a small positive "
851 "integer constant."));
855 nlag = lex_integer ();
858 n_lag = max (nlag, n_lag);
859 *n = xmalloc (sizeof (struct lag_node));
860 (*n)->lag.type = (v->type == NUMERIC ? OP_NUM_LAG : OP_STR_LAG);
862 (*n)->lag.lag = nlag;
863 return (v->type == NUMERIC ? EX_NUMERIC : EX_STRING);
866 /* This screwball function parses n-ary operators:
867 1. NMISS, NVALID, SUM, MEAN, MIN, MAX: any number of (numeric) arguments.
868 2. SD, VARIANCE, CFVAR: at least two (numeric) arguments.
869 3. RANGE: An odd number of arguments, but at least three.
870 All arguments must be the same type.
871 4. ANY: At least two arguments. All arguments must be the same type.
874 nary_num_func (struct function *f, int min_args, union any_node **n)
876 /* Argument number of current argument (used for error messages). */
879 /* Number of arguments. */
882 /* Number of arguments allocated. */
885 /* Type of arguments. */
886 int type = (f->t == OP_ANY || f->t == OP_RANGE) ? -1 : NUMERIC;
888 *n = xmalloc (sizeof (struct nonterm_node) + sizeof (union any_node *[15]));
889 (*n)->nonterm.type = f->t;
893 /* Special case: vara TO varb. */
895 /* FIXME: Is this condition failsafe? Can we _ever_ have two
896 juxtaposed identifiers otherwise? */
897 if (token == T_ID && is_varname (tokid)
898 && toupper (lex_look_ahead ()) == 'T')
903 int opts = PV_SINGLE;
907 else if (type == ALPHA)
909 if (!parse_variables (NULL, &v, &nv, opts))
911 if (nv + (*n)->nonterm.n >= m)
914 *n = xrealloc (*n, (sizeof (struct nonterm_node)
915 + (m - 1) * sizeof (union any_node *)));
920 for (j = 1; j < nv; j++)
921 if (type != v[j]->type)
923 msg (SE, _("Type mismatch in argument %d of %s, which was "
924 "expected to be of %s type. It was actually "
926 argn, f->s, type_name (type), type_name (v[j]->type));
931 for (j = 0; j < nv; j++)
933 union any_node **c = &(*n)->nonterm.arg[(*n)->nonterm.n++];
934 *c = xmalloc (sizeof (struct var_node));
935 (*c)->var.type = (type == NUMERIC ? OP_NUM_VAR : OP_STR_VAR);
942 int t = parse_or (&c);
949 msg (SE, _("%s cannot take Boolean operands."), f->s);
956 else if (t == EX_STRING)
959 else if ((t == EX_NUMERIC) ^ (type == NUMERIC))
962 msg (SE, _("Type mismatch in argument %d of %s, which was "
963 "expected to be of %s type. It was actually "
965 argn, f->s, type_name (type), expr_type_name (t));
968 if ((*n)->nonterm.n + 1 >= m)
971 *n = xrealloc (*n, (sizeof (struct nonterm_node)
972 + (m - 1) * sizeof (union any_node *)));
974 (*n)->nonterm.arg[(*n)->nonterm.n++] = c;
979 if (!lex_match (','))
981 lex_error (_("in function call"));
987 *n = xrealloc (*n, (sizeof (struct nonterm_node)
988 + ((*n)->nonterm.n) * sizeof (union any_node *)));
990 nargs = (*n)->nonterm.n;
991 if (f->t == OP_RANGE)
993 if (nargs < 3 || (nargs & 1) == 0)
995 msg (SE, _("RANGE requires an odd number of arguments, but "
1000 else if (f->t == OP_SD || f->t == OP_VARIANCE
1001 || f->t == OP_CFVAR || f->t == OP_ANY)
1005 msg (SE, _("%s requires at least two arguments."), f->s);
1010 if (f->t == OP_CFVAR || f->t == OP_SD || f->t == OP_VARIANCE)
1011 min_args = max (min_args, 2);
1013 min_args = max (min_args, 1);
1015 /* Yes, this is admittedly a terrible crock, but it works. */
1016 (*n)->nonterm.arg[(*n)->nonterm.n] = (union any_node *) min_args;
1018 if (min_args > nargs)
1020 msg (SE, _("%s.%d requires at least %d arguments."),
1021 f->s, min_args, min_args);
1025 if (f->t == OP_ANY || f->t == OP_RANGE)
1027 if (type == T_STRING)
1040 CONCAT_func (struct function * f unused, int x unused, union any_node ** n)
1046 *n = xmalloc (sizeof (struct nonterm_node) + sizeof (union any_node *[15]));
1047 (*n)->nonterm.type = OP_CONCAT;
1048 (*n)->nonterm.n = 0;
1051 if ((*n)->nonterm.n >= m)
1054 *n = xrealloc (*n, (sizeof (struct nonterm_node)
1055 + (m - 1) * sizeof (union any_node *)));
1057 type = parse_or (&(*n)->nonterm.arg[(*n)->nonterm.n]);
1058 if (type == EX_ERROR)
1060 if (type != EX_STRING)
1062 msg (SE, _("Argument %d to CONCAT is type %s. All arguments "
1063 "to CONCAT must be strings."),
1064 (*n)->nonterm.n + 1, expr_type_name (type));
1069 if (!lex_match (','))
1072 *n = xrealloc (*n, (sizeof (struct nonterm_node)
1073 + ((*n)->nonterm.n - 1) * sizeof (union any_node *)));
1081 /* Parses a string function according to f->desc. f->desc[0] is the
1082 return type of the function. Succeeding characters represent
1083 successive args. Optional args are separated from the required
1084 args by a slash (`/'). Codes are `n', numeric arg; `s', string
1085 arg; and `f', format spec (this must be the last arg). If the
1086 optional args are included, the type becomes f->t+1. */
1088 generic_str_func (struct function *f, int x unused, union any_node ** n)
1094 /* Count max number of arguments. */
1098 if (*cp == 'n' || *cp == 's')
1100 else if (*cp == 'f')
1106 *n = xmalloc (sizeof (struct nonterm_node)
1107 + (max_args - 1) * sizeof (union any_node *));
1108 (*n)->nonterm.type = f->t;
1109 (*n)->nonterm.n = 0;
1112 if (*cp == 'n' || *cp == 's')
1114 int t = *cp == 'n' ? EX_NUMERIC : EX_STRING;
1115 type = parse_or (&(*n)->nonterm.arg[(*n)->nonterm.n]);
1117 if (type == EX_ERROR)
1121 msg (SE, _("Argument %d to %s was expected to be of %s type. "
1122 "It was actually of type %s."),
1123 (*n)->nonterm.n + 1, f->s,
1124 *cp == 'n' ? _("numeric") : _("string"),
1125 expr_type_name (type));
1130 else if (*cp == 'f')
1132 /* This is always the very last argument. Also, this code
1133 is a crock. However, it works. */
1134 struct fmt_spec fmt;
1136 if (!parse_format_specifier (&fmt, 0))
1138 if (formats[fmt.type].cat & FCAT_STRING)
1140 msg (SE, _("%s is not a numeric format."), fmt_to_string (&fmt));
1143 (*n)->nonterm.arg[(*n)->nonterm.n + 0] = (union any_node *) fmt.type;
1144 (*n)->nonterm.arg[(*n)->nonterm.n + 1] = (union any_node *) fmt.w;
1145 (*n)->nonterm.arg[(*n)->nonterm.n + 2] = (union any_node *) fmt.d;
1156 if (lex_match (','))
1158 (*n)->nonterm.type++;
1164 else if (!lex_match (','))
1166 msg (SE, _("Too few arguments to function %s."), f->s);
1171 return f->desc[0] == 'n' ? EX_NUMERIC : EX_STRING;
1178 /* General function parsing. */
1181 get_num_args (struct function *f, int num_args, union any_node **n)
1186 *n = xmalloc (sizeof (struct nonterm_node)
1187 + (num_args - 1) * sizeof (union any_node *));
1188 (*n)->nonterm.type = f->t;
1189 (*n)->nonterm.n = 0;
1192 t = parse_or (&(*n)->nonterm.arg[i]);
1196 if (t != EX_NUMERIC)
1198 msg (SE, _("Type mismatch in argument %d of %s, which was expected "
1199 "to be numeric. It was actually type %s."),
1200 i + 1, f->s, expr_type_name (t));
1203 if (++i >= num_args)
1205 if (!lex_match (','))
1207 msg (SE, _("Missing comma following argument %d of %s."), i + 1, f->s);
1218 parse_function (union any_node ** n)
1220 struct function *fp;
1221 char fname[32], *cp;
1226 /* Check for a vector with this name. */
1227 v = find_vector (tokid);
1231 assert (token == '(');
1234 *n = xmalloc (sizeof (struct nonterm_node)
1235 + sizeof (union any_node *[2]));
1236 (*n)->nonterm.type = (v->v[0]->type == NUMERIC
1237 ? OP_VEC_ELEM_NUM : OP_VEC_ELEM_STR);
1238 (*n)->nonterm.n = 0;
1240 t = parse_or (&(*n)->nonterm.arg[0]);
1243 if (t != EX_NUMERIC)
1245 msg (SE, _("The index value after a vector name must be numeric."));
1250 if (!lex_match (')'))
1252 msg (SE, _("`)' expected after a vector index value."));
1255 ((*n)->nonterm.arg[1]) = (union any_node *) v->index;
1257 return v->v[0]->type == NUMERIC ? EX_NUMERIC : EX_STRING;
1260 ds_truncate (&tokstr, 31);
1261 strcpy (fname, ds_value (&tokstr));
1262 cp = strrchr (fname, '.');
1263 if (cp && isdigit ((unsigned char) cp[1]))
1265 min_args = atoi (&cp[1]);
1272 if (!lex_force_match ('('))
1279 fp = binary_search (func_tab, func_count, sizeof *func_tab, &f,
1280 compare_functions, NULL);
1285 msg (SE, _("There is no function named %s."), fname);
1288 if (min_args && fp->func != nary_num_func)
1290 msg (SE, _("Function %s may not be given a minimum number of "
1291 "arguments."), fname);
1294 t = fp->func (fp, min_args, n);
1297 if (!lex_match (')'))
1299 lex_error (_("expecting `)' after %s function"), fname);
1310 #if GLOBAL_DEBUGGING
1311 #define op(a,b,c,d) {a,b,c,d}
1313 #define op(a,b,c,d) {b,c,d}
1318 struct op_desc ops[OP_SENTINEL + 1] =
1320 op ("!?ERROR?!", 000, 0, 0),
1322 op ("plus", 001, varies, 1),
1323 op ("mul", 011, varies, 1),
1324 op ("pow", 010, -1, 0),
1325 op ("and", 010, -1, 0),
1326 op ("or", 010, -1, 0),
1327 op ("not", 000, 0, 0),
1328 op ("eq", 000, -1, 0),
1329 op ("ge", 000, -1, 0),
1330 op ("gt", 000, -1, 0),
1331 op ("le", 000, -1, 0),
1332 op ("lt", 000, -1, 0),
1333 op ("ne", 000, -1, 0),
1335 op ("string-eq", 000, -1, 0),
1336 op ("string-ge", 000, -1, 0),
1337 op ("string-gt", 000, -1, 0),
1338 op ("string-le", 000, -1, 0),
1339 op ("string-lt", 000, -1, 0),
1340 op ("string-ne", 000, -1, 0),
1342 op ("neg", 000, 0, 0),
1343 op ("abs", 000, 0, 0),
1344 op ("arcos", 000, 0, 0),
1345 op ("arsin", 000, 0, 0),
1346 op ("artan", 000, 0, 0),
1347 op ("cos", 000, 0, 0),
1348 op ("exp", 000, 0, 0),
1349 op ("lg10", 000, 0, 0),
1350 op ("ln", 000, 0, 0),
1351 op ("mod10", 000, 0, 0),
1352 op ("rnd", 000, 0, 0),
1353 op ("sin", 000, 0, 0),
1354 op ("sqrt", 000, 0, 0),
1355 op ("tan", 000, 0, 0),
1356 op ("trunc", 000, 0, 0),
1358 op ("any", 011, varies, 1),
1359 op ("any-string", 001, varies, 1),
1360 op ("cfvar", 013, varies, 2),
1361 op ("max", 013, varies, 2),
1362 op ("mean", 013, varies, 2),
1363 op ("min", 013, varies, 2),
1364 op ("nmiss", 011, varies, 1),
1365 op ("nvalid", 011, varies, 1),
1366 op ("range", 011, varies, 1),
1367 op ("range-string", 001, varies, 1),
1368 op ("sd", 013, varies, 2),
1369 op ("sum", 013, varies, 2),
1370 op ("variance", 013, varies, 2),
1372 op ("time_hms", 000, -2, 0),
1373 op ("ctime_days?!", 000, 0, 0),
1374 op ("ctime_hours?!", 000, 0, 0),
1375 op ("ctime_minutes?!", 000, 0, 0),
1376 op ("ctime_seconds?!", 000, 0, 0),
1377 op ("time_days?!", 000, 0, 0),
1379 op ("date_dmy", 000, -2, 0),
1380 op ("date_mdy", 000, -2, 0),
1381 op ("date_moyr", 000, -1, 0),
1382 op ("date_qyr", 000, -1, 0),
1383 op ("date_wkyr", 000, -1, 0),
1384 op ("date_yrday", 000, -1, 0),
1385 op ("yrmoda", 000, -2, 0),
1387 op ("xdate_date", 000, 0, 0),
1388 op ("xdate_hour", 000, 0, 0),
1389 op ("xdate_jday", 000, 0, 0),
1390 op ("xdate_mday", 000, 0, 0),
1391 op ("xdate_minute", 000, 0, 0),
1392 op ("xdate_month", 000, 0, 0),
1393 op ("xdate_quarter", 000, 0, 0),
1394 op ("xdate_second", 000, 0, 0),
1395 op ("xdate_tday", 000, 0, 0),
1396 op ("xdate_time", 000, 0, 0),
1397 op ("xdate_week", 000, 0, 0),
1398 op ("xdate_wkday", 000, 0, 0),
1399 op ("xdate_year", 000, 0, 0),
1401 op ("concat", 001, varies, 1),
1402 op ("index-2", 000, -1, 0),
1403 op ("index-3", 000, -2, 0),
1404 op ("rindex-2", 000, -1, 0),
1405 op ("rindex-3", 000, -2, 0),
1406 op ("length", 000, 0, 0),
1407 op ("lower", 000, 0, 0),
1408 op ("upcas", 000, 0, 0),
1409 op ("lpad-2", 010, -1, 0),
1410 op ("lpad-3", 010, -2, 0),
1411 op ("rpad-2", 010, -1, 0),
1412 op ("rpad-3", 010, -2, 0),
1413 op ("ltrim-1", 000, 0, 0),
1414 op ("ltrim-2", 000, -1, 0),
1415 op ("rtrim-1", 000, 0, 0),
1416 op ("rtrim-2", 000, -1, 0),
1417 op ("number-1", 010, 0, 0),
1418 op ("number-2", 014, 0, 3),
1419 op ("string", 004, 0, 3),
1420 op ("substr-2", 010, -1, 0),
1421 op ("substr-3", 010, -2, 0),
1423 op ("inv", 000, 0, 0),
1424 op ("square", 000, 0, 0),
1425 op ("num-to-Bool", 000, 0, 0),
1427 op ("mod", 010, -1, 0),
1428 op ("normal", 000, 0, 0),
1429 op ("uniform", 000, 0, 0),
1430 op ("sysmis", 010, 0, 0),
1431 op ("vec-elem-num", 002, 0, 1),
1432 op ("vec-elem-str", 002, 0, 1),
1434 op ("!?TERMINAL?!", 000, 0, 0),
1435 op ("num-con", 000, +1, 0),
1436 op ("str-con", 000, +1, 0),
1437 op ("num-var", 000, +1, 0),
1438 op ("str-var", 000, +1, 0),
1439 op ("num-lag", 000, +1, 1),
1440 op ("str-lag", 000, +1, 1),
1441 op ("num-sys", 000, +1, 1),
1442 op ("num-val", 000, +1, 1),
1443 op ("str-mis", 000, +1, 1),
1444 op ("$casenum", 000, +1, 0),
1445 op ("!?SENTINEL?!", 000, 0, 0),
1452 /* Utility functions. */
1455 expr_type_name (int type)
1463 return _("Boolean");
1466 return _("numeric");
1478 type_name (int type)
1483 return _("numeric");
1493 make_bool (union any_node **n)
1497 c = xmalloc (sizeof (struct nonterm_node));
1498 c->nonterm.type = OP_NUM_TO_BOOL;
1500 c->nonterm.arg[0] = *n;
1505 free_node (union any_node *n)
1507 if (n->type < OP_TERMINAL)
1511 for (i = 0; i < n->nonterm.n; i++)
1512 free_node (n->nonterm.arg[i]);
1518 allocate_nonterminal (int op, union any_node *n)
1522 c = xmalloc (sizeof c->nonterm);
1523 c->nonterm.type = op;
1525 c->nonterm.arg[0] = n;
1531 append_nonterminal_arg (union any_node *a, union any_node *b)
1533 a = xrealloc (a, sizeof *a + sizeof *a->nonterm.arg * a->nonterm.n);
1534 a->nonterm.arg[a->nonterm.n++] = b;
1538 static struct function func_tab[] =
1540 {"ABS", OP_ABS, unary_func, NULL},
1541 {"ACOS", OP_ARCOS, unary_func, NULL},
1542 {"ARCOS", OP_ARCOS, unary_func, NULL},
1543 {"ARSIN", OP_ARSIN, unary_func, NULL},
1544 {"ARTAN", OP_ARTAN, unary_func, NULL},
1545 {"ASIN", OP_ARSIN, unary_func, NULL},
1546 {"ATAN", OP_ARTAN, unary_func, NULL},
1547 {"COS", OP_COS, unary_func, NULL},
1548 {"EXP", OP_EXP, unary_func, NULL},
1549 {"LG10", OP_LG10, unary_func, NULL},
1550 {"LN", OP_LN, unary_func, NULL},
1551 {"MOD10", OP_MOD10, unary_func, NULL},
1552 {"NORMAL", OP_NORMAL, unary_func, NULL},
1553 {"RND", OP_RND, unary_func, NULL},
1554 {"SIN", OP_SIN, unary_func, NULL},
1555 {"SQRT", OP_SQRT, unary_func, NULL},
1556 {"TAN", OP_TAN, unary_func, NULL},
1557 {"TRUNC", OP_TRUNC, unary_func, NULL},
1558 {"UNIFORM", OP_UNIFORM, unary_func, NULL},
1560 {"TIME.DAYS", OP_TIME_DAYS, unary_func, NULL},
1561 {"TIME.HMS", OP_TIME_HMS, ternary_func, NULL},
1563 {"CTIME.DAYS", OP_CTIME_DAYS, unary_func, NULL},
1564 {"CTIME.HOURS", OP_CTIME_HOURS, unary_func, NULL},
1565 {"CTIME.MINUTES", OP_CTIME_MINUTES, unary_func, NULL},
1566 {"CTIME.SECONDS", OP_CTIME_SECONDS, unary_func, NULL},
1568 {"DATE.DMY", OP_DATE_DMY, ternary_func, NULL},
1569 {"DATE.MDY", OP_DATE_MDY, ternary_func, NULL},
1570 {"DATE.MOYR", OP_DATE_MOYR, binary_func, NULL},
1571 {"DATE.QYR", OP_DATE_QYR, binary_func, NULL},
1572 {"DATE.WKYR", OP_DATE_WKYR, binary_func, NULL},
1573 {"DATE.YRDAY", OP_DATE_YRDAY, binary_func, NULL},
1575 {"XDATE.DATE", OP_XDATE_DATE, unary_func, NULL},
1576 {"XDATE.HOUR", OP_XDATE_HOUR, unary_func, NULL},
1577 {"XDATE.JDAY", OP_XDATE_JDAY, unary_func, NULL},
1578 {"XDATE.MDAY", OP_XDATE_MDAY, unary_func, NULL},
1579 {"XDATE.MINUTE", OP_XDATE_MINUTE, unary_func, NULL},
1580 {"XDATE.MONTH", OP_XDATE_MONTH, unary_func, NULL},
1581 {"XDATE.QUARTER", OP_XDATE_QUARTER, unary_func, NULL},
1582 {"XDATE.SECOND", OP_XDATE_SECOND, unary_func, NULL},
1583 {"XDATE.TDAY", OP_XDATE_TDAY, unary_func, NULL},
1584 {"XDATE.TIME", OP_XDATE_TIME, unary_func, NULL},
1585 {"XDATE.WEEK", OP_XDATE_WEEK, unary_func, NULL},
1586 {"XDATE.WKDAY", OP_XDATE_WKDAY, unary_func, NULL},
1587 {"XDATE.YEAR", OP_XDATE_YEAR, unary_func, NULL},
1589 {"MISSING", OP_SYSMIS, MISSING_func, NULL},
1590 {"MOD", OP_MOD, binary_func, NULL},
1591 {"SYSMIS", OP_SYSMIS, SYSMIS_func, NULL},
1592 {"VALUE", OP_NUM_VAL, VALUE_func, NULL},
1593 {"LAG", OP_NUM_LAG, LAG_func, NULL},
1594 {"YRMODA", OP_YRMODA, ternary_func, NULL},
1596 {"ANY", OP_ANY, nary_num_func, NULL},
1597 {"CFVAR", OP_CFVAR, nary_num_func, NULL},
1598 {"MAX", OP_MAX, nary_num_func, NULL},
1599 {"MEAN", OP_MEAN, nary_num_func, NULL},
1600 {"MIN", OP_MIN, nary_num_func, NULL},
1601 {"NMISS", OP_NMISS, nary_num_func, NULL},
1602 {"NVALID", OP_NVALID, nary_num_func, NULL},
1603 {"RANGE", OP_RANGE, nary_num_func, NULL},
1604 {"SD", OP_SD, nary_num_func, NULL},
1605 {"SUM", OP_SUM, nary_num_func, NULL},
1606 {"VARIANCE", OP_VARIANCE, nary_num_func, NULL},
1608 {"CONCAT", OP_CONCAT, CONCAT_func, NULL},
1609 {"INDEX", OP_INDEX, generic_str_func, "nss/n"},
1610 {"RINDEX", OP_RINDEX, generic_str_func, "nss/n"},
1611 {"LENGTH", OP_LENGTH, generic_str_func, "ns"},
1612 {"LOWER", OP_LOWER, generic_str_func, "ss"},
1613 {"UPCAS", OP_UPPER, generic_str_func, "ss"},
1614 {"LPAD", OP_LPAD, generic_str_func, "ssn/s"},
1615 {"RPAD", OP_RPAD, generic_str_func, "ssn/s"},
1616 {"LTRIM", OP_LTRIM, generic_str_func, "ss/s"},
1617 {"RTRIM", OP_RTRIM, generic_str_func, "ss/s"},
1618 {"NUMBER", OP_NUMBER, generic_str_func, "ns/f"},
1619 {"STRING", OP_STRING, generic_str_func, "snf"},
1620 {"SUBSTR", OP_SUBSTR, generic_str_func, "ssn/n"},
1623 /* An algo_compare_func that compares functions A and B based on
1626 compare_functions (const void *a_, const void *b_, void *aux unused)
1628 const struct function *a = a_;
1629 const struct function *b = b_;
1631 return strcmp (a->s, b->s);
1635 init_func_tab (void)
1645 func_count = sizeof func_tab / sizeof *func_tab;
1646 sort (func_tab, func_count, sizeof *func_tab, compare_functions, NULL);
1653 print_type (union any_node * n)
1658 s = ops[n->type].name;
1660 if (ops[n->type].flags & OP_MIN_ARGS)
1661 printf ("%s.%d\n", s, (int) n->nonterm.arg[n->nonterm.n]);
1662 else if (ops[n->type].flags & OP_FMT_SPEC)
1666 f.type = (int) n->nonterm.arg[n->nonterm.n + 0];
1667 f.w = (int) n->nonterm.arg[n->nonterm.n + 1];
1668 f.d = (int) n->nonterm.arg[n->nonterm.n + 2];
1669 printf ("%s(%s)\n", s, fmt_to_string (&f));
1676 debug_print_tree (union any_node * n, int level)
1679 for (i = 0; i < level; i++)
1681 if (n->type < OP_TERMINAL)
1684 for (i = 0; i < n->nonterm.n; i++)
1685 debug_print_tree (n->nonterm.arg[i], level + 1);
1692 printf (_("!!TERMINAL!!"));
1695 if (n->num_con.value == SYSMIS)
1698 printf ("%f", n->num_con.value);
1701 printf ("\"%.*s\"", n->str_con.len, n->str_con.s);
1705 printf ("%s", n->var.v->name);
1709 printf ("LAG(%s,%d)", n->lag.v->name, n->lag.lag);
1712 printf ("SYSMIS(%s)", n->var.v->name);
1715 printf ("VALUE(%s)", n->var.v->name);
1718 printf (_("!!SENTINEL!!"));
1721 printf (_("!!ERROR%d!!"), n->type);
1727 #endif /* DEBUGGING */
1729 #if GLOBAL_DEBUGGING
1731 debug_print_postfix (struct expression * e)
1734 double *num = e->num;
1735 unsigned char *str = e->str;
1736 struct variable **v = e->var;
1739 debug_printf ((_("postfix:")));
1740 for (o = e->op; *o != OP_SENTINEL;)
1743 if (t < OP_TERMINAL)
1745 debug_printf ((" %s", ops[t].name));
1747 if (ops[t].flags & OP_VAR_ARGS)
1749 debug_printf (("(%d)", *o));
1752 if (ops[t].flags & OP_MIN_ARGS)
1754 debug_printf ((".%d", *o));
1757 if (ops[t].flags & OP_FMT_SPEC)
1760 f.type = (int) *o++;
1763 debug_printf (("(%s)", fmt_to_string (&f)));
1766 else if (t == OP_NUM_CON)
1769 debug_printf ((" SYSMIS"));
1771 debug_printf ((" %f", *num));
1774 else if (t == OP_STR_CON)
1776 debug_printf ((" \"%.*s\"", *str, &str[1]));
1779 else if (t == OP_NUM_VAR || t == OP_STR_VAR)
1781 debug_printf ((" %s", (*v)->name));
1784 else if (t == OP_NUM_SYS)
1786 debug_printf ((" SYSMIS(#%d)", *o));
1789 else if (t == OP_NUM_VAL)
1791 debug_printf ((" VALUE(#%d)", *o));
1794 else if (t == OP_NUM_LAG || t == OP_STR_LAG)
1796 debug_printf ((" LAG(%s,%d)", (*v)->name, *o));
1802 printf ("debug_print_postfix(): %d\n", t);
1806 debug_putc ('\n', stdout);
1808 #endif /* GLOBAL_DEBUGGING */