This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Sort magic and magic vtable names in files generated by mg_vtable.pl
[perl5.git] / regen / overload.pl
CommitLineData
bab3dc31 1#!/usr/bin/perl -w
bab3dc31 2#
8bc7f08e 3# Regenerate (overwriting only if changed):
6294c161
DM
4#
5# overload.h
6# overload.c
7# lib/overload/numbers.pm
8#
9# from information stored in the DATA section of this file.
10#
8c798f87 11# This allows the order of overloading constants to be changed.
6294c161
DM
12#
13# Accepts the standard regen_lib -q and -v args.
14#
15# This script is normally invoked from regen.pl.
bab3dc31
NC
16
17BEGIN {
18 # Get function prototypes
af001346 19 require 'regen/regen_lib.pl';
bab3dc31
NC
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
cc49830d
NC
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.c', 'overload.h';
e46c382e 38
cc49830d
NC
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] });
78102347 43
e46c382e
YK
44{
45local $" = "\n ";
2d6469fe 46print $p <<"EOF";
e46c382e
YK
47package overload::numbers;
48
49our \@names = qw#
50 @names
51#;
52
53our \@enums = qw#
54 @enums
55#;
56
d87d3eed 57{ my \$i = 0; our %names = map { \$_ => \$i++ } \@names }
e46c382e 58
d87d3eed 59{ my \$i = 0; our %enums = map { \$_ => \$i++ } \@enums }
e46c382e
YK
60EOF
61}
62
2d6469fe 63print $h "enum {\n";
bab3dc31 64
c4ac9b44
DM
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;
2d6469fe 72 printf $h " %s_amg,%s/* 0x%02x %-8s */\n", $enums[$_],
218eba0d 73 ("\t" x $l), $_, $op;
c4ac9b44 74}
bab3dc31 75
2d6469fe 76print $h <<'EOF';
bab3dc31
NC
77 max_amg_code
78 /* Do not leave a trailing comma here. C9X allows it, C89 doesn't. */
79};
80
bab3dc31 81#define NofAMmeth max_amg_code
8261f8eb
NC
82EOF
83
08858ed2 84print $c <<'EOF';
bab3dc31 85#define AMG_id2name(id) (PL_AMG_names[id]+1)
82af6593 86#define AMG_id2namelen(id) (PL_AMG_namelens[id]-1)
bab3dc31 87
2e1c5ef0 88static const U8 PL_AMG_namelens[NofAMmeth] = {
d279ab82
NC
89EOF
90
91my $last = pop @names;
92
916e4025 93print $c map { " " . (length $_) . ",\n" } @names;
d279ab82
NC
94
95my $lastlen = length $last;
08858ed2 96print $c <<"EOT";
d279ab82
NC
97 $lastlen
98};
99
2e1c5ef0 100static const char * const PL_AMG_names[NofAMmeth] = {
bab3dc31
NC
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. */
d279ab82 106EOT
bab3dc31 107
c4ac9b44
DM
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}
bab3dc31 115
08858ed2 116print $c <<"EOT";
bab3dc31
NC
117 "$last"
118};
bab3dc31
NC
119EOT
120
ce716c52
NC
121foreach ($h, $c, $p) {
122 read_only_bottom_close_and_rename($_);
123}
bab3dc31
NC
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 (&=
181bor (|
182bor_ass (|=
183bxor (^
184bxor_ass (^=
185ncmp (<=>
186scmp (cmp
187compl (~
188atan2 (atan2
189cos (cos
190sin (sin
191exp (exp
192log (log
193sqrt (sqrt
194repeat (x
195repeat_ass (x=
196concat (.
197concat_ass (.=
198smart (~~
8c8d0d99 199ftest (-X
d9151963 200regexp (qr
bab3dc31
NC
201# Note: Perl_Gv_AMupdate() assumes that DESTROY is the last entry
202DESTROY DESTROY