session: Fix two memory leaks.
[pspp] / src / language / expressions / parse.c
1 /* PSPP - a program for statistical analysis.
2    Copyright (C) 1997-9, 2000, 2006, 2010, 2011, 2012 Free Software Foundation, Inc.
3
4    This program is free software: you can redistribute it and/or modify
5    it under the terms of the GNU General Public License as published by
6    the Free Software Foundation, either version 3 of the License, or
7    (at your option) any later version.
8
9    This program is distributed in the hope that it will be useful,
10    but WITHOUT ANY WARRANTY; without even the implied warranty of
11    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12    GNU General Public License for more details.
13
14    You should have received a copy of the GNU General Public License
15    along with this program.  If not, see <http://www.gnu.org/licenses/>. */
16
17 #include <config.h>
18
19 #include "private.h"
20
21 #include <ctype.h>
22 #include <float.h>
23 #include <limits.h>
24 #include <stdlib.h>
25
26 #include "data/case.h"
27 #include "data/dictionary.h"
28 #include "data/settings.h"
29 #include "data/variable.h"
30 #include "language/expressions/helpers.h"
31 #include "language/lexer/format-parser.h"
32 #include "language/lexer/lexer.h"
33 #include "language/lexer/variable-parser.h"
34 #include "libpspp/array.h"
35 #include "libpspp/assertion.h"
36 #include "libpspp/i18n.h"
37 #include "libpspp/message.h"
38 #include "libpspp/misc.h"
39 #include "libpspp/pool.h"
40 #include "libpspp/str.h"
41
42 #include "gl/c-strcase.h"
43 #include "gl/xalloc.h"
44 \f
45 /* Declarations. */
46
47 /* Recursive descent parser in order of increasing precedence. */
48 typedef union any_node *parse_recursively_func (struct lexer *, struct expression *);
49 static parse_recursively_func parse_or, parse_and, parse_not;
50 static parse_recursively_func parse_rel, parse_add, parse_mul;
51 static parse_recursively_func parse_neg, parse_exp;
52 static parse_recursively_func parse_primary;
53 static parse_recursively_func parse_vector_element, parse_function;
54
55 /* Utility functions. */
56 static struct expression *expr_create (struct dataset *ds);
57 atom_type expr_node_returns (const union any_node *);
58
59 static const char *atom_type_name (atom_type);
60 static struct expression *finish_expression (union any_node *,
61                                              struct expression *);
62 static bool type_check (struct expression *, union any_node **,
63                         enum expr_type expected_type);
64 static union any_node *allocate_unary_variable (struct expression *,
65                                                 const struct variable *);
66 \f
67 /* Public functions. */
68
69 /* Parses an expression of the given TYPE.
70    If DICT is nonnull then variables and vectors within it may be
71    referenced within the expression; otherwise, the expression
72    must not reference any variables or vectors.
73    Returns the new expression if successful or a null pointer
74    otherwise. */
75 struct expression *
76 expr_parse (struct lexer *lexer, struct dataset *ds, enum expr_type type)
77 {
78   union any_node *n;
79   struct expression *e;
80
81   assert (type == EXPR_NUMBER || type == EXPR_STRING || type == EXPR_BOOLEAN);
82
83   e = expr_create (ds);
84   n = parse_or (lexer, e);
85   if (n != NULL && type_check (e, &n, type))
86     return finish_expression (expr_optimize (n, e), e);
87   else
88     {
89       expr_free (e);
90       return NULL;
91     }
92 }
93
94 /* Parses and returns an expression of the given TYPE, as
95    expr_parse(), and sets up so that destroying POOL will free
96    the expression as well. */
97 struct expression *
98 expr_parse_pool (struct lexer *lexer,
99                  struct pool *pool,
100                  struct dataset *ds,
101                  enum expr_type type)
102 {
103   struct expression *e = expr_parse (lexer, ds, type);
104   if (e != NULL)
105     pool_add_subpool (pool, e->expr_pool);
106   return e;
107 }
108
109 /* Free expression E. */
110 void
111 expr_free (struct expression *e)
112 {
113   if (e != NULL)
114     pool_destroy (e->expr_pool);
115 }
116
117 struct expression *
118 expr_parse_any (struct lexer *lexer, struct dataset *ds, bool optimize)
119 {
120   union any_node *n;
121   struct expression *e;
122
123   e = expr_create (ds);
124   n = parse_or (lexer, e);
125   if (n == NULL)
126     {
127       expr_free (e);
128       return NULL;
129     }
130
131   if (optimize)
132     n = expr_optimize (n, e);
133   return finish_expression (n, e);
134 }
135 \f
136 /* Finishing up expression building. */
137
138 /* Height of an expression's stacks. */
139 struct stack_heights
140   {
141     int number_height;  /* Height of number stack. */
142     int string_height;  /* Height of string stack. */
143   };
144
145 /* Stack heights used by different kinds of arguments. */
146 static const struct stack_heights on_number_stack = {1, 0};
147 static const struct stack_heights on_string_stack = {0, 1};
148 static const struct stack_heights not_on_stack = {0, 0};
149
150 /* Returns the stack heights used by an atom of the given
151    TYPE. */
152 static const struct stack_heights *
153 atom_type_stack (atom_type type)
154 {
155   assert (is_atom (type));
156
157   switch (type)
158     {
159     case OP_number:
160     case OP_boolean:
161       return &on_number_stack;
162
163     case OP_string:
164       return &on_string_stack;
165
166     case OP_format:
167     case OP_ni_format:
168     case OP_no_format:
169     case OP_num_var:
170     case OP_str_var:
171     case OP_integer:
172     case OP_pos_int:
173     case OP_vector:
174       return &not_on_stack;
175
176     default:
177       NOT_REACHED ();
178     }
179 }
180
181 /* Measures the stack height needed for node N, supposing that
182    the stack height is initially *HEIGHT and updating *HEIGHT to
183    the final stack height.  Updates *MAX, if necessary, to
184    reflect the maximum intermediate or final height. */
185 static void
186 measure_stack (const union any_node *n,
187                struct stack_heights *height, struct stack_heights *max)
188 {
189   const struct stack_heights *return_height;
190
191   if (is_composite (n->type))
192     {
193       struct stack_heights args;
194       int i;
195
196       args = *height;
197       for (i = 0; i < n->composite.arg_cnt; i++)
198         measure_stack (n->composite.args[i], &args, max);
199
200       return_height = atom_type_stack (operations[n->type].returns);
201     }
202   else
203     return_height = atom_type_stack (n->type);
204
205   height->number_height += return_height->number_height;
206   height->string_height += return_height->string_height;
207
208   if (height->number_height > max->number_height)
209     max->number_height = height->number_height;
210   if (height->string_height > max->string_height)
211     max->string_height = height->string_height;
212 }
213
214 /* Allocates stacks within E sufficient for evaluating node N. */
215 static void
216 allocate_stacks (union any_node *n, struct expression *e)
217 {
218   struct stack_heights initial = {0, 0};
219   struct stack_heights max = {0, 0};
220
221   measure_stack (n, &initial, &max);
222   e->number_stack = pool_alloc (e->expr_pool,
223                                 sizeof *e->number_stack * max.number_height);
224   e->string_stack = pool_alloc (e->expr_pool,
225                                 sizeof *e->string_stack * max.string_height);
226 }
227
228 /* Finalizes expression E for evaluating node N. */
229 static struct expression *
230 finish_expression (union any_node *n, struct expression *e)
231 {
232   /* Allocate stacks. */
233   allocate_stacks (n, e);
234
235   /* Output postfix representation. */
236   expr_flatten (n, e);
237
238   /* The eval_pool might have been used for allocating strings
239      during optimization.  We need to keep those strings around
240      for all subsequent evaluations, so start a new eval_pool. */
241   e->eval_pool = pool_create_subpool (e->expr_pool);
242
243   return e;
244 }
245
246 /* Verifies that expression E, whose root node is *N, can be
247    converted to type EXPECTED_TYPE, inserting a conversion at *N
248    if necessary.  Returns true if successful, false on failure. */
249 static bool
250 type_check (struct expression *e,
251             union any_node **n, enum expr_type expected_type)
252 {
253   atom_type actual_type = expr_node_returns (*n);
254
255   switch (expected_type)
256     {
257     case EXPR_BOOLEAN:
258     case EXPR_NUMBER:
259       if (actual_type != OP_number && actual_type != OP_boolean)
260         {
261           msg (SE, _("Type mismatch: expression has %s type, "
262                      "but a numeric value is required here."),
263                atom_type_name (actual_type));
264           return false;
265         }
266       if (actual_type == OP_number && expected_type == EXPR_BOOLEAN)
267         *n = expr_allocate_binary (e, OP_NUM_TO_BOOLEAN, *n,
268                                    expr_allocate_string (e, ss_empty ()));
269       break;
270
271     case EXPR_STRING:
272       if (actual_type != OP_string)
273         {
274           msg (SE, _("Type mismatch: expression has %s type, "
275                      "but a string value is required here."),
276                atom_type_name (actual_type));
277           return false;
278         }
279       break;
280
281     default:
282       NOT_REACHED ();
283     }
284
285   return true;
286 }
287 \f
288 /* Recursive-descent expression parser. */
289
290 /* Considers whether *NODE may be coerced to type REQUIRED_TYPE.
291    Returns true if possible, false if disallowed.
292
293    If DO_COERCION is false, then *NODE is not modified and there
294    are no side effects.
295
296    If DO_COERCION is true, we perform the coercion if possible,
297    modifying *NODE if necessary.  If the coercion is not possible
298    then we free *NODE and set *NODE to a null pointer.
299
300    This function's interface is somewhat awkward.  Use one of the
301    wrapper functions type_coercion(), type_coercion_assert(), or
302    is_coercible() instead. */
303 static bool
304 type_coercion_core (struct expression *e,
305                     atom_type required_type,
306                     union any_node **node,
307                     const char *operator_name,
308                     bool do_coercion)
309 {
310   atom_type actual_type;
311
312   assert (!!do_coercion == (e != NULL));
313   if (*node == NULL)
314     {
315       /* Propagate error.  Whatever caused the original error
316          already emitted an error message. */
317       return false;
318     }
319
320   actual_type = expr_node_returns (*node);
321   if (actual_type == required_type)
322     {
323       /* Type match. */
324       return true;
325     }
326
327   switch (required_type)
328     {
329     case OP_number:
330       if (actual_type == OP_boolean)
331         {
332           /* To enforce strict typing rules, insert Boolean to
333              numeric "conversion".  This conversion is a no-op,
334              so it will be removed later. */
335           if (do_coercion)
336             *node = expr_allocate_unary (e, OP_BOOLEAN_TO_NUM, *node);
337           return true;
338         }
339       break;
340
341     case OP_string:
342       /* No coercion to string. */
343       break;
344
345     case OP_boolean:
346       if (actual_type == OP_number)
347         {
348           /* Convert numeric to boolean. */
349           if (do_coercion)
350             {
351               union any_node *op_name;
352
353               op_name = expr_allocate_string (e, ss_cstr (operator_name));
354               *node = expr_allocate_binary (e, OP_NUM_TO_BOOLEAN, *node,
355                                             op_name);
356             }
357           return true;
358         }
359       break;
360
361     case OP_format:
362       NOT_REACHED ();
363
364     case OP_ni_format:
365       msg_disable ();
366       if ((*node)->type == OP_format
367           && fmt_check_input (&(*node)->format.f)
368           && fmt_check_type_compat (&(*node)->format.f, VAL_NUMERIC))
369         {
370           msg_enable ();
371           if (do_coercion)
372             (*node)->type = OP_ni_format;
373           return true;
374         }
375       msg_enable ();
376       break;
377
378     case OP_no_format:
379       msg_disable ();
380       if ((*node)->type == OP_format
381           && fmt_check_output (&(*node)->format.f)
382           && fmt_check_type_compat (&(*node)->format.f, VAL_NUMERIC))
383         {
384           msg_enable ();
385           if (do_coercion)
386             (*node)->type = OP_no_format;
387           return true;
388         }
389       msg_enable ();
390       break;
391
392     case OP_num_var:
393       if ((*node)->type == OP_NUM_VAR)
394         {
395           if (do_coercion)
396             *node = (*node)->composite.args[0];
397           return true;
398         }
399       break;
400
401     case OP_str_var:
402       if ((*node)->type == OP_STR_VAR)
403         {
404           if (do_coercion)
405             *node = (*node)->composite.args[0];
406           return true;
407         }
408       break;
409
410     case OP_var:
411       if ((*node)->type == OP_NUM_VAR || (*node)->type == OP_STR_VAR)
412         {
413           if (do_coercion)
414             *node = (*node)->composite.args[0];
415           return true;
416         }
417       break;
418
419     case OP_pos_int:
420       if ((*node)->type == OP_number
421           && floor ((*node)->number.n) == (*node)->number.n
422           && (*node)->number.n > 0 && (*node)->number.n < INT_MAX)
423         {
424           if (do_coercion)
425             *node = expr_allocate_pos_int (e, (*node)->number.n);
426           return true;
427         }
428       break;
429
430     default:
431       NOT_REACHED ();
432     }
433
434   if (do_coercion)
435     {
436       msg (SE, _("Type mismatch while applying %s operator: "
437                  "cannot convert %s to %s."),
438            operator_name,
439            atom_type_name (actual_type), atom_type_name (required_type));
440       *node = NULL;
441     }
442   return false;
443 }
444
445 /* Coerces *NODE to type REQUIRED_TYPE, and returns success.  If
446    *NODE cannot be coerced to the desired type then we issue an
447    error message about operator OPERATOR_NAME and free *NODE. */
448 static bool
449 type_coercion (struct expression *e,
450                atom_type required_type, union any_node **node,
451                const char *operator_name)
452 {
453   return type_coercion_core (e, required_type, node, operator_name, true);
454 }
455
456 /* Coerces *NODE to type REQUIRED_TYPE.
457    Assert-fails if the coercion is disallowed. */
458 static void
459 type_coercion_assert (struct expression *e,
460                       atom_type required_type, union any_node **node)
461 {
462   int success = type_coercion_core (e, required_type, node, NULL, true);
463   assert (success);
464 }
465
466 /* Returns true if *NODE may be coerced to type REQUIRED_TYPE,
467    false otherwise. */
468 static bool
469 is_coercible (atom_type required_type, union any_node *const *node)
470 {
471   return type_coercion_core (NULL, required_type,
472                              (union any_node **) node, NULL, false);
473 }
474
475 /* Returns true if ACTUAL_TYPE is a kind of REQUIRED_TYPE, false
476    otherwise. */
477 static bool
478 is_compatible (atom_type required_type, atom_type actual_type)
479 {
480   return (required_type == actual_type
481           || (required_type == OP_var
482               && (actual_type == OP_num_var || actual_type == OP_str_var)));
483 }
484
485 /* How to parse an operator. */
486 struct operator
487   {
488     int token;                  /* Token representing operator. */
489     operation_type type;        /* Operation type representing operation. */
490     const char *name;           /* Name of operator. */
491   };
492
493 /* Attempts to match the current token against the tokens for the
494    OP_CNT operators in OPS[].  If successful, returns true
495    and, if OPERATOR is non-null, sets *OPERATOR to the operator.
496    On failure, returns false and, if OPERATOR is non-null, sets
497    *OPERATOR to a null pointer. */
498 static bool
499 match_operator (struct lexer *lexer, const struct operator ops[], size_t op_cnt,
500                 const struct operator **operator)
501 {
502   const struct operator *op;
503
504   for (op = ops; op < ops + op_cnt; op++)
505     if (lex_token (lexer) == op->token)
506       {
507         if (op->token != T_NEG_NUM)
508           lex_get (lexer);
509         if (operator != NULL)
510           *operator = op;
511         return true;
512       }
513   if (operator != NULL)
514     *operator = NULL;
515   return false;
516 }
517
518 static bool
519 check_operator (const struct operator *op, int arg_cnt, atom_type arg_type)
520 {
521   const struct operation *o;
522   size_t i;
523
524   assert (op != NULL);
525   o = &operations[op->type];
526   assert (o->arg_cnt == arg_cnt);
527   assert ((o->flags & OPF_ARRAY_OPERAND) == 0);
528   for (i = 0; i < arg_cnt; i++)
529     assert (is_compatible (arg_type, o->args[i]));
530   return true;
531 }
532
533 static bool
534 check_binary_operators (const struct operator ops[], size_t op_cnt,
535                         atom_type arg_type)
536 {
537   size_t i;
538
539   for (i = 0; i < op_cnt; i++)
540     check_operator (&ops[i], 2, arg_type);
541   return true;
542 }
543
544 static atom_type
545 get_operand_type (const struct operator *op)
546 {
547   return operations[op->type].args[0];
548 }
549
550 /* Parses a chain of left-associative operator/operand pairs.
551    There are OP_CNT operators, specified in OPS[].  The
552    operators' operands must all be the same type.  The next
553    higher level is parsed by PARSE_NEXT_LEVEL.  If CHAIN_WARNING
554    is non-null, then it will be issued as a warning if more than
555    one operator/operand pair is parsed. */
556 static union any_node *
557 parse_binary_operators (struct lexer *lexer, struct expression *e, union any_node *node,
558                         const struct operator ops[], size_t op_cnt,
559                         parse_recursively_func *parse_next_level,
560                         const char *chain_warning)
561 {
562   atom_type operand_type = get_operand_type (&ops[0]);
563   int op_count;
564   const struct operator *operator;
565
566   assert (check_binary_operators (ops, op_cnt, operand_type));
567   if (node == NULL)
568     return node;
569
570   for (op_count = 0; match_operator (lexer, ops, op_cnt, &operator); op_count++)
571     {
572       union any_node *rhs;
573
574       /* Convert the left-hand side to type OPERAND_TYPE. */
575       if (!type_coercion (e, operand_type, &node, operator->name))
576         return NULL;
577
578       /* Parse the right-hand side and coerce to type
579          OPERAND_TYPE. */
580       rhs = parse_next_level (lexer, e);
581       if (!type_coercion (e, operand_type, &rhs, operator->name))
582         return NULL;
583       node = expr_allocate_binary (e, operator->type, node, rhs);
584     }
585
586   if (op_count > 1 && chain_warning != NULL)
587     msg (SW, "%s", chain_warning);
588
589   return node;
590 }
591
592 static union any_node *
593 parse_inverting_unary_operator (struct lexer *lexer, struct expression *e,
594                                 const struct operator *op,
595                                 parse_recursively_func *parse_next_level)
596 {
597   union any_node *node;
598   unsigned op_count;
599
600   check_operator (op, 1, get_operand_type (op));
601
602   op_count = 0;
603   while (match_operator (lexer, op, 1, NULL))
604     op_count++;
605
606   node = parse_next_level (lexer, e);
607   if (op_count > 0
608       && type_coercion (e, get_operand_type (op), &node, op->name)
609       && op_count % 2 != 0)
610     return expr_allocate_unary (e, op->type, node);
611   else
612     return node;
613 }
614
615 /* Parses the OR level. */
616 static union any_node *
617 parse_or (struct lexer *lexer, struct expression *e)
618 {
619   static const struct operator op =
620     { T_OR, OP_OR, "logical disjunction (`OR')" };
621
622   return parse_binary_operators (lexer, e, parse_and (lexer, e), &op, 1, parse_and, NULL);
623 }
624
625 /* Parses the AND level. */
626 static union any_node *
627 parse_and (struct lexer *lexer, struct expression *e)
628 {
629   static const struct operator op =
630     { T_AND, OP_AND, "logical conjunction (`AND')" };
631
632   return parse_binary_operators (lexer, e, parse_not (lexer, e),
633                                  &op, 1, parse_not, NULL);
634 }
635
636 /* Parses the NOT level. */
637 static union any_node *
638 parse_not (struct lexer *lexer, struct expression *e)
639 {
640   static const struct operator op
641     = { T_NOT, OP_NOT, "logical negation (`NOT')" };
642   return parse_inverting_unary_operator (lexer, e, &op, parse_rel);
643 }
644
645 /* Parse relational operators. */
646 static union any_node *
647 parse_rel (struct lexer *lexer, struct expression *e)
648 {
649   const char *chain_warning =
650     _("Chaining relational operators (e.g. `a < b < c') will "
651       "not produce the mathematically expected result.  "
652       "Use the AND logical operator to fix the problem "
653       "(e.g. `a < b AND b < c').  "
654       "If chaining is really intended, parentheses will disable "
655       "this warning (e.g. `(a < b) < c'.)");
656
657   union any_node *node = parse_add (lexer, e);
658
659   if (node == NULL)
660     return NULL;
661
662   switch (expr_node_returns (node))
663     {
664     case OP_number:
665     case OP_boolean:
666       {
667         static const struct operator ops[] =
668           {
669             { T_EQUALS, OP_EQ, "numeric equality (`=')" },
670             { T_EQ, OP_EQ, "numeric equality (`EQ')" },
671             { T_GE, OP_GE, "numeric greater-than-or-equal-to (`>=')" },
672             { T_GT, OP_GT, "numeric greater than (`>')" },
673             { T_LE, OP_LE, "numeric less-than-or-equal-to (`<=')" },
674             { T_LT, OP_LT, "numeric less than (`<')" },
675             { T_NE, OP_NE, "numeric inequality (`<>')" },
676           };
677
678         return parse_binary_operators (lexer, e, node, ops,
679                                        sizeof ops / sizeof *ops,
680                                        parse_add, chain_warning);
681       }
682
683     case OP_string:
684       {
685         static const struct operator ops[] =
686           {
687             { T_EQUALS, OP_EQ_STRING, "string equality (`=')" },
688             { T_EQ, OP_EQ_STRING, "string equality (`EQ')" },
689             { T_GE, OP_GE_STRING, "string greater-than-or-equal-to (`>=')" },
690             { T_GT, OP_GT_STRING, "string greater than (`>')" },
691             { T_LE, OP_LE_STRING, "string less-than-or-equal-to (`<=')" },
692             { T_LT, OP_LT_STRING, "string less than (`<')" },
693             { T_NE, OP_NE_STRING, "string inequality (`<>')" },
694           };
695
696         return parse_binary_operators (lexer, e, node, ops,
697                                        sizeof ops / sizeof *ops,
698                                        parse_add, chain_warning);
699       }
700
701     default:
702       return node;
703     }
704 }
705
706 /* Parses the addition and subtraction level. */
707 static union any_node *
708 parse_add (struct lexer *lexer, struct expression *e)
709 {
710   static const struct operator ops[] =
711     {
712       { T_PLUS, OP_ADD, "addition (`+')" },
713       { T_DASH, OP_SUB, "subtraction (`-')" },
714       { T_NEG_NUM, OP_ADD, "subtraction (`-')" },
715     };
716
717   return parse_binary_operators (lexer, e, parse_mul (lexer, e),
718                                  ops, sizeof ops / sizeof *ops,
719                                  parse_mul, NULL);
720 }
721
722 /* Parses the multiplication and division level. */
723 static union any_node *
724 parse_mul (struct lexer *lexer, struct expression *e)
725 {
726   static const struct operator ops[] =
727     {
728       { T_ASTERISK, OP_MUL, "multiplication (`*')" },
729       { T_SLASH, OP_DIV, "division (`/')" },
730     };
731
732   return parse_binary_operators (lexer, e, parse_neg (lexer, e),
733                                  ops, sizeof ops / sizeof *ops,
734                                  parse_neg, NULL);
735 }
736
737 /* Parses the unary minus level. */
738 static union any_node *
739 parse_neg (struct lexer *lexer, struct expression *e)
740 {
741   static const struct operator op = { T_DASH, OP_NEG, "negation (`-')" };
742   return parse_inverting_unary_operator (lexer, e, &op, parse_exp);
743 }
744
745 static union any_node *
746 parse_exp (struct lexer *lexer, struct expression *e)
747 {
748   static const struct operator op =
749     { T_EXP, OP_POW, "exponentiation (`**')" };
750
751   const char *chain_warning =
752     _("The exponentiation operator (`**') is left-associative, "
753       "even though right-associative semantics are more useful.  "
754       "That is, `a**b**c' equals `(a**b)**c', not as `a**(b**c)'.  "
755       "To disable this warning, insert parentheses.");
756
757   union any_node *lhs, *node;
758   bool negative = false;
759
760   if (lex_token (lexer) == T_NEG_NUM)
761     {
762       lhs = expr_allocate_number (e, -lex_tokval (lexer));
763       negative = true;
764       lex_get (lexer);
765     }
766   else
767     lhs = parse_primary (lexer, e);
768
769   node = parse_binary_operators (lexer, e, lhs, &op, 1,
770                                   parse_primary, chain_warning);
771   return negative ? expr_allocate_unary (e, OP_NEG, node) : node;
772 }
773
774 /* Parses system variables. */
775 static union any_node *
776 parse_sysvar (struct lexer *lexer, struct expression *e)
777 {
778   if (lex_match_id (lexer, "$CASENUM"))
779     return expr_allocate_nullary (e, OP_CASENUM);
780   else if (lex_match_id (lexer, "$DATE"))
781     {
782       static const char *months[12] =
783         {
784           "JAN", "FEB", "MAR", "APR", "MAY", "JUN",
785           "JUL", "AUG", "SEP", "OCT", "NOV", "DEC",
786         };
787
788       time_t last_proc_time = time_of_last_procedure (e->ds);
789       struct tm *time;
790       char temp_buf[10];
791       struct substring s;
792
793       time = localtime (&last_proc_time);
794       sprintf (temp_buf, "%02d %s %02d", abs (time->tm_mday) % 100,
795                months[abs (time->tm_mon) % 12], abs (time->tm_year) % 100);
796
797       ss_alloc_substring (&s, ss_cstr (temp_buf));
798       return expr_allocate_string (e, s);
799     }
800   else if (lex_match_id (lexer, "$TRUE"))
801     return expr_allocate_boolean (e, 1.0);
802   else if (lex_match_id (lexer, "$FALSE"))
803     return expr_allocate_boolean (e, 0.0);
804   else if (lex_match_id (lexer, "$SYSMIS"))
805     return expr_allocate_number (e, SYSMIS);
806   else if (lex_match_id (lexer, "$JDATE"))
807     {
808       time_t time = time_of_last_procedure (e->ds);
809       struct tm *tm = localtime (&time);
810       return expr_allocate_number (e, expr_ymd_to_ofs (tm->tm_year + 1900,
811                                                        tm->tm_mon + 1,
812                                                        tm->tm_mday));
813     }
814   else if (lex_match_id (lexer, "$TIME"))
815     {
816       time_t time = time_of_last_procedure (e->ds);
817       struct tm *tm = localtime (&time);
818       return expr_allocate_number (e,
819                                    expr_ymd_to_date (tm->tm_year + 1900,
820                                                      tm->tm_mon + 1,
821                                                      tm->tm_mday)
822                                    + tm->tm_hour * 60 * 60.
823                                    + tm->tm_min * 60.
824                                    + tm->tm_sec);
825     }
826   else if (lex_match_id (lexer, "$LENGTH"))
827     return expr_allocate_number (e, settings_get_viewlength ());
828   else if (lex_match_id (lexer, "$WIDTH"))
829     return expr_allocate_number (e, settings_get_viewwidth ());
830   else
831     {
832       msg (SE, _("Unknown system variable %s."), lex_tokcstr (lexer));
833       return NULL;
834     }
835 }
836
837 /* Parses numbers, varnames, etc. */
838 static union any_node *
839 parse_primary (struct lexer *lexer, struct expression *e)
840 {
841   switch (lex_token (lexer))
842     {
843     case T_ID:
844       if (lex_next_token (lexer, 1) == T_LPAREN)
845         {
846           /* An identifier followed by a left parenthesis may be
847              a vector element reference.  If not, it's a function
848              call. */
849           if (e->ds != NULL && dict_lookup_vector (dataset_dict (e->ds), lex_tokcstr (lexer)) != NULL)
850             return parse_vector_element (lexer, e);
851           else
852             return parse_function (lexer, e);
853         }
854       else if (lex_tokcstr (lexer)[0] == '$')
855         {
856           /* $ at the beginning indicates a system variable. */
857           return parse_sysvar (lexer, e);
858         }
859       else if (e->ds != NULL && dict_lookup_var (dataset_dict (e->ds), lex_tokcstr (lexer)))
860         {
861           /* It looks like a user variable.
862              (It could be a format specifier, but we'll assume
863              it's a variable unless proven otherwise. */
864           return allocate_unary_variable (e, parse_variable (lexer, dataset_dict (e->ds)));
865         }
866       else
867         {
868           /* Try to parse it as a format specifier. */
869           struct fmt_spec fmt;
870           bool ok;
871
872           msg_disable ();
873           ok = parse_format_specifier (lexer, &fmt);
874           msg_enable ();
875
876           if (ok)
877             return expr_allocate_format (e, &fmt);
878
879           /* All attempts failed. */
880           msg (SE, _("Unknown identifier %s."), lex_tokcstr (lexer));
881           return NULL;
882         }
883       break;
884
885     case T_POS_NUM:
886     case T_NEG_NUM:
887       {
888         union any_node *node = expr_allocate_number (e, lex_tokval (lexer) );
889         lex_get (lexer);
890         return node;
891       }
892
893     case T_STRING:
894       {
895         const char *dict_encoding;
896         union any_node *node;
897         char *s;
898
899         dict_encoding = (e->ds != NULL
900                          ? dict_get_encoding (dataset_dict (e->ds))
901                          : "UTF-8");
902         s = recode_string_pool (dict_encoding, "UTF-8", lex_tokcstr (lexer),
903                            ss_length (lex_tokss (lexer)), e->expr_pool);
904         node = expr_allocate_string (e, ss_cstr (s));
905
906         lex_get (lexer);
907         return node;
908       }
909
910     case T_LPAREN:
911       {
912         union any_node *node;
913         lex_get (lexer);
914         node = parse_or (lexer, e);
915         if (node != NULL && !lex_force_match (lexer, T_RPAREN))
916           return NULL;
917         return node;
918       }
919
920     default:
921       lex_error (lexer, NULL);
922       return NULL;
923     }
924 }
925
926 static union any_node *
927 parse_vector_element (struct lexer *lexer, struct expression *e)
928 {
929   const struct vector *vector;
930   union any_node *element;
931
932   /* Find vector, skip token.
933      The caller must already have verified that the current token
934      is the name of a vector. */
935   vector = dict_lookup_vector (dataset_dict (e->ds), lex_tokcstr (lexer));
936   assert (vector != NULL);
937   lex_get (lexer);
938
939   /* Skip left parenthesis token.
940      The caller must have verified that the lookahead is a left
941      parenthesis. */
942   assert (lex_token (lexer) == T_LPAREN);
943   lex_get (lexer);
944
945   element = parse_or (lexer, e);
946   if (!type_coercion (e, OP_number, &element, "vector indexing")
947       || !lex_match (lexer, T_RPAREN))
948     return NULL;
949
950   return expr_allocate_binary (e, (vector_get_type (vector) == VAL_NUMERIC
951                                    ? OP_VEC_ELEM_NUM : OP_VEC_ELEM_STR),
952                                element, expr_allocate_vector (e, vector));
953 }
954 \f
955 /* Individual function parsing. */
956
957 const struct operation operations[OP_first + OP_cnt] = {
958 #include "parse.inc"
959 };
960
961 static bool
962 word_matches (const char **test, const char **name)
963 {
964   size_t test_len = strcspn (*test, ".");
965   size_t name_len = strcspn (*name, ".");
966   if (test_len == name_len)
967     {
968       if (buf_compare_case (*test, *name, test_len))
969         return false;
970     }
971   else if (test_len < 3 || test_len > name_len)
972     return false;
973   else
974     {
975       if (buf_compare_case (*test, *name, test_len))
976         return false;
977     }
978
979   *test += test_len;
980   *name += name_len;
981   if (**test != **name)
982     return false;
983
984   if (**test == '.')
985     {
986       (*test)++;
987       (*name)++;
988     }
989   return true;
990 }
991
992 static int
993 compare_names (const char *test, const char *name, bool abbrev_ok)
994 {
995   if (!abbrev_ok)
996     return true;
997
998   for (;;)
999     {
1000       if (!word_matches (&test, &name))
1001         return true;
1002       if (*name == '\0' && *test == '\0')
1003         return false;
1004     }
1005 }
1006
1007 static int
1008 compare_strings (const char *test, const char *name, bool abbrev_ok UNUSED)
1009 {
1010   return c_strcasecmp (test, name);
1011 }
1012
1013 static bool
1014 lookup_function_helper (const char *name,
1015                         int (*compare) (const char *test, const char *name,
1016                                         bool abbrev_ok),
1017                         const struct operation **first,
1018                         const struct operation **last)
1019 {
1020   const struct operation *f;
1021
1022   for (f = operations + OP_function_first;
1023        f <= operations + OP_function_last; f++)
1024     if (!compare (name, f->name, !(f->flags & OPF_NO_ABBREV)))
1025       {
1026         *first = f;
1027
1028         while (f <= operations + OP_function_last
1029                && !compare (name, f->name, !(f->flags & OPF_NO_ABBREV)))
1030           f++;
1031         *last = f;
1032
1033         return true;
1034       }
1035
1036   return false;
1037 }
1038
1039 static bool
1040 lookup_function (const char *name,
1041                  const struct operation **first,
1042                  const struct operation **last)
1043 {
1044   *first = *last = NULL;
1045   return (lookup_function_helper (name, compare_strings, first, last)
1046           || lookup_function_helper (name, compare_names, first, last));
1047 }
1048
1049 static int
1050 extract_min_valid (const char *s)
1051 {
1052   char *p = strrchr (s, '.');
1053   if (p == NULL
1054       || p[1] < '0' || p[1] > '9'
1055       || strspn (p + 1, "0123456789") != strlen (p + 1))
1056     return -1;
1057   *p = '\0';
1058   return atoi (p + 1);
1059 }
1060
1061 static atom_type
1062 function_arg_type (const struct operation *f, size_t arg_idx)
1063 {
1064   assert (arg_idx < f->arg_cnt || (f->flags & OPF_ARRAY_OPERAND));
1065
1066   return f->args[arg_idx < f->arg_cnt ? arg_idx : f->arg_cnt - 1];
1067 }
1068
1069 static bool
1070 match_function (union any_node **args, int arg_cnt, const struct operation *f)
1071 {
1072   size_t i;
1073
1074   if (arg_cnt < f->arg_cnt
1075       || (arg_cnt > f->arg_cnt && (f->flags & OPF_ARRAY_OPERAND) == 0)
1076       || arg_cnt - (f->arg_cnt - 1) < f->array_min_elems)
1077     return false;
1078
1079   for (i = 0; i < arg_cnt; i++)
1080     if (!is_coercible (function_arg_type (f, i), &args[i]))
1081       return false;
1082
1083   return true;
1084 }
1085
1086 static void
1087 coerce_function_args (struct expression *e, const struct operation *f,
1088                       union any_node **args, size_t arg_cnt)
1089 {
1090   int i;
1091
1092   for (i = 0; i < arg_cnt; i++)
1093     type_coercion_assert (e, function_arg_type (f, i), &args[i]);
1094 }
1095
1096 static bool
1097 validate_function_args (const struct operation *f, int arg_cnt, int min_valid)
1098 {
1099   int array_arg_cnt = arg_cnt - (f->arg_cnt - 1);
1100   if (array_arg_cnt < f->array_min_elems)
1101     {
1102       msg (SE, _("%s must have at least %d arguments in list."),
1103            f->prototype, f->array_min_elems);
1104       return false;
1105     }
1106
1107   if ((f->flags & OPF_ARRAY_OPERAND)
1108       && array_arg_cnt % f->array_granularity != 0)
1109     {
1110       if (f->array_granularity == 2)
1111         msg (SE, _("%s must have an even number of arguments in list."),
1112              f->prototype);
1113       else
1114         msg (SE, _("%s must have multiple of %d arguments in list."),
1115              f->prototype, f->array_granularity);
1116       return false;
1117     }
1118
1119   if (min_valid != -1)
1120     {
1121       if (f->array_min_elems == 0)
1122         {
1123           assert ((f->flags & OPF_MIN_VALID) == 0);
1124           msg (SE, _("%s function does not accept a minimum valid "
1125                      "argument count."), f->prototype);
1126           return false;
1127         }
1128       else
1129         {
1130           assert (f->flags & OPF_MIN_VALID);
1131           if (array_arg_cnt < f->array_min_elems)
1132             {
1133               msg (SE, _("%s requires at least %d valid arguments in list."),
1134                    f->prototype, f->array_min_elems);
1135               return false;
1136             }
1137           else if (min_valid > array_arg_cnt)
1138             {
1139               msg (SE, _("With %s, "
1140                          "using minimum valid argument count of %d "
1141                          "does not make sense when passing only %d "
1142                          "arguments in list."),
1143                    f->prototype, min_valid, array_arg_cnt);
1144               return false;
1145             }
1146         }
1147     }
1148
1149   return true;
1150 }
1151
1152 static void
1153 add_arg (union any_node ***args, int *arg_cnt, int *arg_cap,
1154          union any_node *arg)
1155 {
1156   if (*arg_cnt >= *arg_cap)
1157     {
1158       *arg_cap += 8;
1159       *args = xrealloc (*args, sizeof **args * *arg_cap);
1160     }
1161
1162   (*args)[(*arg_cnt)++] = arg;
1163 }
1164
1165 static void
1166 put_invocation (struct string *s,
1167                 const char *func_name, union any_node **args, size_t arg_cnt)
1168 {
1169   size_t i;
1170
1171   ds_put_format (s, "%s(", func_name);
1172   for (i = 0; i < arg_cnt; i++)
1173     {
1174       if (i > 0)
1175         ds_put_cstr (s, ", ");
1176       ds_put_cstr (s, operations[expr_node_returns (args[i])].prototype);
1177     }
1178   ds_put_byte (s, ')');
1179 }
1180
1181 static void
1182 no_match (const char *func_name,
1183           union any_node **args, size_t arg_cnt,
1184           const struct operation *first, const struct operation *last)
1185 {
1186   struct string s;
1187   const struct operation *f;
1188
1189   ds_init_empty (&s);
1190
1191   if (last - first == 1)
1192     {
1193       ds_put_format (&s, _("Type mismatch invoking %s as "), first->prototype);
1194       put_invocation (&s, func_name, args, arg_cnt);
1195     }
1196   else
1197     {
1198       ds_put_cstr (&s, _("Function invocation "));
1199       put_invocation (&s, func_name, args, arg_cnt);
1200       ds_put_cstr (&s, _(" does not match any known function.  Candidates are:"));
1201
1202       for (f = first; f < last; f++)
1203         ds_put_format (&s, "\n%s", f->prototype);
1204     }
1205   ds_put_byte (&s, '.');
1206
1207   msg (SE, "%s", ds_cstr (&s));
1208
1209   ds_destroy (&s);
1210 }
1211
1212 static union any_node *
1213 parse_function (struct lexer *lexer, struct expression *e)
1214 {
1215   int min_valid;
1216   const struct operation *f, *first, *last;
1217
1218   union any_node **args = NULL;
1219   int arg_cnt = 0;
1220   int arg_cap = 0;
1221
1222   struct string func_name;
1223
1224   union any_node *n;
1225
1226   ds_init_substring (&func_name, lex_tokss (lexer));
1227   min_valid = extract_min_valid (lex_tokcstr (lexer));
1228   if (!lookup_function (lex_tokcstr (lexer), &first, &last))
1229     {
1230       msg (SE, _("No function or vector named %s."), lex_tokcstr (lexer));
1231       ds_destroy (&func_name);
1232       return NULL;
1233     }
1234
1235   lex_get (lexer);
1236   if (!lex_force_match (lexer, T_LPAREN))
1237     {
1238       ds_destroy (&func_name);
1239       return NULL;
1240     }
1241
1242   args = NULL;
1243   arg_cnt = arg_cap = 0;
1244   if (lex_token (lexer) != T_RPAREN)
1245     for (;;)
1246       {
1247         if (lex_token (lexer) == T_ID
1248             && lex_next_token (lexer, 1) == T_TO)
1249           {
1250             const struct variable **vars;
1251             size_t var_cnt;
1252             size_t i;
1253
1254             if (!parse_variables_const (lexer, dataset_dict (e->ds), &vars, &var_cnt, PV_SINGLE))
1255               goto fail;
1256             for (i = 0; i < var_cnt; i++)
1257               add_arg (&args, &arg_cnt, &arg_cap,
1258                        allocate_unary_variable (e, vars[i]));
1259             free (vars);
1260           }
1261         else
1262           {
1263             union any_node *arg = parse_or (lexer, e);
1264             if (arg == NULL)
1265               goto fail;
1266
1267             add_arg (&args, &arg_cnt, &arg_cap, arg);
1268           }
1269         if (lex_match (lexer, T_RPAREN))
1270           break;
1271         else if (!lex_match (lexer, T_COMMA))
1272           {
1273             lex_error_expecting (lexer, "`,'", "`)'", NULL_SENTINEL);
1274             goto fail;
1275           }
1276       }
1277
1278   for (f = first; f < last; f++)
1279     if (match_function (args, arg_cnt, f))
1280       break;
1281   if (f >= last)
1282     {
1283       no_match (ds_cstr (&func_name), args, arg_cnt, first, last);
1284       goto fail;
1285     }
1286
1287   coerce_function_args (e, f, args, arg_cnt);
1288   if (!validate_function_args (f, arg_cnt, min_valid))
1289     goto fail;
1290
1291   if ((f->flags & OPF_EXTENSION) && settings_get_syntax () == COMPATIBLE)
1292     msg (SW, _("%s is a PSPP extension."), f->prototype);
1293   if (f->flags & OPF_UNIMPLEMENTED)
1294     {
1295       msg (SE, _("%s is not yet implemented."), f->prototype);
1296       goto fail;
1297     }
1298   if ((f->flags & OPF_PERM_ONLY) &&
1299       proc_in_temporary_transformations (e->ds))
1300     {
1301       msg (SE, _("%s may not appear after TEMPORARY."), f->prototype);
1302       goto fail;
1303     }
1304
1305   n = expr_allocate_composite (e, f - operations, args, arg_cnt);
1306   n->composite.min_valid = min_valid != -1 ? min_valid : f->array_min_elems;
1307
1308   if (n->type == OP_LAG_Vn || n->type == OP_LAG_Vs)
1309     dataset_need_lag (e->ds, 1);
1310   else if (n->type == OP_LAG_Vnn || n->type == OP_LAG_Vsn)
1311     {
1312       int n_before;
1313       assert (n->composite.arg_cnt == 2);
1314       assert (n->composite.args[1]->type == OP_pos_int);
1315       n_before = n->composite.args[1]->integer.i;
1316       dataset_need_lag (e->ds, n_before);
1317     }
1318
1319   free (args);
1320   ds_destroy (&func_name);
1321   return n;
1322
1323 fail:
1324   free (args);
1325   ds_destroy (&func_name);
1326   return NULL;
1327 }
1328 \f
1329 /* Utility functions. */
1330
1331 static struct expression *
1332 expr_create (struct dataset *ds)
1333 {
1334   struct pool *pool = pool_create ();
1335   struct expression *e = pool_alloc (pool, sizeof *e);
1336   e->expr_pool = pool;
1337   e->ds = ds;
1338   e->eval_pool = pool_create_subpool (e->expr_pool);
1339   e->ops = NULL;
1340   e->op_types = NULL;
1341   e->op_cnt = e->op_cap = 0;
1342   return e;
1343 }
1344
1345 atom_type
1346 expr_node_returns (const union any_node *n)
1347 {
1348   assert (n != NULL);
1349   assert (is_operation (n->type));
1350   if (is_atom (n->type))
1351     return n->type;
1352   else if (is_composite (n->type))
1353     return operations[n->type].returns;
1354   else
1355     NOT_REACHED ();
1356 }
1357
1358 static const char *
1359 atom_type_name (atom_type type)
1360 {
1361   assert (is_atom (type));
1362   return operations[type].name;
1363 }
1364
1365 union any_node *
1366 expr_allocate_nullary (struct expression *e, operation_type op)
1367 {
1368   return expr_allocate_composite (e, op, NULL, 0);
1369 }
1370
1371 union any_node *
1372 expr_allocate_unary (struct expression *e, operation_type op,
1373                      union any_node *arg0)
1374 {
1375   return expr_allocate_composite (e, op, &arg0, 1);
1376 }
1377
1378 union any_node *
1379 expr_allocate_binary (struct expression *e, operation_type op,
1380                       union any_node *arg0, union any_node *arg1)
1381 {
1382   union any_node *args[2];
1383   args[0] = arg0;
1384   args[1] = arg1;
1385   return expr_allocate_composite (e, op, args, 2);
1386 }
1387
1388 static bool
1389 is_valid_node (union any_node *n)
1390 {
1391   const struct operation *op;
1392   size_t i;
1393
1394   assert (n != NULL);
1395   assert (is_operation (n->type));
1396   op = &operations[n->type];
1397
1398   if (!is_atom (n->type))
1399     {
1400       struct composite_node *c = &n->composite;
1401
1402       assert (is_composite (n->type));
1403       assert (c->arg_cnt >= op->arg_cnt);
1404       for (i = 0; i < op->arg_cnt; i++)
1405         assert (is_compatible (op->args[i], expr_node_returns (c->args[i])));
1406       if (c->arg_cnt > op->arg_cnt && !is_operator (n->type))
1407         {
1408           assert (op->flags & OPF_ARRAY_OPERAND);
1409           for (i = 0; i < c->arg_cnt; i++)
1410             assert (is_compatible (op->args[op->arg_cnt - 1],
1411                                    expr_node_returns (c->args[i])));
1412         }
1413     }
1414
1415   return true;
1416 }
1417
1418 union any_node *
1419 expr_allocate_composite (struct expression *e, operation_type op,
1420                          union any_node **args, size_t arg_cnt)
1421 {
1422   union any_node *n;
1423   size_t i;
1424
1425   n = pool_alloc (e->expr_pool, sizeof n->composite);
1426   n->type = op;
1427   n->composite.arg_cnt = arg_cnt;
1428   n->composite.args = pool_alloc (e->expr_pool,
1429                                   sizeof *n->composite.args * arg_cnt);
1430   for (i = 0; i < arg_cnt; i++)
1431     {
1432       if (args[i] == NULL)
1433         return NULL;
1434       n->composite.args[i] = args[i];
1435     }
1436   memcpy (n->composite.args, args, sizeof *n->composite.args * arg_cnt);
1437   n->composite.min_valid = 0;
1438   assert (is_valid_node (n));
1439   return n;
1440 }
1441
1442 union any_node *
1443 expr_allocate_number (struct expression *e, double d)
1444 {
1445   union any_node *n = pool_alloc (e->expr_pool, sizeof n->number);
1446   n->type = OP_number;
1447   n->number.n = d;
1448   return n;
1449 }
1450
1451 union any_node *
1452 expr_allocate_boolean (struct expression *e, double b)
1453 {
1454   union any_node *n = pool_alloc (e->expr_pool, sizeof n->number);
1455   assert (b == 0.0 || b == 1.0 || b == SYSMIS);
1456   n->type = OP_boolean;
1457   n->number.n = b;
1458   return n;
1459 }
1460
1461 union any_node *
1462 expr_allocate_integer (struct expression *e, int i)
1463 {
1464   union any_node *n = pool_alloc (e->expr_pool, sizeof n->integer);
1465   n->type = OP_integer;
1466   n->integer.i = i;
1467   return n;
1468 }
1469
1470 union any_node *
1471 expr_allocate_pos_int (struct expression *e, int i)
1472 {
1473   union any_node *n = pool_alloc (e->expr_pool, sizeof n->integer);
1474   assert (i > 0);
1475   n->type = OP_pos_int;
1476   n->integer.i = i;
1477   return n;
1478 }
1479
1480 union any_node *
1481 expr_allocate_vector (struct expression *e, const struct vector *vector)
1482 {
1483   union any_node *n = pool_alloc (e->expr_pool, sizeof n->vector);
1484   n->type = OP_vector;
1485   n->vector.v = vector;
1486   return n;
1487 }
1488
1489 union any_node *
1490 expr_allocate_string (struct expression *e, struct substring s)
1491 {
1492   union any_node *n = pool_alloc (e->expr_pool, sizeof n->string);
1493   n->type = OP_string;
1494   n->string.s = s;
1495   return n;
1496 }
1497
1498 union any_node *
1499 expr_allocate_variable (struct expression *e, const struct variable *v)
1500 {
1501   union any_node *n = pool_alloc (e->expr_pool, sizeof n->variable);
1502   n->type = var_is_numeric (v) ? OP_num_var : OP_str_var;
1503   n->variable.v = v;
1504   return n;
1505 }
1506
1507 union any_node *
1508 expr_allocate_format (struct expression *e, const struct fmt_spec *format)
1509 {
1510   union any_node *n = pool_alloc (e->expr_pool, sizeof n->format);
1511   n->type = OP_format;
1512   n->format.f = *format;
1513   return n;
1514 }
1515
1516 /* Allocates a unary composite node that represents the value of
1517    variable V in expression E. */
1518 static union any_node *
1519 allocate_unary_variable (struct expression *e, const struct variable *v)
1520 {
1521   assert (v != NULL);
1522   return expr_allocate_unary (e, var_is_numeric (v) ? OP_NUM_VAR : OP_STR_VAR,
1523                               expr_allocate_variable (e, v));
1524 }
1525 \f
1526 /* Export function details to other modules. */
1527
1528 /* Returns the operation structure for the function with the
1529    given IDX. */
1530 const struct operation *
1531 expr_get_function (size_t idx)
1532 {
1533   assert (idx < OP_function_cnt);
1534   return &operations[OP_function_first + idx];
1535 }
1536
1537 /* Returns the number of expression functions. */
1538 size_t
1539 expr_get_function_cnt (void)
1540 {
1541   return OP_function_cnt;
1542 }
1543
1544 /* Returns the name of operation OP. */
1545 const char *
1546 expr_operation_get_name (const struct operation *op)
1547 {
1548   return op->name;
1549 }
1550
1551 /* Returns the human-readable prototype for operation OP. */
1552 const char *
1553 expr_operation_get_prototype (const struct operation *op)
1554 {
1555   return op->prototype;
1556 }
1557
1558 /* Returns the number of arguments for operation OP. */
1559 int
1560 expr_operation_get_arg_cnt (const struct operation *op)
1561 {
1562   return op->arg_cnt;
1563 }