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 }