1#!/usr/bin/perl -w
2#
3# Regenerate (overwriting only if changed):
4#
5#    overload.h
6#    overload.inc
7#    lib/overload/numbers.pm
8#
9# from information stored in the DATA section of this file.
10#
11# This allows the order of overloading constants to be changed.
12#
13# Accepts the standard regen_lib -q and -v args.
14#
15# This script is normally invoked from regen.pl.
16
17BEGIN {
18    # Get function prototypes
19    require './regen/regen_lib.pl';
20}
21
22use strict;
23
24my (@enums, @names);
25while (<DATA>) {
26  next if /^#/;
27  next if /^$/;
28  my ($enum, $name) = /^(\S+)\s+(\S+)/ or die "Can't parse $_";
29  push @enums, $enum;
30  push @names, $name;
31}
32
33my ($c, $h) = map {
34    open_new($_, '>',
35             { by => 'regen/overload.pl', file => $_, style => '*',
36               copyright => [1997, 1998, 2000, 2001, 2005 .. 2007, 2011] });
37} 'overload.inc', 'overload.h';
38
39mkdir("lib/overload", 0777) unless -d 'lib/overload';
40my $p = open_new('lib/overload/numbers.pm', '>',
41                 { by => 'regen/overload.pl',
42                   file => 'lib/overload/numbers.pm', copyright => [2008] });
43
44{
45local $" = "\n    ";
46print $p <<"EOF";
47package overload::numbers;
48
49our \@names = qw#
50    @names
51#;
52
53our \@enums = qw#
54    @enums
55#;
56
57{ my \$i = 0; our %names = map { \$_ => \$i++ } \@names }
58
59{ my \$i = 0; our %enums = map { \$_ => \$i++ } \@enums }
60EOF
61}
62
63print $h "enum {\n";
64
65for (0..$#enums) {
66    my $op = $names[$_];
67    $op = 'fallback' if $op eq '()';
68    $op =~ s/^\(//;
69    die if $op =~ m{\*/};
70    my $l =   3 - int((length($enums[$_]) + 9) / 8);
71    $l = 1 if $l < 1;
72    printf $h "    %s_amg,%s/* 0x%02x %-8s */\n", $enums[$_],
73        ("\t" x $l), $_, $op;
74}
75
76print $h <<'EOF';
77    max_amg_code
78    /* Do not leave a trailing comma here.  C9X allows it, C89 doesn't. */
79};
80
81#define NofAMmeth max_amg_code
82EOF
83
84print $c <<'EOF';
85#define AMG_id2name(id) (PL_AMG_names[id]+1)
86#define AMG_id2namelen(id) (PL_AMG_namelens[id]-1)
87
88static const U8 PL_AMG_namelens[NofAMmeth] = {
89EOF
90
91my $last = pop @names;
92
93print $c map { "    " . (length $_) . ",\n" } @names;
94
95my $lastlen = length $last;
96print $c <<"EOT";
97    $lastlen
98};
99
100static const char * const PL_AMG_names[NofAMmeth] = {
101  /* Names kept in the symbol table.  fallback => "()", the rest has
102     "(" prepended.  The only other place in perl which knows about
103     this convention is AMG_id2name (used for debugging output and
104     'nomethod' only), the only other place which has it hardwired is
105     overload.pm.  */
106EOT
107
108for (0..$#names) {
109    my $n = $names[$_];
110    $n =~ s/(["\\])/\\$1/g;
111    my $l =   3 - int((length($n) + 7) / 8);
112    $l = 1 if $l < 1;
113    printf $c "    \"%s\",%s/* %-10s */\n", $n, ("\t" x $l), $enums[$_];
114}
115
116print $c <<"EOT";
117    "$last"
118};
119EOT
120
121foreach ($h, $c, $p) {
122    read_only_bottom_close_and_rename($_);
123}
124__DATA__
125# Fallback should be the first
126fallback	()
127
128# These 5 are the most common in the fallback switch statement in amagic_call
129to_sv		(${}
130to_av		(@{}
131to_hv		(%{}
132to_gv		(*{}
133to_cv		(&{}
134
135# These have non-default cases in that switch statement
136inc		(++
137dec		(--
138bool_		(bool
139numer		(0+
140string		(""
141not		(!
142copy		(=
143abs		(abs
144neg		(neg
145iter		(<>
146int		(int
147
148# These 12 feature in the next switch statement
149lt		(<
150le		(<=
151gt		(>
152ge		(>=
153eq		(==
154ne		(!=
155slt		(lt
156sle		(le
157sgt		(gt
158sge		(ge
159seq		(eq
160sne		(ne
161
162nomethod	(nomethod
163add		(+
164add_ass		(+=
165subtr		(-
166subtr_ass	(-=
167mult		(*
168mult_ass	(*=
169div		(/
170div_ass		(/=
171modulo		(%
172modulo_ass	(%=
173pow		(**
174pow_ass		(**=
175lshift		(<<
176lshift_ass	(<<=
177rshift		(>>
178rshift_ass	(>>=
179band		(&
180band_ass	(&=
181sband		(&.
182sband_ass	(&.=
183bor		(|
184bor_ass		(|=
185sbor		(|.
186sbor_ass	(|.=
187bxor		(^
188bxor_ass	(^=
189sbxor		(^.
190sbxor_ass	(^.=
191ncmp		(<=>
192scmp		(cmp
193compl		(~
194scompl		(~.
195atan2		(atan2
196cos		(cos
197sin		(sin
198exp		(exp
199log		(log
200sqrt		(sqrt
201repeat		(x
202repeat_ass	(x=
203concat		(.
204concat_ass	(.=
205smart		(~~
206ftest           (-X
207regexp          (qr
208