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