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
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
916e4025 33safer_unlink ('lib/overload/numbers.pm');
81372052
JC
34my $c = safer_open("overload.c-new");
35my $h = safer_open("overload.h-new");
916e4025
NC
36mkdir("lib/overload", 0777) unless -d 'lib/overload';
37my $p = safer_open('lib/overload/numbers.pm');
e46c382e
YK
38
39
40select $p;
41
42{
43local $" = "\n ";
44print <<"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 !!!!!!!
1de57daf 55# This file is built by regen/overload.pl
e46c382e
YK
56#
57
58package overload::numbers;
59
60our \@names = qw#
61 @names
62#;
63
64our \@enums = qw#
65 @enums
66#;
67
d87d3eed 68{ my \$i = 0; our %names = map { \$_ => \$i++ } \@names }
e46c382e 69
d87d3eed 70{ my \$i = 0; our %enums = map { \$_ => \$i++ } \@enums }
e46c382e
YK
71
72EOF
73}
74
8261f8eb
NC
75
76sub print_header {
77 my $file = shift;
78 print <<"EOF";
bab3dc31
NC
79/* -*- buffer-read-only: t -*-
80 *
8261f8eb 81 * $file
bab3dc31 82 *
c4ac9b44
DM
83 * Copyright (C) 1997, 1998, 2000, 2001, 2005, 2006, 2007, 2011
84 * by Larry Wall and others
bab3dc31
NC
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 !!!!!!!
1de57daf 90 * This file is built by regen/overload.pl
bab3dc31 91 */
8261f8eb
NC
92EOF
93}
94
08858ed2 95select $c;
8261f8eb
NC
96print_header('overload.c');
97
08858ed2 98select $h;
8261f8eb
NC
99print_header('overload.h');
100print <<'EOF';
bab3dc31
NC
101
102enum {
103EOF
104
c4ac9b44
DM
105for (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;
218eba0d
DM
112 printf " %s_amg,%s/* 0x%02x %-8s */\n", $enums[$_],
113 ("\t" x $l), $_, $op;
c4ac9b44 114}
bab3dc31
NC
115
116print <<'EOF';
117 max_amg_code
118 /* Do not leave a trailing comma here. C9X allows it, C89 doesn't. */
119};
120
bab3dc31 121#define NofAMmeth max_amg_code
8261f8eb
NC
122
123EOF
124
08858ed2 125print $c <<'EOF';
8261f8eb 126
bab3dc31 127#define AMG_id2name(id) (PL_AMG_names[id]+1)
82af6593 128#define AMG_id2namelen(id) (PL_AMG_namelens[id]-1)
bab3dc31 129
2e1c5ef0 130static const U8 PL_AMG_namelens[NofAMmeth] = {
d279ab82
NC
131EOF
132
133my $last = pop @names;
134
916e4025 135print $c map { " " . (length $_) . ",\n" } @names;
d279ab82
NC
136
137my $lastlen = length $last;
08858ed2 138print $c <<"EOT";
d279ab82
NC
139 $lastlen
140};
141
2e1c5ef0 142static const char * const PL_AMG_names[NofAMmeth] = {
bab3dc31
NC
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. */
d279ab82 148EOT
bab3dc31 149
c4ac9b44
DM
150for (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}
bab3dc31 157
08858ed2 158print $c <<"EOT";
bab3dc31
NC
159 "$last"
160};
bab3dc31
NC
161EOT
162
08858ed2
NC
163safer_close($h);
164safer_close($c);
e46c382e 165safer_close($p);
81372052
JC
166rename_if_different("overload.c-new", "overload.c");
167rename_if_different("overload.h-new","overload.h");
8c798f87 168
bab3dc31
NC
169__DATA__
170# Fallback should be the first
171fallback ()
172
173# These 5 are the most common in the fallback switch statement in amagic_call
174to_sv (${}
175to_av (@{}
176to_hv (%{}
177to_gv (*{}
178to_cv (&{}
179
180# These have non-default cases in that switch statement
181inc (++
182dec (--
183bool_ (bool
184numer (0+
185string (""
186not (!
187copy (=
188abs (abs
189neg (neg
190iter (<>
191int (int
192
193# These 12 feature in the next switch statement
194lt (<
195le (<=
196gt (>
197ge (>=
198eq (==
199ne (!=
200slt (lt
201sle (le
202sgt (gt
203sge (ge
204seq (eq
205sne (ne
206
207nomethod (nomethod
208add (+
209add_ass (+=
210subtr (-
211subtr_ass (-=
212mult (*
213mult_ass (*=
214div (/
215div_ass (/=
216modulo (%
217modulo_ass (%=
218pow (**
219pow_ass (**=
220lshift (<<
221lshift_ass (<<=
222rshift (>>
223rshift_ass (>>=
224band (&
225band_ass (&=
226bor (|
227bor_ass (|=
228bxor (^
229bxor_ass (^=
230ncmp (<=>
231scmp (cmp
232compl (~
233atan2 (atan2
234cos (cos
235sin (sin
236exp (exp
237log (log
238sqrt (sqrt
239repeat (x
240repeat_ass (x=
241concat (.
242concat_ass (.=
243smart (~~
8c8d0d99 244ftest (-X
d9151963 245regexp (qr
bab3dc31
NC
246# Note: Perl_Gv_AMupdate() assumes that DESTROY is the last entry
247DESTROY DESTROY