This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
add enum index in overload.h comments
[perl5.git] / regen / overload.pl
1 #!/usr/bin/perl -w
2 #
3 # Regenerate (overwriting only if changed):
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 #
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 safer_unlink ('lib/overload/numbers.pm');
34 my $c = safer_open("overload.c-new");
35 my $h = safer_open("overload.h-new");
36 mkdir("lib/overload", 0777) unless -d 'lib/overload';
37 my $p = safer_open('lib/overload/numbers.pm');
38
39
40 select $p;
41
42 {
43 local $" = "\n    ";
44 print <<"EOF";
45 # -*- buffer-read-only: t -*-
46 #
47 #   lib/overload/numbers.pm
48 #
49 #   Copyright (C) 2008 by Larry Wall and others
50 #
51 #   You may distribute under the terms of either the GNU General Public
52 #   License or the Artistic License, as specified in the README file.
53 #
54 # !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
55 # This file is built by regen/overload.pl
56 #
57
58 package overload::numbers;
59
60 our \@names = qw#
61     @names
62 #;
63
64 our \@enums = qw#
65     @enums
66 #;
67
68 { my \$i = 0; our %names = map { \$_ => \$i++ } \@names }
69
70 { my \$i = 0; our %enums = map { \$_ => \$i++ } \@enums }
71
72 EOF
73 }
74
75
76 sub print_header {
77   my $file = shift;
78   print <<"EOF";
79 /* -*- buffer-read-only: t -*-
80  *
81  *    $file
82  *
83  *    Copyright (C) 1997, 1998, 2000, 2001, 2005, 2006, 2007, 2011
84  *    by Larry Wall and others
85  *
86  *    You may distribute under the terms of either the GNU General Public
87  *    License or the Artistic License, as specified in the README file.
88  *
89  *  !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
90  *  This file is built by regen/overload.pl
91  */
92 EOF
93 }
94
95 select $c;
96 print_header('overload.c');
97
98 select $h;
99 print_header('overload.h');
100 print <<'EOF';
101
102 enum {
103 EOF
104
105 for (0..$#enums) {
106     my $op = $names[$_];
107     $op = 'fallback' if $op eq '()';
108     $op =~ s/^\(//;
109     die if $op =~ m{\*/};
110     my $l =   3 - int((length($enums[$_]) + 9) / 8);
111     $l = 1 if $l < 1;
112     printf "    %s_amg,%s/* 0x%02x %-8s */\n", $enums[$_],
113         ("\t" x $l), $_, $op;
114 }
115
116 print <<'EOF';
117     max_amg_code
118     /* Do not leave a trailing comma here.  C9X allows it, C89 doesn't. */
119 };
120
121 #define NofAMmeth max_amg_code
122
123 EOF
124
125 print $c <<'EOF';
126
127 #define AMG_id2name(id) (PL_AMG_names[id]+1)
128 #define AMG_id2namelen(id) (PL_AMG_namelens[id]-1)
129
130 static const U8 PL_AMG_namelens[NofAMmeth] = {
131 EOF
132
133 my $last = pop @names;
134
135 print $c map { "    " . (length $_) . ",\n" } @names;
136
137 my $lastlen = length $last;
138 print $c <<"EOT";
139     $lastlen
140 };
141
142 static const char * const PL_AMG_names[NofAMmeth] = {
143   /* Names kept in the symbol table.  fallback => "()", the rest has
144      "(" prepended.  The only other place in perl which knows about
145      this convention is AMG_id2name (used for debugging output and
146      'nomethod' only), the only other place which has it hardwired is
147      overload.pm.  */
148 EOT
149
150 for (0..$#names) {
151     my $n = $names[$_];
152     $n =~ s/(["\\])/\\$1/g;
153     my $l =   3 - int((length($n) + 7) / 8);
154     $l = 1 if $l < 1;
155     printf $c "    \"%s\",%s/* %-10s */\n", $n, ("\t" x $l), $enums[$_];
156 }
157
158 print $c <<"EOT";
159     "$last"
160 };
161 EOT
162
163 safer_close($h);
164 safer_close($c);
165 safer_close($p);
166 rename_if_different("overload.c-new", "overload.c");
167 rename_if_different("overload.h-new","overload.h");
168
169 __DATA__
170 # Fallback should be the first
171 fallback        ()
172
173 # These 5 are the most common in the fallback switch statement in amagic_call
174 to_sv           (${}
175 to_av           (@{}
176 to_hv           (%{}
177 to_gv           (*{}
178 to_cv           (&{}
179
180 # These have non-default cases in that switch statement
181 inc             (++
182 dec             (--
183 bool_           (bool
184 numer           (0+
185 string          (""
186 not             (!
187 copy            (=
188 abs             (abs
189 neg             (neg
190 iter            (<>
191 int             (int
192
193 # These 12 feature in the next switch statement
194 lt              (<
195 le              (<=
196 gt              (>
197 ge              (>=
198 eq              (==
199 ne              (!=
200 slt             (lt
201 sle             (le
202 sgt             (gt
203 sge             (ge
204 seq             (eq
205 sne             (ne
206
207 nomethod        (nomethod
208 add             (+
209 add_ass         (+=
210 subtr           (-
211 subtr_ass       (-=
212 mult            (*
213 mult_ass        (*=
214 div             (/
215 div_ass         (/=
216 modulo          (%
217 modulo_ass      (%=
218 pow             (**
219 pow_ass         (**=
220 lshift          (<<
221 lshift_ass      (<<=
222 rshift          (>>
223 rshift_ass      (>>=
224 band            (&
225 band_ass        (&=
226 bor             (|
227 bor_ass         (|=
228 bxor            (^
229 bxor_ass        (^=
230 ncmp            (<=>
231 scmp            (cmp
232 compl           (~
233 atan2           (atan2
234 cos             (cos
235 sin             (sin
236 exp             (exp
237 log             (log
238 sqrt            (sqrt
239 repeat          (x
240 repeat_ass      (x=
241 concat          (.
242 concat_ass      (.=
243 smart           (~~
244 ftest           (-X
245 regexp          (qr
246 # Note: Perl_Gv_AMupdate() assumes that DESTROY is the last entry
247 DESTROY         DESTROY