perlop: fix documentation for s/// "false" return value
[perl.git] / regen / overload.pl
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
17 BEGIN {
18     # Get function prototypes
19     require './regen/regen_lib.pl';
20 }
21
22 use strict;
23
24 my (@enums, @names);
25 while (<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
33 my ($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
39 mkdir("lib/overload", 0777) unless -d 'lib/overload';
40 my $p = open_new('lib/overload/numbers.pm', '>',
41                  { by => 'regen/overload.pl',
42                    file => 'lib/overload/numbers.pm', copyright => [2008] });
43
44 {
45 local $" = "\n    ";
46 print $p <<"EOF";
47 package overload::numbers;
48
49 our \@names = qw#
50     @names
51 #;
52
53 our \@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 }
60 EOF
61 }
62
63 print $h "enum {\n";
64
65 for (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
76 print $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
82 EOF
83
84 print $c <<'EOF';
85 #define AMG_id2name(id) (PL_AMG_names[id]+1)
86 #define AMG_id2namelen(id) (PL_AMG_namelens[id]-1)
87
88 static const U8 PL_AMG_namelens[NofAMmeth] = {
89 EOF
90
91 my $last = pop @names;
92
93 print $c map { "    " . (length $_) . ",\n" } @names;
94
95 my $lastlen = length $last;
96 print $c <<"EOT";
97     $lastlen
98 };
99
100 static 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.  */
106 EOT
107
108 for (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
116 print $c <<"EOT";
117     "$last"
118 };
119 EOT
120
121 foreach ($h, $c, $p) {
122     read_only_bottom_close_and_rename($_);
123 }
124 __DATA__
125 # Fallback should be the first
126 fallback        ()
127
128 # These 5 are the most common in the fallback switch statement in amagic_call
129 to_sv           (${}
130 to_av           (@{}
131 to_hv           (%{}
132 to_gv           (*{}
133 to_cv           (&{}
134
135 # These have non-default cases in that switch statement
136 inc             (++
137 dec             (--
138 bool_           (bool
139 numer           (0+
140 string          (""
141 not             (!
142 copy            (=
143 abs             (abs
144 neg             (neg
145 iter            (<>
146 int             (int
147
148 # These 12 feature in the next switch statement
149 lt              (<
150 le              (<=
151 gt              (>
152 ge              (>=
153 eq              (==
154 ne              (!=
155 slt             (lt
156 sle             (le
157 sgt             (gt
158 sge             (ge
159 seq             (eq
160 sne             (ne
161
162 nomethod        (nomethod
163 add             (+
164 add_ass         (+=
165 subtr           (-
166 subtr_ass       (-=
167 mult            (*
168 mult_ass        (*=
169 div             (/
170 div_ass         (/=
171 modulo          (%
172 modulo_ass      (%=
173 pow             (**
174 pow_ass         (**=
175 lshift          (<<
176 lshift_ass      (<<=
177 rshift          (>>
178 rshift_ass      (>>=
179 band            (&
180 band_ass        (&=
181 sband           (&.
182 sband_ass       (&.=
183 bor             (|
184 bor_ass         (|=
185 sbor            (|.
186 sbor_ass        (|.=
187 bxor            (^
188 bxor_ass        (^=
189 sbxor           (^.
190 sbxor_ass       (^.=
191 ncmp            (<=>
192 scmp            (cmp
193 compl           (~
194 scompl          (~.
195 atan2           (atan2
196 cos             (cos
197 sin             (sin
198 exp             (exp
199 log             (log
200 sqrt            (sqrt
201 repeat          (x
202 repeat_ass      (x=
203 concat          (.
204 concat_ass      (.=
205 smart           (~~
206 ftest           (-X
207 regexp          (qr