From 312d3d2bd75e1589256d1115ff13363419ff4616 Mon Sep 17 00:00:00 2001 From: Ben Pfaff Date: Sat, 20 Feb 2016 16:43:21 -0800 Subject: [PATCH] expressions: Merge all the little generator programs into generate.pl. The little generator programs had a bizarre flaw: they silently produced no output if there was an error parsing their input. This was due to the use of the Perl "do" construct for executing generate.pl, which just returns the message if the nested code exits with "die". I know that the generators actually worked better at one point... Anyway, the simplest solution seems to be to just merge all the little output generator programs into generate.pl. It doesn't make the code any harder to understand, so that's what this commit does. --- src/language/expressions/automake.mk | 18 +- src/language/expressions/evaluate.hpl | 37 --- src/language/expressions/evaluate.incpl | 85 ------ src/language/expressions/generate.pl | 343 +++++++++++++++++++++++- src/language/expressions/operations.hpl | 58 ---- src/language/expressions/optimize.incpl | 85 ------ src/language/expressions/parse.incpl | 82 ------ 7 files changed, 341 insertions(+), 367 deletions(-) delete mode 100644 src/language/expressions/evaluate.hpl delete mode 100644 src/language/expressions/evaluate.incpl delete mode 100644 src/language/expressions/operations.hpl delete mode 100644 src/language/expressions/optimize.incpl delete mode 100644 src/language/expressions/parse.incpl diff --git a/src/language/expressions/automake.mk b/src/language/expressions/automake.mk index cc2ed229a7..58e64327e7 100644 --- a/src/language/expressions/automake.mk +++ b/src/language/expressions/automake.mk @@ -9,7 +9,7 @@ language_expressions_sources = \ src/language/expressions/private.h \ src/language/expressions/public.h -expressions_built_sources= \ +expressions_built_sources = \ src/language/expressions/evaluate.h \ src/language/expressions/evaluate.inc \ src/language/expressions/operations.h \ @@ -21,21 +21,13 @@ CLEANFILES += $(expressions_built_sources) helpers = src/language/expressions/generate.pl \ src/language/expressions/operations.def +EXTRA_DIST += $(helpers) $(expressions_built_sources): $(helpers) -EXTRA_DIST += $(helpers) $(expressions_built_sources:=pl) + $(AV_V_GEN)$(MKDIR_P) `dirname $@` && \ + $(PERL) $< -o $@ -i $(top_srcdir)/src/language/expressions/operations.def + AM_CPPFLAGS += -I$(top_builddir)/src/language/expressions \ -I$(top_srcdir)/src/language/expressions -SUFFIXES += .h .hpl .inc .incpl - -generate_from_pl = $(MKDIR_P) `dirname $@` && \ - $(PERL) -I $(top_srcdir)/src/language/expressions $< -o $@ -i $(top_srcdir)/src/language/expressions/operations.def - -.hpl.h: - $(AM_V_GEN)$(generate_from_pl) - -.incpl.inc: - $(AM_V_GEN)$(generate_from_pl) - EXTRA_DIST += src/language/expressions/TODO diff --git a/src/language/expressions/evaluate.hpl b/src/language/expressions/evaluate.hpl deleted file mode 100644 index c26a7cc9c6..0000000000 --- a/src/language/expressions/evaluate.hpl +++ /dev/null @@ -1,37 +0,0 @@ -use strict; -use warnings 'all'; - -do 'generate.pl'; - -our (%ops); -our (@order); -sub generate_output { - print "#include \"helpers.h\"\n\n"; - - for my $opname (@order) { - my ($op) = $ops{$opname}; - next if $op->{UNIMPLEMENTED}; - - my (@args); - for my $arg (@{$op->{ARGS}}) { - if (!defined $arg->{IDX}) { - push (@args, c_type ($arg->{TYPE}) . $arg->{NAME}); - } else { - push (@args, c_type ($arg->{TYPE}) . "$arg->{NAME}" . "[]"); - push (@args, "size_t $arg->{IDX}"); - } - } - for my $aux (@{$op->{AUX}}) { - push (@args, c_type ($aux->{TYPE}) . $aux->{NAME}); - } - push (@args, "void") if !@args; - - my ($statements) = $op->{BLOCK} || " return $op->{EXPRESSION};\n"; - - print "static inline ", c_type ($op->{RETURNS}), "\n"; - print "eval_$opname (", join (', ', @args), ")\n"; - print "{\n"; - print "$statements"; - print "}\n\n"; - } -} diff --git a/src/language/expressions/evaluate.incpl b/src/language/expressions/evaluate.incpl deleted file mode 100644 index e2fccab8d5..0000000000 --- a/src/language/expressions/evaluate.incpl +++ /dev/null @@ -1,85 +0,0 @@ -use strict; -use warnings 'all'; - -do 'generate.pl'; - -our (@order); -our (%ops); - -sub generate_output { - for my $opname (@order) { - my ($op) = $ops{$opname}; - - if ($op->{UNIMPLEMENTED}) { - print "case $opname:\n"; - print " NOT_REACHED ();\n\n"; - next; - } - - my (@decls); - my (@args); - for my $arg (@{$op->{ARGS}}) { - my ($name) = $arg->{NAME}; - my ($type) = $arg->{TYPE}; - my ($c_type) = c_type ($type); - my ($idx) = $arg->{IDX}; - push (@args, "arg_$arg->{NAME}"); - if (!defined ($idx)) { - my ($decl) = "${c_type}arg_$name"; - if ($type->{ROLE} eq 'any') { - unshift (@decls, "$decl = *--$type->{STACK}"); - } elsif ($type->{ROLE} eq 'leaf') { - push (@decls, "$decl = op++->$type->{ATOM}"); - } else { - die; - } - } else { - my ($stack) = $type->{STACK}; - defined $stack or die; - unshift (@decls, - "$c_type*arg_$arg->{NAME} = $stack -= arg_$idx"); - unshift (@decls, "size_t arg_$arg->{IDX} = op++->integer"); - - my ($idx) = "arg_$idx"; - if ($arg->{TIMES} != 1) { - $idx .= " / $arg->{TIMES}"; - } - push (@args, $idx); - } - } - for my $aux (@{$op->{AUX}}) { - my ($type) = $aux->{TYPE}; - my ($name) = $aux->{NAME}; - if ($type->{ROLE} eq 'leaf') { - my ($c_type) = c_type ($type); - push (@decls, "${c_type}aux_$name = op++->$type->{ATOM}"); - push (@args, "aux_$name"); - } elsif ($type->{ROLE} eq 'fixed') { - push (@args, $type->{FIXED_VALUE}); - } - } - - my ($sysmis_cond) = make_sysmis_decl ($op, "op++->integer"); - push (@decls, $sysmis_cond) if defined $sysmis_cond; - - my ($result) = "eval_$op->{OPNAME} (" . join (', ', @args) . ")"; - - my ($stack) = $op->{RETURNS}{STACK}; - - print "case $opname:\n"; - if (@decls) { - print " {\n"; - print " $_;\n" foreach @decls; - if (defined $sysmis_cond) { - my ($miss_ret) = $op->{RETURNS}{MISSING_VALUE}; - print " *$stack++ = force_sysmis ? $miss_ret : $result;\n"; - } else { - print " *$stack++ = $result;\n"; - } - print " }\n"; - } else { - print " *$stack++ = $result;\n"; - } - print " break;\n\n"; - } -} diff --git a/src/language/expressions/generate.pl b/src/language/expressions/generate.pl index c8fdf4c1d3..9d1e50245d 100644 --- a/src/language/expressions/generate.pl +++ b/src/language/expressions/generate.pl @@ -4,8 +4,6 @@ use warnings 'all'; use Getopt::Long; # Parse command line. -our ($default_output_file) = $0; -$default_output_file =~ s/\.pl//; our ($input_file); our ($output_file); parse_cmd_line (); @@ -21,7 +19,19 @@ parse_input (); # Produce output. print_header (); -generate_output (); +if ($output_file =~ /evaluate\.h$/) { + generate_evaluate_h (); +} elsif ($output_file =~ /evaluate\.inc$/) { + generate_evaluate_inc (); +} elsif ($output_file =~ /operations\.h$/) { + generate_operations_h (); +} elsif ($output_file =~ /optimize\.inc$/) { + generate_optimize_inc (); +} elsif ($output_file =~ /parse\.inc$/) { + generate_parse_inc (); +} else { + die "$output_file: unknown output type\n"; +} print_trailer (); # Command line. @@ -36,7 +46,7 @@ sub parse_cmd_line { or exit 1; $input_file = "operations.def" if !defined $input_file; - $output_file = $default_output_file if !defined $output_file; + die "$0: output file must be specified\n" if !defined $output_file; open (INPUT, "<$input_file") or die "$input_file: open: $!\n"; open (OUTPUT, ">$output_file") or die "$output_file: create: $!\n"; @@ -46,10 +56,10 @@ sub parse_cmd_line { sub usage { print <{UNIMPLEMENTED}; + + my (@args); + for my $arg (@{$op->{ARGS}}) { + if (!defined $arg->{IDX}) { + push (@args, c_type ($arg->{TYPE}) . $arg->{NAME}); + } else { + push (@args, c_type ($arg->{TYPE}) . "$arg->{NAME}" . "[]"); + push (@args, "size_t $arg->{IDX}"); + } + } + for my $aux (@{$op->{AUX}}) { + push (@args, c_type ($aux->{TYPE}) . $aux->{NAME}); + } + push (@args, "void") if !@args; + + my ($statements) = $op->{BLOCK} || " return $op->{EXPRESSION};\n"; + + print "static inline ", c_type ($op->{RETURNS}), "\n"; + print "eval_$opname (", join (', ', @args), ")\n"; + print "{\n"; + print "$statements"; + print "}\n\n"; + } +} + +sub generate_evaluate_inc { + for my $opname (@order) { + my ($op) = $ops{$opname}; + + if ($op->{UNIMPLEMENTED}) { + print "case $opname:\n"; + print " NOT_REACHED ();\n\n"; + next; + } + + my (@decls); + my (@args); + for my $arg (@{$op->{ARGS}}) { + my ($name) = $arg->{NAME}; + my ($type) = $arg->{TYPE}; + my ($c_type) = c_type ($type); + my ($idx) = $arg->{IDX}; + push (@args, "arg_$arg->{NAME}"); + if (!defined ($idx)) { + my ($decl) = "${c_type}arg_$name"; + if ($type->{ROLE} eq 'any') { + unshift (@decls, "$decl = *--$type->{STACK}"); + } elsif ($type->{ROLE} eq 'leaf') { + push (@decls, "$decl = op++->$type->{ATOM}"); + } else { + die; + } + } else { + my ($stack) = $type->{STACK}; + defined $stack or die; + unshift (@decls, + "$c_type*arg_$arg->{NAME} = $stack -= arg_$idx"); + unshift (@decls, "size_t arg_$arg->{IDX} = op++->integer"); + + my ($idx) = "arg_$idx"; + if ($arg->{TIMES} != 1) { + $idx .= " / $arg->{TIMES}"; + } + push (@args, $idx); + } + } + for my $aux (@{$op->{AUX}}) { + my ($type) = $aux->{TYPE}; + my ($name) = $aux->{NAME}; + if ($type->{ROLE} eq 'leaf') { + my ($c_type) = c_type ($type); + push (@decls, "${c_type}aux_$name = op++->$type->{ATOM}"); + push (@args, "aux_$name"); + } elsif ($type->{ROLE} eq 'fixed') { + push (@args, $type->{FIXED_VALUE}); + } + } + + my ($sysmis_cond) = make_sysmis_decl ($op, "op++->integer"); + push (@decls, $sysmis_cond) if defined $sysmis_cond; + + my ($result) = "eval_$op->{OPNAME} (" . join (', ', @args) . ")"; + + my ($stack) = $op->{RETURNS}{STACK}; + + print "case $opname:\n"; + if (@decls) { + print " {\n"; + print " $_;\n" foreach @decls; + if (defined $sysmis_cond) { + my ($miss_ret) = $op->{RETURNS}{MISSING_VALUE}; + print " *$stack++ = force_sysmis ? $miss_ret : $result;\n"; + } else { + print " *$stack++ = $result;\n"; + } + print " }\n"; + } else { + print " *$stack++ = $result;\n"; + } + print " break;\n\n"; + } +} + +sub generate_operations_h { + print "#include \n"; + print "#include \n\n"; + + print "typedef enum"; + print " {\n"; + my (@atoms); + foreach my $type (@types) { + next if $type->{ROLE} eq 'fixed'; + push (@atoms, "OP_$type->{NAME}"); + } + print_operations ('atom', 1, \@atoms); + print_operations ('function', "OP_atom_last + 1", \@funcs); + print_operations ('operator', "OP_function_last + 1", \@opers); + print_range ("OP_composite", "OP_function_first", "OP_operator_last"); + print ",\n\n"; + print_range ("OP", "OP_atom_first", "OP_composite_last"); + print "\n }\n"; + print "operation_type, atom_type;\n"; + + print_predicate ('is_operation', 'OP'); + print_predicate ("is_$_", "OP_$_") + foreach qw (atom composite function operator); +} + +sub print_operations { + my ($type, $first, $names) = @_; + print " /* \u$type types. */\n"; + print " $names->[0] = $first,\n"; + print " $_,\n" foreach @$names[1...$#{$names}]; + print_range ("OP_$type", $names->[0], $names->[$#{$names}]); + print ",\n\n"; +} + +sub print_range { + my ($prefix, $first, $last) = @_; + print " ${prefix}_first = $first,\n"; + print " ${prefix}_last = $last,\n"; + print " ${prefix}_cnt = ${prefix}_last - ${prefix}_first + 1"; +} + +sub print_predicate { + my ($function, $category) = @_; + my ($assertion) = ""; + + print "\nstatic inline bool\n"; + print "$function (operation_type op)\n"; + print "{\n"; + print " assert (is_operation (op));\n" if $function ne 'is_operation'; + print " return op >= ${category}_first && op <= ${category}_last;\n"; + print "}\n"; +} + +sub generate_optimize_inc { + for my $opname (@order) { + my ($op) = $ops{$opname}; + + if (!$op->{OPTIMIZABLE} || $op->{UNIMPLEMENTED}) { + print "case $opname:\n"; + print " NOT_REACHED ();\n\n"; + next; + } + + my (@decls); + my ($arg_idx) = 0; + for my $arg (@{$op->{ARGS}}) { + my ($decl); + my ($name) = $arg->{NAME}; + my ($type) = $arg->{TYPE}; + my ($ctype) = c_type ($type); + my ($idx) = $arg->{IDX}; + if (!defined ($idx)) { + my ($func) = "get_$type->{ATOM}_arg"; + push (@decls, "${ctype}arg_$name = $func (node, $arg_idx)"); + } else { + my ($decl) = "size_t arg_$idx = node->arg_cnt"; + $decl .= " - $arg_idx" if $arg_idx; + push (@decls, $decl); + + push (@decls, "${ctype}*arg_$name = " + . "get_$type->{ATOM}_args " + . " (node, $arg_idx, arg_$idx, e)"); + } + $arg_idx++; + } + + my ($sysmis_cond) = make_sysmis_decl ($op, "node->min_valid"); + push (@decls, $sysmis_cond) if defined $sysmis_cond; + + my (@args); + for my $arg (@{$op->{ARGS}}) { + push (@args, "arg_$arg->{NAME}"); + if (defined $arg->{IDX}) { + my ($idx) = "arg_$arg->{IDX}"; + $idx .= " / $arg->{TIMES}" if $arg->{TIMES} != 1; + push (@args, $idx); + } + } + for my $aux (@{$op->{AUX}}) { + my ($type) = $aux->{TYPE}; + if ($type->{ROLE} eq 'leaf') { + my ($func) = "get_$type->{ATOM}_arg"; + push (@args, "$func (node, $arg_idx)"); + $arg_idx++; + } elsif ($type->{ROLE} eq 'fixed') { + push (@args, $type->{FIXED_VALUE}); + } else { + die; + } + } + + my ($result) = "eval_$op->{OPNAME} (" . join (', ', @args) . ")"; + if (@decls && defined ($sysmis_cond)) { + my ($miss_ret) = $op->{RETURNS}{MISSING_VALUE}; + push (@decls, c_type ($op->{RETURNS}) . "result = " + . "force_sysmis ? $miss_ret : $result"); + $result = "result"; + } + + print "case $opname:\n"; + my ($alloc_func) = "expr_allocate_$op->{RETURNS}{NAME}"; + if (@decls) { + print " {\n"; + print " $_;\n" foreach @decls; + print " return $alloc_func (e, $result);\n"; + print " }\n"; + } else { + print " return $alloc_func (e, $result);\n"; + } + print "\n"; + } +} + +sub generate_parse_inc { + my (@members) = ("\"\"", "\"\"", 0, 0, 0, "{}", 0, 0); + print "{", join (', ', @members), "},\n"; + + for my $type (@types) { + next if $type->{ROLE} eq 'fixed'; + + my ($human_name) = $type->{HUMAN_NAME}; + $human_name = $type->{NAME} if !defined $human_name; + + my (@members) = ("\"$type->{NAME}\"", "\"$human_name\"", + 0, "OP_$type->{NAME}", 0, "{}", 0, 0); + print "{", join (', ', @members), "},\n"; + } + + for my $opname (@order) { + my ($op) = $ops{$opname}; + + my (@members); + + push (@members, "\"$op->{NAME}\""); + + if ($op->{CATEGORY} eq 'function') { + my (@args, @opt_args); + for my $arg (@{$op->{ARGS}}) { + push (@args, $arg->{TYPE}{HUMAN_NAME}) if !defined $arg->{IDX}; + } + + if (my ($array) = array_arg ($op)) { + if (!defined $op->{MIN_VALID}) { + my (@array_args); + for (my $i = 0; $i < $array->{TIMES}; $i++) { + push (@array_args, $array->{TYPE}{HUMAN_NAME}); + } + push (@args, @array_args); + @opt_args = @array_args; + } else { + for (my $i = 0; $i < $op->{MIN_VALID}; $i++) { + push (@args, $array->{TYPE}{HUMAN_NAME}); + } + push (@opt_args, $array->{TYPE}{HUMAN_NAME}); + } + } + my ($human) = "$op->{NAME}(" . join (', ', @args); + $human .= '[, ' . join (', ', @opt_args) . ']...' if @opt_args; + $human .= ')'; + push (@members, "\"$human\""); + } else { + push (@members, "NULL"); + } + + my (@flags); + push (@flags, "OPF_ABSORB_MISS") if defined $op->{ABSORB_MISS}; + push (@flags, "OPF_ARRAY_OPERAND") if array_arg ($op); + push (@flags, "OPF_MIN_VALID") if defined $op->{MIN_VALID}; + push (@flags, "OPF_NONOPTIMIZABLE") if !$op->{OPTIMIZABLE}; + push (@flags, "OPF_EXTENSION") if $op->{EXTENSION}; + push (@flags, "OPF_UNIMPLEMENTED") if $op->{UNIMPLEMENTED}; + push (@flags, "OPF_PERM_ONLY") if $op->{PERM_ONLY}; + push (@flags, "OPF_NO_ABBREV") if $op->{NO_ABBREV}; + push (@members, @flags ? join (' | ', @flags) : 0); + + push (@members, "OP_$op->{RETURNS}{NAME}"); + + push (@members, scalar (@{$op->{ARGS}})); + + my (@arg_types) = map ("OP_$_->{TYPE}{NAME}", @{$op->{ARGS}}); + push (@members, "{" . join (', ', @arg_types) . "}"); + + push (@members, $op->{MIN_VALID} || 0); + + push (@members, array_arg ($op) ? ${array_arg ($op)}{TIMES} : 0); + + print "{", join (', ', @members), "},\n"; + } +} # Utilities. diff --git a/src/language/expressions/operations.hpl b/src/language/expressions/operations.hpl deleted file mode 100644 index 8e6e120b98..0000000000 --- a/src/language/expressions/operations.hpl +++ /dev/null @@ -1,58 +0,0 @@ -use strict; -use warnings 'all'; - -do 'generate.pl'; -our (@types, @funcs, @opers); - -sub generate_output { - print "#include \n"; - print "#include \n\n"; - - print "typedef enum"; - print " {\n"; - my (@atoms); - foreach my $type (@types) { - next if $type->{ROLE} eq 'fixed'; - push (@atoms, "OP_$type->{NAME}"); - } - print_operations ('atom', 1, \@atoms); - print_operations ('function', "OP_atom_last + 1", \@funcs); - print_operations ('operator', "OP_function_last + 1", \@opers); - print_range ("OP_composite", "OP_function_first", "OP_operator_last"); - print ",\n\n"; - print_range ("OP", "OP_atom_first", "OP_composite_last"); - print "\n }\n"; - print "operation_type, atom_type;\n"; - - print_predicate ('is_operation', 'OP'); - print_predicate ("is_$_", "OP_$_") - foreach qw (atom composite function operator); -} - -sub print_operations { - my ($type, $first, $names) = @_; - print " /* \u$type types. */\n"; - print " $names->[0] = $first,\n"; - print " $_,\n" foreach @$names[1...$#{$names}]; - print_range ("OP_$type", $names->[0], $names->[$#{$names}]); - print ",\n\n"; -} - -sub print_range { - my ($prefix, $first, $last) = @_; - print " ${prefix}_first = $first,\n"; - print " ${prefix}_last = $last,\n"; - print " ${prefix}_cnt = ${prefix}_last - ${prefix}_first + 1"; -} - -sub print_predicate { - my ($function, $category) = @_; - my ($assertion) = ""; - - print "\nstatic inline bool\n"; - print "$function (operation_type op)\n"; - print "{\n"; - print " assert (is_operation (op));\n" if $function ne 'is_operation'; - print " return op >= ${category}_first && op <= ${category}_last;\n"; - print "}\n"; -} diff --git a/src/language/expressions/optimize.incpl b/src/language/expressions/optimize.incpl deleted file mode 100644 index c44177456c..0000000000 --- a/src/language/expressions/optimize.incpl +++ /dev/null @@ -1,85 +0,0 @@ -use strict; -use warnings 'all'; - -do 'generate.pl'; -our (@order, %ops); - -sub generate_output { - for my $opname (@order) { - my ($op) = $ops{$opname}; - - if (!$op->{OPTIMIZABLE} || $op->{UNIMPLEMENTED}) { - print "case $opname:\n"; - print " NOT_REACHED ();\n\n"; - next; - } - - my (@decls); - my ($arg_idx) = 0; - for my $arg (@{$op->{ARGS}}) { - my ($decl); - my ($name) = $arg->{NAME}; - my ($type) = $arg->{TYPE}; - my ($ctype) = c_type ($type); - my ($idx) = $arg->{IDX}; - if (!defined ($idx)) { - my ($func) = "get_$type->{ATOM}_arg"; - push (@decls, "${ctype}arg_$name = $func (node, $arg_idx)"); - } else { - my ($decl) = "size_t arg_$idx = node->arg_cnt"; - $decl .= " - $arg_idx" if $arg_idx; - push (@decls, $decl); - - push (@decls, "${ctype}*arg_$name = " - . "get_$type->{ATOM}_args " - . " (node, $arg_idx, arg_$idx, e)"); - } - $arg_idx++; - } - - my ($sysmis_cond) = make_sysmis_decl ($op, "node->min_valid"); - push (@decls, $sysmis_cond) if defined $sysmis_cond; - - my (@args); - for my $arg (@{$op->{ARGS}}) { - push (@args, "arg_$arg->{NAME}"); - if (defined $arg->{IDX}) { - my ($idx) = "arg_$arg->{IDX}"; - $idx .= " / $arg->{TIMES}" if $arg->{TIMES} != 1; - push (@args, $idx); - } - } - for my $aux (@{$op->{AUX}}) { - my ($type) = $aux->{TYPE}; - if ($type->{ROLE} eq 'leaf') { - my ($func) = "get_$type->{ATOM}_arg"; - push (@args, "$func (node, $arg_idx)"); - $arg_idx++; - } elsif ($type->{ROLE} eq 'fixed') { - push (@args, $type->{FIXED_VALUE}); - } else { - die; - } - } - - my ($result) = "eval_$op->{OPNAME} (" . join (', ', @args) . ")"; - if (@decls && defined ($sysmis_cond)) { - my ($miss_ret) = $op->{RETURNS}{MISSING_VALUE}; - push (@decls, c_type ($op->{RETURNS}) . "result = " - . "force_sysmis ? $miss_ret : $result"); - $result = "result"; - } - - print "case $opname:\n"; - my ($alloc_func) = "expr_allocate_$op->{RETURNS}{NAME}"; - if (@decls) { - print " {\n"; - print " $_;\n" foreach @decls; - print " return $alloc_func (e, $result);\n"; - print " }\n"; - } else { - print " return $alloc_func (e, $result);\n"; - } - print "\n"; - } -} diff --git a/src/language/expressions/parse.incpl b/src/language/expressions/parse.incpl deleted file mode 100644 index 7f9af1b92f..0000000000 --- a/src/language/expressions/parse.incpl +++ /dev/null @@ -1,82 +0,0 @@ -use strict; -use warnings 'all'; - -do 'generate.pl'; -our (@types, @order, %ops); - -sub generate_output { - my (@members) = ("\"\"", "\"\"", 0, 0, 0, "{}", 0, 0); - print "{", join (', ', @members), "},\n"; - - for my $type (@types) { - next if $type->{ROLE} eq 'fixed'; - - my ($human_name) = $type->{HUMAN_NAME}; - $human_name = $type->{NAME} if !defined $human_name; - - my (@members) = ("\"$type->{NAME}\"", "\"$human_name\"", - 0, "OP_$type->{NAME}", 0, "{}", 0, 0); - print "{", join (', ', @members), "},\n"; - } - - for my $opname (@order) { - my ($op) = $ops{$opname}; - - my (@members); - - push (@members, "\"$op->{NAME}\""); - - if ($op->{CATEGORY} eq 'function') { - my (@args, @opt_args); - for my $arg (@{$op->{ARGS}}) { - push (@args, $arg->{TYPE}{HUMAN_NAME}) if !defined $arg->{IDX}; - } - - if (my ($array) = array_arg ($op)) { - if (!defined $op->{MIN_VALID}) { - my (@array_args); - for (my $i = 0; $i < $array->{TIMES}; $i++) { - push (@array_args, $array->{TYPE}{HUMAN_NAME}); - } - push (@args, @array_args); - @opt_args = @array_args; - } else { - for (my $i = 0; $i < $op->{MIN_VALID}; $i++) { - push (@args, $array->{TYPE}{HUMAN_NAME}); - } - push (@opt_args, $array->{TYPE}{HUMAN_NAME}); - } - } - my ($human) = "$op->{NAME}(" . join (', ', @args); - $human .= '[, ' . join (', ', @opt_args) . ']...' if @opt_args; - $human .= ')'; - push (@members, "\"$human\""); - } else { - push (@members, "NULL"); - } - - my (@flags); - push (@flags, "OPF_ABSORB_MISS") if defined $op->{ABSORB_MISS}; - push (@flags, "OPF_ARRAY_OPERAND") if array_arg ($op); - push (@flags, "OPF_MIN_VALID") if defined $op->{MIN_VALID}; - push (@flags, "OPF_NONOPTIMIZABLE") if !$op->{OPTIMIZABLE}; - push (@flags, "OPF_EXTENSION") if $op->{EXTENSION}; - push (@flags, "OPF_UNIMPLEMENTED") if $op->{UNIMPLEMENTED}; - push (@flags, "OPF_PERM_ONLY") if $op->{PERM_ONLY}; - push (@flags, "OPF_NO_ABBREV") if $op->{NO_ABBREV}; - push (@members, @flags ? join (' | ', @flags) : 0); - - push (@members, "OP_$op->{RETURNS}{NAME}"); - - push (@members, scalar (@{$op->{ARGS}})); - - my (@arg_types) = map ("OP_$_->{TYPE}{NAME}", @{$op->{ARGS}}); - push (@members, "{" . join (', ', @arg_types) . "}"); - - push (@members, $op->{MIN_VALID} || 0); - - push (@members, array_arg ($op) ? ${array_arg ($op)}{TIMES} : 0); - - print "{", join (', ', @members), "},\n"; - } -} -- 2.30.2