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
27 #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)
85 pool_destroy (e->pool);
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
124 debug_print_postfix (e);
131 type_check (union any_node **n, int type, int flags)
133 /* Enforce PXP_BOOLEAN flag. */
134 if (flags & PXP_BOOLEAN)
136 if (type == EX_STRING)
138 msg (SE, _("A string expression was supplied in a place "
139 "where a Boolean expression was expected."));
142 else if (type == EX_NUMERIC)
143 *n = allocate_nonterminal (OP_NUM_TO_BOOL, *n);
146 /* Enforce PXP_NUMERIC flag. */
147 if ((flags & PXP_NUMERIC) && (type != EX_NUMERIC))
149 msg (SE, _("A numeric expression was expected in a place "
150 "where one was not supplied."));
154 /* Enforce PXP_STRING flag. */
155 if ((flags & PXP_STRING) && (type != EX_STRING))
157 msg (SE, _("A string expression was expected in a place "
158 "where one was not supplied."));
165 /* Recursive-descent expression parser. */
167 /* Parses the OR level. */
169 parse_or (union any_node **n)
171 char typ[] = N_("The OR operator cannot take string operands.");
175 type = parse_and (n);
176 if (type == EX_ERROR || token != T_OR)
178 if (type == EX_STRING)
181 msg (SE, gettext (typ));
184 else if (type == EX_NUMERIC)
187 c = allocate_nonterminal (OP_OR, *n);
191 type = parse_and (n);
192 if (type == EX_ERROR)
194 else if (type == EX_STRING)
196 msg (SE, gettext (typ));
199 else if (type == EX_NUMERIC)
201 c = append_nonterminal_arg (c, *n);
214 /* Parses the AND level. */
216 parse_and (union any_node ** n)
218 static const char typ[]
219 = N_("The AND operator cannot take string operands.");
221 int type = parse_not (n);
223 if (type == EX_ERROR)
227 if (type == EX_STRING)
230 msg (SE, gettext (typ));
233 else if (type == EX_NUMERIC)
236 c = allocate_nonterminal (OP_AND, *n);
240 type = parse_not (n);
241 if (type == EX_ERROR)
243 else if (type == EX_STRING)
245 msg (SE, gettext (typ));
248 else if (type == EX_NUMERIC)
250 c = append_nonterminal_arg (c, *n);
263 /* Parses the NOT level. */
265 parse_not (union any_node ** n)
267 static const char typ[]
268 = N_("The NOT operator cannot take a string operand.");
272 while (lex_match (T_NOT))
274 type = parse_rel (n);
275 if (!not || type == EX_ERROR)
278 if (type == EX_STRING)
281 msg (SE, gettext (typ));
284 else if (type == EX_NUMERIC)
287 *n = allocate_nonterminal (OP_NOT, *n);
292 parse_rel (union any_node ** n)
294 static const char typ[]
295 = N_("Strings cannot be compared with numeric or Boolean "
296 "values with the relational operators "
299 int type = parse_add (n);
301 if (type == EX_ERROR)
305 if (token < T_EQ || token > T_NE)
312 c = allocate_nonterminal (token - T_EQ
313 + (type == EX_NUMERIC ? OP_EQ : OP_STRING_EQ),
320 if (t == EX_BOOLEAN && type == EX_NUMERIC)
321 make_bool (&c->nonterm.arg[0]);
322 else if (t == EX_NUMERIC && type == EX_BOOLEAN)
326 msg (SE, gettext (typ));
330 c = append_nonterminal_arg (c, *n);
335 if (token < T_EQ || token > T_NE)
347 /* Parses the addition and subtraction level. */
349 parse_add (union any_node **n)
351 static const char typ[]
352 = N_("The `+' and `-' operators may only be used with "
353 "numeric operands.");
358 type = parse_mul (n);
359 lex_negative_to_dash ();
360 if (type == EX_ERROR || (token != '+' && token != '-'))
362 if (type != EX_NUMERIC)
365 msg (SE, gettext (typ));
369 c = allocate_nonterminal (OP_PLUS, *n);
375 type = parse_mul (n);
376 if (type == EX_ERROR)
378 else if (type != EX_NUMERIC)
380 msg (SE, gettext (typ));
384 *n = allocate_nonterminal (OP_NEG, *n);
385 c = append_nonterminal_arg (c, *n);
387 lex_negative_to_dash ();
388 if (token != '+' && token != '-')
399 /* Parses the multiplication and division level. */
401 parse_mul (union any_node ** n)
403 static const char typ[]
404 = N_("The `*' and `/' operators may only be used with "
405 "numeric operands.");
411 type = parse_neg (n);
412 if (type == EX_ERROR || (token != '*' && token != '/'))
414 if (type != EX_NUMERIC)
417 msg (SE, gettext (typ));
421 c = allocate_nonterminal (OP_MUL, *n);
427 type = parse_neg (n);
428 if (type == EX_ERROR)
430 else if (type != EX_NUMERIC)
432 msg (SE, gettext (typ));
436 *n = allocate_nonterminal (OP_INV, *n);
437 c = append_nonterminal_arg (c, *n);
439 if (token != '*' && token != '/')
450 /* Parses the unary minus level. */
452 parse_neg (union any_node **n)
454 static const char typ[]
455 = N_("The unary minus (-) operator can only take a numeric operand.");
462 lex_negative_to_dash ();
463 if (!lex_match ('-'))
467 type = parse_exp (n);
468 if (!neg || type == EX_ERROR)
470 if (type != EX_NUMERIC)
473 msg (SE, gettext (typ));
477 *n = allocate_nonterminal (OP_NEG, *n);
482 parse_exp (union any_node **n)
484 static const char typ[]
485 = N_("Both operands to the ** operator must be numeric.");
490 type = parse_primary (n);
491 if (type == EX_ERROR || token != T_EXP)
493 if (type != EX_NUMERIC)
496 msg (SE, gettext (typ));
502 c = allocate_nonterminal (OP_POW, *n);
505 type = parse_primary (n);
506 if (type == EX_ERROR)
508 else if (type != EX_NUMERIC)
510 msg (SE, gettext (typ));
513 *n = append_nonterminal_arg (c, *n);
525 /* Parses system variables. */
527 parse_sysvar (union any_node **n)
529 if (!strcmp (tokid, "$CASENUM"))
531 *n = xmalloc (sizeof (struct casenum_node));
532 (*n)->casenum.type = OP_CASENUM;
539 if (!strcmp (tokid, "$SYSMIS"))
541 else if (!strcmp (tokid, "$JDATE"))
543 struct tm *time = localtime (&last_vfm_invocation);
544 d = yrmoda (time->tm_year + 1900, time->tm_mon + 1, time->tm_mday);
546 else if (!strcmp (tokid, "$DATE"))
548 static const char *months[12] =
550 "JAN", "FEB", "MAR", "APR", "MAY", "JUN",
551 "JUL", "AUG", "SEP", "OCT", "NOV", "DEC",
557 time = localtime (&last_vfm_invocation);
558 sprintf (temp_buf, "%02d %s %02d", abs (time->tm_mday) % 100,
559 months[abs (time->tm_mon) % 12], abs (time->tm_year) % 100);
561 *n = xmalloc (sizeof (struct str_con_node) + 8);
562 (*n)->str_con.type = OP_STR_CON;
563 (*n)->str_con.len = 9;
564 memcpy ((*n)->str_con.s, temp_buf, 9);
567 else if (!strcmp (tokid, "$TIME"))
570 time = localtime (&last_vfm_invocation);
571 d = (yrmoda (time->tm_year + 1900, time->tm_mon + 1,
572 time->tm_mday) * 60. * 60. * 24.
573 + time->tm_hour * 60 * 60.
577 else if (!strcmp (tokid, "$LENGTH"))
579 msg (SW, _("Use of $LENGTH is obsolete, returning default of 66."));
582 else if (!strcmp (tokid, "$WIDTH"))
584 msg (SW, _("Use of $WIDTH is obsolete, returning default of 131."));
589 msg (SE, _("Unknown system variable %s."), tokid);
593 *n = xmalloc (sizeof (struct num_con_node));
594 (*n)->num_con.type = OP_NUM_CON;
595 (*n)->num_con.value = d;
600 /* Parses numbers, varnames, etc. */
602 parse_primary (union any_node **n)
610 /* An identifier followed by a left parenthesis is a function
612 if (lex_look_ahead () == '(')
613 return parse_function (n);
615 /* $ at the beginning indicates a system variable. */
618 int type = parse_sysvar (n);
623 /* Otherwise, it must be a user variable. */
624 v = dict_lookup_var (default_dict, tokid);
628 lex_error (_("expecting variable name"));
632 *n = xmalloc (sizeof (struct var_node));
633 (*n)->var.type = v->type == NUMERIC ? OP_NUM_VAR : OP_STR_VAR;
635 return v->type == NUMERIC ? EX_NUMERIC : EX_STRING;
639 *n = xmalloc (sizeof (struct num_con_node));
640 (*n)->num_con.type = OP_NUM_CON;
641 (*n)->num_con.value = tokval;
647 *n = xmalloc (sizeof (struct str_con_node) + ds_length (&tokstr) - 1);
648 (*n)->str_con.type = OP_STR_CON;
649 (*n)->str_con.len = ds_length (&tokstr);
650 memcpy ((*n)->str_con.s, ds_value (&tokstr), ds_length (&tokstr));
660 if (!lex_match (')'))
662 lex_error (_("expecting `)'"));
670 lex_error (_("in expression"));
675 /* Individual function parsing. */
681 int (*func) (struct function *, int, union any_node **);
685 static struct function func_tab[];
686 static int func_count;
688 static int get_num_args (struct function *, int, union any_node **);
691 unary_func (struct function * f, int x UNUSED, union any_node ** n)
694 struct nonterm_node *c;
696 if (!get_num_args (f, 1, n))
702 divisor = 1 / 60. / 60. / 24.;
705 divisor = 1 / 60. / 60.;
707 case OP_CTIME_MINUTES:
711 divisor = 60. * 60. * 24.;
714 case OP_CTIME_SECONDS:
716 *n = (*n)->nonterm.arg[0];
723 /* Arrive here when we encounter an operation that is just a
724 glorified version of a multiplication or division. Converts the
725 operation directly into that multiplication. */
726 c = xmalloc (sizeof (struct nonterm_node) + sizeof (union any_node *));
729 c->arg[0] = (*n)->nonterm.arg[0];
730 c->arg[1] = xmalloc (sizeof (struct num_con_node));
731 c->arg[1]->num_con.type = OP_NUM_CON;
732 c->arg[1]->num_con.value = divisor;
734 *n = (union any_node *) c;
739 binary_func (struct function * f, int x UNUSED, union any_node ** n)
741 if (!get_num_args (f, 2, n))
747 ternary_func (struct function * f, int x UNUSED, union any_node ** n)
749 if (!get_num_args (f, 3, n))
755 MISSING_func (struct function * f, int x UNUSED, union any_node ** n)
758 && dict_lookup_var (default_dict, tokid) != NULL
759 && lex_look_ahead () == ')')
761 struct var_node *c = xmalloc (sizeof *c);
762 c->v = parse_variable ();
763 c->type = c->v->type == ALPHA ? OP_STR_MIS : OP_NUM_SYS;
764 *n = (union any_node *) c;
767 if (!get_num_args (f, 1, n))
773 SYSMIS_func (struct function * f UNUSED, int x UNUSED, union any_node ** n)
778 && dict_lookup_var (default_dict, tokid)
779 && lex_look_ahead () == ')')
782 v = parse_variable ();
783 if (v->type == ALPHA)
785 struct num_con_node *c = xmalloc (sizeof *c);
786 c->type = OP_NUM_CON;
792 struct var_node *c = xmalloc (sizeof *c);
793 c->type = OP_NUM_SYS;
802 else if (t == EX_NUMERIC)
804 *n = allocate_nonterminal (OP_SYSMIS, *n);
807 else /* EX_STRING or EX_BOOLEAN */
809 /* Return constant `true' value. */
811 *n = xmalloc (sizeof (struct num_con_node));
812 (*n)->num_con.type = OP_NUM_CON;
813 (*n)->num_con.value = 1.0;
819 VALUE_func (struct function *f UNUSED, int x UNUSED, union any_node **n)
821 struct variable *v = parse_variable ();
825 *n = xmalloc (sizeof (struct var_node));
827 if (v->type == NUMERIC)
829 (*n)->var.type = OP_NUM_VAL;
834 (*n)->var.type = OP_STR_VAR;
840 LAG_func (struct function *f UNUSED, int x UNUSED, union any_node **n)
842 struct variable *v = parse_variable ();
849 if (!lex_integer_p () || lex_integer () <= 0 || lex_integer () > 1000)
851 msg (SE, _("Argument 2 to LAG must be a small positive "
852 "integer constant."));
856 nlag = lex_integer ();
859 n_lag = max (nlag, n_lag);
860 *n = xmalloc (sizeof (struct lag_node));
861 (*n)->lag.type = (v->type == NUMERIC ? OP_NUM_LAG : OP_STR_LAG);
863 (*n)->lag.lag = nlag;
864 return (v->type == NUMERIC ? EX_NUMERIC : EX_STRING);
867 /* This screwball function parses n-ary operators:
868 1. NMISS, NVALID, SUM, MEAN, MIN, MAX: any number of (numeric) arguments.
869 2. SD, VARIANCE, CFVAR: at least two (numeric) arguments.
870 3. RANGE: An odd number of arguments, but at least three.
871 All arguments must be the same type.
872 4. ANY: At least two arguments. All arguments must be the same type.
875 nary_num_func (struct function *f, int min_args, union any_node **n)
877 /* Argument number of current argument (used for error messages). */
880 /* Number of arguments. */
883 /* Number of arguments allocated. */
886 /* Type of arguments. */
887 int type = (f->t == OP_ANY || f->t == OP_RANGE) ? -1 : NUMERIC;
889 *n = xmalloc (sizeof (struct nonterm_node) + sizeof (union any_node *[15]));
890 (*n)->nonterm.type = f->t;
894 /* Special case: vara TO varb. */
896 /* FIXME: Is this condition failsafe? Can we _ever_ have two
897 juxtaposed identifiers otherwise? */
898 if (token == T_ID && dict_lookup_var (default_dict, tokid) != NULL
899 && toupper (lex_look_ahead ()) == 'T')
904 int opts = PV_SINGLE;
908 else if (type == ALPHA)
910 if (!parse_variables (default_dict, &v, &nv, opts))
912 if (nv + (*n)->nonterm.n >= m)
915 *n = xrealloc (*n, (sizeof (struct nonterm_node)
916 + (m - 1) * sizeof (union any_node *)));
921 for (j = 1; j < nv; j++)
922 if (type != v[j]->type)
924 msg (SE, _("Type mismatch in argument %d of %s, which was "
925 "expected to be of %s type. It was actually "
927 argn, f->s, type_name (type), type_name (v[j]->type));
932 for (j = 0; j < nv; j++)
934 union any_node **c = &(*n)->nonterm.arg[(*n)->nonterm.n++];
935 *c = xmalloc (sizeof (struct var_node));
936 (*c)->var.type = (type == NUMERIC ? OP_NUM_VAR : OP_STR_VAR);
943 int t = parse_or (&c);
950 msg (SE, _("%s cannot take Boolean operands."), f->s);
957 else if (t == EX_STRING)
960 else if ((t == EX_NUMERIC) ^ (type == NUMERIC))
963 msg (SE, _("Type mismatch in argument %d of %s, which was "
964 "expected to be of %s type. It was actually "
966 argn, f->s, type_name (type), expr_type_name (t));
969 if ((*n)->nonterm.n + 1 >= m)
972 *n = xrealloc (*n, (sizeof (struct nonterm_node)
973 + (m - 1) * sizeof (union any_node *)));
975 (*n)->nonterm.arg[(*n)->nonterm.n++] = c;
980 if (!lex_match (','))
982 lex_error (_("in function call"));
988 *n = xrealloc (*n, (sizeof (struct nonterm_node)
989 + ((*n)->nonterm.n) * sizeof (union any_node *)));
991 nargs = (*n)->nonterm.n;
992 if (f->t == OP_RANGE)
994 if (nargs < 3 || (nargs & 1) == 0)
996 msg (SE, _("RANGE requires an odd number of arguments, but "
1001 else if (f->t == OP_SD || f->t == OP_VARIANCE
1002 || f->t == OP_CFVAR || f->t == OP_ANY)
1006 msg (SE, _("%s requires at least two arguments."), f->s);
1011 if (f->t == OP_CFVAR || f->t == OP_SD || f->t == OP_VARIANCE)
1012 min_args = max (min_args, 2);
1014 min_args = max (min_args, 1);
1016 /* Yes, this is admittedly a terrible crock, but it works. */
1017 (*n)->nonterm.arg[(*n)->nonterm.n] = (union any_node *) min_args;
1019 if (min_args > nargs)
1021 msg (SE, _("%s.%d requires at least %d arguments."),
1022 f->s, min_args, min_args);
1026 if (f->t == OP_ANY || f->t == OP_RANGE)
1028 if (type == T_STRING)
1041 CONCAT_func (struct function * f UNUSED, int x UNUSED, union any_node ** n)
1047 *n = xmalloc (sizeof (struct nonterm_node) + sizeof (union any_node *[15]));
1048 (*n)->nonterm.type = OP_CONCAT;
1049 (*n)->nonterm.n = 0;
1052 if ((*n)->nonterm.n >= m)
1055 *n = xrealloc (*n, (sizeof (struct nonterm_node)
1056 + (m - 1) * sizeof (union any_node *)));
1058 type = parse_or (&(*n)->nonterm.arg[(*n)->nonterm.n]);
1059 if (type == EX_ERROR)
1061 if (type != EX_STRING)
1063 msg (SE, _("Argument %d to CONCAT is type %s. All arguments "
1064 "to CONCAT must be strings."),
1065 (*n)->nonterm.n + 1, expr_type_name (type));
1070 if (!lex_match (','))
1073 *n = xrealloc (*n, (sizeof (struct nonterm_node)
1074 + ((*n)->nonterm.n - 1) * sizeof (union any_node *)));
1082 /* Parses a string function according to f->desc. f->desc[0] is the
1083 return type of the function. Succeeding characters represent
1084 successive args. Optional args are separated from the required
1085 args by a slash (`/'). Codes are `n', numeric arg; `s', string
1086 arg; and `f', format spec (this must be the last arg). If the
1087 optional args are included, the type becomes f->t+1. */
1089 generic_str_func (struct function *f, int x UNUSED, union any_node ** n)
1095 /* Count max number of arguments. */
1099 if (*cp == 'n' || *cp == 's')
1101 else if (*cp == 'f')
1107 *n = xmalloc (sizeof (struct nonterm_node)
1108 + (max_args - 1) * sizeof (union any_node *));
1109 (*n)->nonterm.type = f->t;
1110 (*n)->nonterm.n = 0;
1113 if (*cp == 'n' || *cp == 's')
1115 int t = *cp == 'n' ? EX_NUMERIC : EX_STRING;
1116 type = parse_or (&(*n)->nonterm.arg[(*n)->nonterm.n]);
1118 if (type == EX_ERROR)
1122 msg (SE, _("Argument %d to %s was expected to be of %s type. "
1123 "It was actually of type %s."),
1124 (*n)->nonterm.n + 1, f->s,
1125 *cp == 'n' ? _("numeric") : _("string"),
1126 expr_type_name (type));
1131 else if (*cp == 'f')
1133 /* This is always the very last argument. Also, this code
1134 is a crock. However, it works. */
1135 struct fmt_spec fmt;
1137 if (!parse_format_specifier (&fmt, 0))
1139 if (formats[fmt.type].cat & FCAT_STRING)
1141 msg (SE, _("%s is not a numeric format."), fmt_to_string (&fmt));
1144 (*n)->nonterm.arg[(*n)->nonterm.n + 0] = (union any_node *) fmt.type;
1145 (*n)->nonterm.arg[(*n)->nonterm.n + 1] = (union any_node *) fmt.w;
1146 (*n)->nonterm.arg[(*n)->nonterm.n + 2] = (union any_node *) fmt.d;
1157 if (lex_match (','))
1159 (*n)->nonterm.type++;
1165 else if (!lex_match (','))
1167 msg (SE, _("Too few arguments to function %s."), f->s);
1172 return f->desc[0] == 'n' ? EX_NUMERIC : EX_STRING;
1179 /* General function parsing. */
1182 get_num_args (struct function *f, int num_args, union any_node **n)
1187 *n = xmalloc (sizeof (struct nonterm_node)
1188 + (num_args - 1) * sizeof (union any_node *));
1189 (*n)->nonterm.type = f->t;
1190 (*n)->nonterm.n = 0;
1193 t = parse_or (&(*n)->nonterm.arg[i]);
1197 if (t != EX_NUMERIC)
1199 msg (SE, _("Type mismatch in argument %d of %s, which was expected "
1200 "to be numeric. It was actually type %s."),
1201 i + 1, f->s, expr_type_name (t));
1204 if (++i >= num_args)
1206 if (!lex_match (','))
1208 msg (SE, _("Missing comma following argument %d of %s."), i + 1, f->s);
1219 parse_function (union any_node ** n)
1221 struct function *fp;
1222 char fname[32], *cp;
1225 const struct vector *v;
1227 /* Check for a vector with this name. */
1228 v = dict_lookup_vector (default_dict, tokid);
1232 assert (token == '(');
1235 *n = xmalloc (sizeof (struct nonterm_node)
1236 + sizeof (union any_node *[2]));
1237 (*n)->nonterm.type = (v->var[0]->type == NUMERIC
1238 ? OP_VEC_ELEM_NUM : OP_VEC_ELEM_STR);
1239 (*n)->nonterm.n = 0;
1241 t = parse_or (&(*n)->nonterm.arg[0]);
1244 if (t != EX_NUMERIC)
1246 msg (SE, _("The index value after a vector name must be numeric."));
1251 if (!lex_match (')'))
1253 msg (SE, _("`)' expected after a vector index value."));
1256 ((*n)->nonterm.arg[1]) = (union any_node *) v->idx;
1258 return v->var[0]->type == NUMERIC ? EX_NUMERIC : EX_STRING;
1261 ds_truncate (&tokstr, 31);
1262 strcpy (fname, ds_value (&tokstr));
1263 cp = strrchr (fname, '.');
1264 if (cp && isdigit ((unsigned char) cp[1]))
1266 min_args = atoi (&cp[1]);
1273 if (!lex_force_match ('('))
1280 fp = binary_search (func_tab, func_count, sizeof *func_tab, &f,
1281 compare_functions, NULL);
1286 msg (SE, _("There is no function named %s."), fname);
1289 if (min_args && fp->func != nary_num_func)
1291 msg (SE, _("Function %s may not be given a minimum number of "
1292 "arguments."), fname);
1295 t = fp->func (fp, min_args, n);
1298 if (!lex_match (')'))
1300 lex_error (_("expecting `)' after %s function"), fname);
1311 #if GLOBAL_DEBUGGING
1312 #define op(a,b,c,d) {a,b,c,d}
1314 #define op(a,b,c,d) {b,c,d}
1319 struct op_desc ops[OP_SENTINEL + 1] =
1321 op ("!?ERROR?!", 000, 0, 0),
1323 op ("plus", 001, varies, 1),
1324 op ("mul", 011, varies, 1),
1325 op ("pow", 010, -1, 0),
1326 op ("and", 010, -1, 0),
1327 op ("or", 010, -1, 0),
1328 op ("not", 000, 0, 0),
1329 op ("eq", 000, -1, 0),
1330 op ("ge", 000, -1, 0),
1331 op ("gt", 000, -1, 0),
1332 op ("le", 000, -1, 0),
1333 op ("lt", 000, -1, 0),
1334 op ("ne", 000, -1, 0),
1336 op ("string-eq", 000, -1, 0),
1337 op ("string-ge", 000, -1, 0),
1338 op ("string-gt", 000, -1, 0),
1339 op ("string-le", 000, -1, 0),
1340 op ("string-lt", 000, -1, 0),
1341 op ("string-ne", 000, -1, 0),
1343 op ("neg", 000, 0, 0),
1344 op ("abs", 000, 0, 0),
1345 op ("arcos", 000, 0, 0),
1346 op ("arsin", 000, 0, 0),
1347 op ("artan", 000, 0, 0),
1348 op ("cos", 000, 0, 0),
1349 op ("exp", 000, 0, 0),
1350 op ("lg10", 000, 0, 0),
1351 op ("ln", 000, 0, 0),
1352 op ("mod10", 000, 0, 0),
1353 op ("rnd", 000, 0, 0),
1354 op ("sin", 000, 0, 0),
1355 op ("sqrt", 000, 0, 0),
1356 op ("tan", 000, 0, 0),
1357 op ("trunc", 000, 0, 0),
1359 op ("any", 011, varies, 1),
1360 op ("any-string", 001, varies, 1),
1361 op ("cfvar", 013, varies, 2),
1362 op ("max", 013, varies, 2),
1363 op ("mean", 013, varies, 2),
1364 op ("min", 013, varies, 2),
1365 op ("nmiss", 011, varies, 1),
1366 op ("nvalid", 011, varies, 1),
1367 op ("range", 011, varies, 1),
1368 op ("range-string", 001, varies, 1),
1369 op ("sd", 013, varies, 2),
1370 op ("sum", 013, varies, 2),
1371 op ("variance", 013, varies, 2),
1373 op ("time_hms", 000, -2, 0),
1374 op ("ctime_days?!", 000, 0, 0),
1375 op ("ctime_hours?!", 000, 0, 0),
1376 op ("ctime_minutes?!", 000, 0, 0),
1377 op ("ctime_seconds?!", 000, 0, 0),
1378 op ("time_days?!", 000, 0, 0),
1380 op ("date_dmy", 000, -2, 0),
1381 op ("date_mdy", 000, -2, 0),
1382 op ("date_moyr", 000, -1, 0),
1383 op ("date_qyr", 000, -1, 0),
1384 op ("date_wkyr", 000, -1, 0),
1385 op ("date_yrday", 000, -1, 0),
1386 op ("yrmoda", 000, -2, 0),
1388 op ("xdate_date", 000, 0, 0),
1389 op ("xdate_hour", 000, 0, 0),
1390 op ("xdate_jday", 000, 0, 0),
1391 op ("xdate_mday", 000, 0, 0),
1392 op ("xdate_minute", 000, 0, 0),
1393 op ("xdate_month", 000, 0, 0),
1394 op ("xdate_quarter", 000, 0, 0),
1395 op ("xdate_second", 000, 0, 0),
1396 op ("xdate_tday", 000, 0, 0),
1397 op ("xdate_time", 000, 0, 0),
1398 op ("xdate_week", 000, 0, 0),
1399 op ("xdate_wkday", 000, 0, 0),
1400 op ("xdate_year", 000, 0, 0),
1402 op ("concat", 001, varies, 1),
1403 op ("index-2", 000, -1, 0),
1404 op ("index-3", 000, -2, 0),
1405 op ("rindex-2", 000, -1, 0),
1406 op ("rindex-3", 000, -2, 0),
1407 op ("length", 000, 0, 0),
1408 op ("lower", 000, 0, 0),
1409 op ("upcas", 000, 0, 0),
1410 op ("lpad-2", 010, -1, 0),
1411 op ("lpad-3", 010, -2, 0),
1412 op ("rpad-2", 010, -1, 0),
1413 op ("rpad-3", 010, -2, 0),
1414 op ("ltrim-1", 000, 0, 0),
1415 op ("ltrim-2", 000, -1, 0),
1416 op ("rtrim-1", 000, 0, 0),
1417 op ("rtrim-2", 000, -1, 0),
1418 op ("number-1", 010, 0, 0),
1419 op ("number-2", 014, 0, 3),
1420 op ("string", 004, 0, 3),
1421 op ("substr-2", 010, -1, 0),
1422 op ("substr-3", 010, -2, 0),
1424 op ("inv", 000, 0, 0),
1425 op ("square", 000, 0, 0),
1426 op ("num-to-Bool", 000, 0, 0),
1428 op ("mod", 010, -1, 0),
1429 op ("normal", 000, 0, 0),
1430 op ("uniform", 000, 0, 0),
1431 op ("sysmis", 010, 0, 0),
1432 op ("vec-elem-num", 002, 0, 1),
1433 op ("vec-elem-str", 002, 0, 1),
1435 op ("!?TERMINAL?!", 000, 0, 0),
1436 op ("num-con", 000, +1, 0),
1437 op ("str-con", 000, +1, 0),
1438 op ("num-var", 000, +1, 0),
1439 op ("str-var", 000, +1, 0),
1440 op ("num-lag", 000, +1, 1),
1441 op ("str-lag", 000, +1, 1),
1442 op ("num-sys", 000, +1, 1),
1443 op ("num-val", 000, +1, 1),
1444 op ("str-mis", 000, +1, 1),
1445 op ("$casenum", 000, +1, 0),
1446 op ("!?SENTINEL?!", 000, 0, 0),
1453 /* Utility functions. */
1456 expr_type_name (int type)
1464 return _("Boolean");
1467 return _("numeric");
1479 type_name (int type)
1484 return _("numeric");
1494 make_bool (union any_node **n)
1498 c = xmalloc (sizeof (struct nonterm_node));
1499 c->nonterm.type = OP_NUM_TO_BOOL;
1501 c->nonterm.arg[0] = *n;
1506 free_node (union any_node *n)
1508 if (n->type < OP_TERMINAL)
1512 for (i = 0; i < n->nonterm.n; i++)
1513 free_node (n->nonterm.arg[i]);
1519 allocate_nonterminal (int op, union any_node *n)
1523 c = xmalloc (sizeof c->nonterm);
1524 c->nonterm.type = op;
1526 c->nonterm.arg[0] = n;
1532 append_nonterminal_arg (union any_node *a, union any_node *b)
1534 a = xrealloc (a, sizeof *a + sizeof *a->nonterm.arg * a->nonterm.n);
1535 a->nonterm.arg[a->nonterm.n++] = b;
1539 static struct function func_tab[] =
1541 {"ABS", OP_ABS, unary_func, NULL},
1542 {"ACOS", OP_ARCOS, unary_func, NULL},
1543 {"ARCOS", OP_ARCOS, unary_func, NULL},
1544 {"ARSIN", OP_ARSIN, unary_func, NULL},
1545 {"ARTAN", OP_ARTAN, unary_func, NULL},
1546 {"ASIN", OP_ARSIN, unary_func, NULL},
1547 {"ATAN", OP_ARTAN, unary_func, NULL},
1548 {"COS", OP_COS, unary_func, NULL},
1549 {"EXP", OP_EXP, unary_func, NULL},
1550 {"LG10", OP_LG10, unary_func, NULL},
1551 {"LN", OP_LN, unary_func, NULL},
1552 {"MOD10", OP_MOD10, unary_func, NULL},
1553 {"NORMAL", OP_NORMAL, unary_func, NULL},
1554 {"RND", OP_RND, unary_func, NULL},
1555 {"SIN", OP_SIN, unary_func, NULL},
1556 {"SQRT", OP_SQRT, unary_func, NULL},
1557 {"TAN", OP_TAN, unary_func, NULL},
1558 {"TRUNC", OP_TRUNC, unary_func, NULL},
1559 {"UNIFORM", OP_UNIFORM, unary_func, NULL},
1561 {"TIME.DAYS", OP_TIME_DAYS, unary_func, NULL},
1562 {"TIME.HMS", OP_TIME_HMS, ternary_func, NULL},
1564 {"CTIME.DAYS", OP_CTIME_DAYS, unary_func, NULL},
1565 {"CTIME.HOURS", OP_CTIME_HOURS, unary_func, NULL},
1566 {"CTIME.MINUTES", OP_CTIME_MINUTES, unary_func, NULL},
1567 {"CTIME.SECONDS", OP_CTIME_SECONDS, unary_func, NULL},
1569 {"DATE.DMY", OP_DATE_DMY, ternary_func, NULL},
1570 {"DATE.MDY", OP_DATE_MDY, ternary_func, NULL},
1571 {"DATE.MOYR", OP_DATE_MOYR, binary_func, NULL},
1572 {"DATE.QYR", OP_DATE_QYR, binary_func, NULL},
1573 {"DATE.WKYR", OP_DATE_WKYR, binary_func, NULL},
1574 {"DATE.YRDAY", OP_DATE_YRDAY, binary_func, NULL},
1576 {"XDATE.DATE", OP_XDATE_DATE, unary_func, NULL},
1577 {"XDATE.HOUR", OP_XDATE_HOUR, unary_func, NULL},
1578 {"XDATE.JDAY", OP_XDATE_JDAY, unary_func, NULL},
1579 {"XDATE.MDAY", OP_XDATE_MDAY, unary_func, NULL},
1580 {"XDATE.MINUTE", OP_XDATE_MINUTE, unary_func, NULL},
1581 {"XDATE.MONTH", OP_XDATE_MONTH, unary_func, NULL},
1582 {"XDATE.QUARTER", OP_XDATE_QUARTER, unary_func, NULL},
1583 {"XDATE.SECOND", OP_XDATE_SECOND, unary_func, NULL},
1584 {"XDATE.TDAY", OP_XDATE_TDAY, unary_func, NULL},
1585 {"XDATE.TIME", OP_XDATE_TIME, unary_func, NULL},
1586 {"XDATE.WEEK", OP_XDATE_WEEK, unary_func, NULL},
1587 {"XDATE.WKDAY", OP_XDATE_WKDAY, unary_func, NULL},
1588 {"XDATE.YEAR", OP_XDATE_YEAR, unary_func, NULL},
1590 {"MISSING", OP_SYSMIS, MISSING_func, NULL},
1591 {"MOD", OP_MOD, binary_func, NULL},
1592 {"SYSMIS", OP_SYSMIS, SYSMIS_func, NULL},
1593 {"VALUE", OP_NUM_VAL, VALUE_func, NULL},
1594 {"LAG", OP_NUM_LAG, LAG_func, NULL},
1595 {"YRMODA", OP_YRMODA, ternary_func, NULL},
1597 {"ANY", OP_ANY, nary_num_func, NULL},
1598 {"CFVAR", OP_CFVAR, nary_num_func, NULL},
1599 {"MAX", OP_MAX, nary_num_func, NULL},
1600 {"MEAN", OP_MEAN, nary_num_func, NULL},
1601 {"MIN", OP_MIN, nary_num_func, NULL},
1602 {"NMISS", OP_NMISS, nary_num_func, NULL},
1603 {"NVALID", OP_NVALID, nary_num_func, NULL},
1604 {"RANGE", OP_RANGE, nary_num_func, NULL},
1605 {"SD", OP_SD, nary_num_func, NULL},
1606 {"SUM", OP_SUM, nary_num_func, NULL},
1607 {"VARIANCE", OP_VARIANCE, nary_num_func, NULL},
1609 {"CONCAT", OP_CONCAT, CONCAT_func, NULL},
1610 {"INDEX", OP_INDEX, generic_str_func, "nss/n"},
1611 {"RINDEX", OP_RINDEX, generic_str_func, "nss/n"},
1612 {"LENGTH", OP_LENGTH, generic_str_func, "ns"},
1613 {"LOWER", OP_LOWER, generic_str_func, "ss"},
1614 {"UPCAS", OP_UPPER, generic_str_func, "ss"},
1615 {"LPAD", OP_LPAD, generic_str_func, "ssn/s"},
1616 {"RPAD", OP_RPAD, generic_str_func, "ssn/s"},
1617 {"LTRIM", OP_LTRIM, generic_str_func, "ss/s"},
1618 {"RTRIM", OP_RTRIM, generic_str_func, "ss/s"},
1619 {"NUMBER", OP_NUMBER, generic_str_func, "ns/f"},
1620 {"STRING", OP_STRING, generic_str_func, "snf"},
1621 {"SUBSTR", OP_SUBSTR, generic_str_func, "ssn/n"},
1624 /* An algo_compare_func that compares functions A and B based on
1627 compare_functions (const void *a_, const void *b_, void *aux UNUSED)
1629 const struct function *a = a_;
1630 const struct function *b = b_;
1632 return strcmp (a->s, b->s);
1636 init_func_tab (void)
1646 func_count = sizeof func_tab / sizeof *func_tab;
1647 sort (func_tab, func_count, sizeof *func_tab, compare_functions, NULL);
1654 print_type (union any_node * n)
1659 s = ops[n->type].name;
1661 if (ops[n->type].flags & OP_MIN_ARGS)
1662 printf ("%s.%d\n", s, (int) n->nonterm.arg[n->nonterm.n]);
1663 else if (ops[n->type].flags & OP_FMT_SPEC)
1667 f.type = (int) n->nonterm.arg[n->nonterm.n + 0];
1668 f.w = (int) n->nonterm.arg[n->nonterm.n + 1];
1669 f.d = (int) n->nonterm.arg[n->nonterm.n + 2];
1670 printf ("%s(%s)\n", s, fmt_to_string (&f));
1677 debug_print_tree (union any_node * n, int level)
1680 for (i = 0; i < level; i++)
1682 if (n->type < OP_TERMINAL)
1685 for (i = 0; i < n->nonterm.n; i++)
1686 debug_print_tree (n->nonterm.arg[i], level + 1);
1693 printf (_("!!TERMINAL!!"));
1696 if (n->num_con.value == SYSMIS)
1699 printf ("%f", n->num_con.value);
1702 printf ("\"%.*s\"", n->str_con.len, n->str_con.s);
1706 printf ("%s", n->var.v->name);
1710 printf ("LAG(%s,%d)", n->lag.v->name, n->lag.lag);
1713 printf ("SYSMIS(%s)", n->var.v->name);
1716 printf ("VALUE(%s)", n->var.v->name);
1719 printf (_("!!SENTINEL!!"));
1722 printf (_("!!ERROR%d!!"), n->type);
1728 #endif /* DEBUGGING */
1730 #if GLOBAL_DEBUGGING
1732 debug_print_postfix (struct expression * e)
1735 double *num = e->num;
1736 unsigned char *str = e->str;
1737 struct variable **v = e->var;
1740 debug_printf ((_("postfix:")));
1741 for (o = e->op; *o != OP_SENTINEL;)
1744 if (t < OP_TERMINAL)
1746 debug_printf ((" %s", ops[t].name));
1748 if (ops[t].flags & OP_VAR_ARGS)
1750 debug_printf (("(%d)", *o));
1753 if (ops[t].flags & OP_MIN_ARGS)
1755 debug_printf ((".%d", *o));
1758 if (ops[t].flags & OP_FMT_SPEC)
1761 f.type = (int) *o++;
1764 debug_printf (("(%s)", fmt_to_string (&f)));
1767 else if (t == OP_NUM_CON)
1770 debug_printf ((" SYSMIS"));
1772 debug_printf ((" %f", *num));
1775 else if (t == OP_STR_CON)
1777 debug_printf ((" \"%.*s\"", *str, &str[1]));
1780 else if (t == OP_NUM_VAR || t == OP_STR_VAR)
1782 debug_printf ((" %s", (*v)->name));
1785 else if (t == OP_NUM_SYS)
1787 debug_printf ((" SYSMIS(#%d)", *o));
1790 else if (t == OP_NUM_VAL)
1792 debug_printf ((" VALUE(#%d)", *o));
1795 else if (t == OP_NUM_LAG || t == OP_STR_LAG)
1797 debug_printf ((" LAG(%s,%d)", (*v)->name, *o));
1803 printf ("debug_print_postfix(): %d\n", t);
1807 debug_putc ('\n', stdout);
1809 #endif /* GLOBAL_DEBUGGING */