Fixed bug in single arity version of LAG.
[pspp] / src / expressions / optimize.inc.pl
1 do 'generate.pl';
2
3 sub generate_output {
4     for my $opname (@order) {
5         my ($op) = $ops{$opname};
6
7         if (!$op->{OPTIMIZABLE} || $op->{UNIMPLEMENTED}) {
8             print "case $opname:\n";
9             print "  abort ();\n\n";
10             next;
11         }
12
13         my (@decls);
14         my ($arg_idx) = 0;
15         for my $arg (@{$op->{ARGS}}) {
16             my ($decl);
17             my ($name) = $arg->{NAME};
18             my ($type) = $arg->{TYPE};
19             my ($ctype) = c_type ($type);
20             my ($idx) = $arg->{IDX};
21             if (!defined ($idx)) {
22                 my ($func) = "get_$type->{ATOM}_arg";
23                 push (@decls, "${ctype}arg_$name = $func (node, $arg_idx)");
24             } else {
25                 my ($decl) = "size_t arg_$idx = node->arg_cnt";
26                 $decl .= " - $arg_idx" if $arg_idx;
27                 push (@decls, $decl);
28
29                 push (@decls, "${ctype}*arg_$name = "
30                       . "get_$type->{ATOM}_args "
31                       . " (node, $arg_idx, arg_$idx, e)");
32             }
33             $arg_idx++;
34         }
35
36         my ($sysmis_cond) = make_sysmis_decl ($op, "node->min_valid");
37         push (@decls, $sysmis_cond) if defined $sysmis_cond;
38
39         my (@args);
40         for my $arg (@{$op->{ARGS}}) {
41             push (@args, "arg_$arg->{NAME}");
42             if (defined $arg->{IDX}) {
43                 my ($idx) = "arg_$arg->{IDX}";
44                 $idx .= " / $arg->{TIMES}" if $arg->{TIMES} != 1;
45                 push (@args, $idx);
46             }
47         }
48         for my $aux (@{$op->{AUX}}) {
49             my ($type) = $aux->{TYPE};
50             if ($type->{ROLE} eq 'leaf') {
51                 my ($func) = "get_$type->{ATOM}_arg";
52                 push (@args, "$func (node, $arg_idx)");
53                 $arg_idx++;
54             } elsif ($type->{ROLE} eq 'fixed') {
55                 push (@args, $type->{FIXED_VALUE});
56             } else {
57                 die;
58             }
59         }
60
61         my ($result) = "eval_$op->{OPNAME} (" . join (', ', @args) . ")";
62         if (@decls && defined ($sysmis_cond)) {
63             my ($miss_ret) = $op->{RETURNS}{MISSING_VALUE};
64             push (@decls, c_type ($op->{RETURNS}) . "result = "
65                   . "force_sysmis ? $miss_ret : $result");
66             $result = "result";
67         }
68
69         print "case $opname:\n";
70         my ($alloc_func) = "expr_allocate_$op->{RETURNS}{NAME}";
71         if (@decls) {
72             print "  {\n";
73             print "    $_;\n" foreach @decls;
74             print "    return $alloc_func (e, $result);\n";
75             print "  }\n";
76         } else {
77             print "  return $alloc_func (e, $result);\n";
78         }
79         print "\n";
80     }
81 }