This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
opcode.pl -> regen/opcode.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
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 !!!!!!!
55# This file is built by overload.pl
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 *
38f14693
RGS
83 * Copyright (C) 1997, 1998, 2000, 2001, 2005, 2006, 2007 by Larry Wall
84 * 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 !!!!!!!
90 * This file is built by overload.pl
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
916e4025 105print map " ${_}_amg,\n", @enums;
bab3dc31
NC
106
107print <<'EOF';
108 max_amg_code
109 /* Do not leave a trailing comma here. C9X allows it, C89 doesn't. */
110};
111
bab3dc31 112#define NofAMmeth max_amg_code
8261f8eb
NC
113
114EOF
115
08858ed2 116print $c <<'EOF';
8261f8eb 117
bab3dc31 118#define AMG_id2name(id) (PL_AMG_names[id]+1)
82af6593 119#define AMG_id2namelen(id) (PL_AMG_namelens[id]-1)
bab3dc31 120
2e1c5ef0 121static const U8 PL_AMG_namelens[NofAMmeth] = {
d279ab82
NC
122EOF
123
124my $last = pop @names;
125
916e4025 126print $c map { " " . (length $_) . ",\n" } @names;
d279ab82
NC
127
128my $lastlen = length $last;
08858ed2 129print $c <<"EOT";
d279ab82
NC
130 $lastlen
131};
132
2e1c5ef0 133static const char * const PL_AMG_names[NofAMmeth] = {
bab3dc31
NC
134 /* Names kept in the symbol table. fallback => "()", the rest has
135 "(" prepended. The only other place in perl which knows about
136 this convention is AMG_id2name (used for debugging output and
137 'nomethod' only), the only other place which has it hardwired is
138 overload.pm. */
d279ab82 139EOT
bab3dc31 140
916e4025 141print $c map { s/(["\\"])/\\$1/g; " \"$_\",\n" } @names;
bab3dc31 142
08858ed2 143print $c <<"EOT";
bab3dc31
NC
144 "$last"
145};
bab3dc31
NC
146EOT
147
08858ed2
NC
148safer_close($h);
149safer_close($c);
e46c382e 150safer_close($p);
81372052
JC
151rename_if_different("overload.c-new", "overload.c");
152rename_if_different("overload.h-new","overload.h");
8c798f87 153
bab3dc31
NC
154__DATA__
155# Fallback should be the first
156fallback ()
157
158# These 5 are the most common in the fallback switch statement in amagic_call
159to_sv (${}
160to_av (@{}
161to_hv (%{}
162to_gv (*{}
163to_cv (&{}
164
165# These have non-default cases in that switch statement
166inc (++
167dec (--
168bool_ (bool
169numer (0+
170string (""
171not (!
172copy (=
173abs (abs
174neg (neg
175iter (<>
176int (int
177
178# These 12 feature in the next switch statement
179lt (<
180le (<=
181gt (>
182ge (>=
183eq (==
184ne (!=
185slt (lt
186sle (le
187sgt (gt
188sge (ge
189seq (eq
190sne (ne
191
192nomethod (nomethod
193add (+
194add_ass (+=
195subtr (-
196subtr_ass (-=
197mult (*
198mult_ass (*=
199div (/
200div_ass (/=
201modulo (%
202modulo_ass (%=
203pow (**
204pow_ass (**=
205lshift (<<
206lshift_ass (<<=
207rshift (>>
208rshift_ass (>>=
209band (&
210band_ass (&=
211bor (|
212bor_ass (|=
213bxor (^
214bxor_ass (^=
215ncmp (<=>
216scmp (cmp
217compl (~
218atan2 (atan2
219cos (cos
220sin (sin
221exp (exp
222log (log
223sqrt (sqrt
224repeat (x
225repeat_ass (x=
226concat (.
227concat_ass (.=
228smart (~~
8c8d0d99 229ftest (-X
d9151963 230regexp (qr
bab3dc31
NC
231# Note: Perl_Gv_AMupdate() assumes that DESTROY is the last entry
232DESTROY DESTROY