session: Fix two memory leaks.
[pspp] / src / language / expressions / parse.incpl
1 use strict;
2 use warnings 'all';
3
4 do 'generate.pl';
5 our (@types, @order, %ops);
6
7 sub generate_output {
8     my (@members) = ("\"\"", "\"\"", 0, 0, 0, "{}", 0, 0);
9     print "{", join (', ', @members), "},\n";
10
11     for my $type (@types) {
12         next if $type->{ROLE} eq 'fixed';
13
14         my ($human_name) = $type->{HUMAN_NAME};
15         $human_name = $type->{NAME} if !defined $human_name;
16         
17         my (@members) = ("\"$type->{NAME}\"", "\"$human_name\"",
18                          0, "OP_$type->{NAME}", 0, "{}", 0, 0);
19         print "{", join (', ', @members), "},\n";
20     }
21
22     for my $opname (@order) {
23         my ($op) = $ops{$opname};
24
25         my (@members);
26
27         push (@members, "\"$op->{NAME}\"");
28
29         if ($op->{CATEGORY} eq 'function') {
30             my (@args, @opt_args);
31             for my $arg (@{$op->{ARGS}}) {
32                 push (@args, $arg->{TYPE}{HUMAN_NAME}) if !defined $arg->{IDX};
33             }
34
35             if (my ($array) = array_arg ($op)) {
36                 if (!defined $op->{MIN_VALID}) {
37                     my (@array_args);
38                     for (my $i = 0; $i < $array->{TIMES}; $i++) {
39                         push (@array_args, $array->{TYPE}{HUMAN_NAME});
40                     }
41                     push (@args, @array_args);
42                     @opt_args = @array_args;
43                 } else {
44                     for (my $i = 0; $i < $op->{MIN_VALID}; $i++) {
45                         push (@args, $array->{TYPE}{HUMAN_NAME});
46                     }
47                     push (@opt_args, $array->{TYPE}{HUMAN_NAME});
48                 }
49             }
50             my ($human) = "$op->{NAME}(" . join (', ', @args);
51             $human .= '[, ' . join (', ', @opt_args) . ']...' if @opt_args;
52             $human .= ')';
53             push (@members, "\"$human\"");
54         } else {
55             push (@members, "NULL");
56         }
57
58         my (@flags);
59         push (@flags, "OPF_ABSORB_MISS") if defined $op->{ABSORB_MISS};
60         push (@flags, "OPF_ARRAY_OPERAND") if array_arg ($op);
61         push (@flags, "OPF_MIN_VALID") if defined $op->{MIN_VALID};
62         push (@flags, "OPF_NONOPTIMIZABLE") if !$op->{OPTIMIZABLE};
63         push (@flags, "OPF_EXTENSION") if $op->{EXTENSION};
64         push (@flags, "OPF_UNIMPLEMENTED") if $op->{UNIMPLEMENTED};
65         push (@flags, "OPF_PERM_ONLY") if $op->{PERM_ONLY};
66         push (@flags, "OPF_NO_ABBREV") if $op->{NO_ABBREV};
67         push (@members, @flags ? join (' | ', @flags) : 0);
68
69         push (@members, "OP_$op->{RETURNS}{NAME}");
70
71         push (@members, scalar (@{$op->{ARGS}}));
72
73         my (@arg_types) = map ("OP_$_->{TYPE}{NAME}", @{$op->{ARGS}});
74         push (@members, "{" . join (', ', @arg_types) . "}");
75
76         push (@members, $op->{MIN_VALID} || 0);
77
78         push (@members, array_arg ($op) ? ${array_arg ($op)}{TIMES} : 0);
79
80         print "{", join (', ', @members), "},\n";
81     }
82 }