This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #9328] Update INSTALL example for BerkeleyDB install
[perl5.git] / overload.pl
CommitLineData
bab3dc31 1#!/usr/bin/perl -w
bab3dc31 2#
6294c161
DM
3# Unconditionally regenerate:
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
e46c382e 35safer_unlink ('overload.h', 'overload.c', catfile(qw(lib overload numbers.pm)));
08858ed2
NC
36my $c = safer_open("overload.c");
37my $h = safer_open("overload.h");
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);
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
bab3dc31
NC
230# Note: Perl_Gv_AMupdate() assumes that DESTROY is the last entry
231DESTROY DESTROY