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