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