This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Rename safer_rename() to rename_if_different(), to accurately describe
[perl5.git] / overload.pl
CommitLineData
bab3dc31
NC
1#!/usr/bin/perl -w
2
3#
4# Generate overload.h
8c798f87 5# This allows the order of overloading constants to be changed.
bab3dc31
NC
6#
7
8BEGIN {
9 # Get function prototypes
10 require 'regen_lib.pl';
11}
12
13use strict;
14
15my (@enums, @names);
16while (<DATA>) {
17 next if /^#/;
18 next if /^$/;
19 my ($enum, $name) = /^(\S+)\s+(\S+)/ or die "Can't parse $_";
20 push @enums, $enum;
21 push @names, $name;
22}
23
8261f8eb
NC
24safer_unlink ('overload.h', 'overload.c');
25die "overload.h: $!" unless open(C, ">overload.c");
26binmode C;
bab3dc31
NC
27die "overload.h: $!" unless open(H, ">overload.h");
28binmode H;
8261f8eb
NC
29
30sub print_header {
31 my $file = shift;
32 print <<"EOF";
bab3dc31
NC
33/* -*- buffer-read-only: t -*-
34 *
8261f8eb 35 * $file
bab3dc31 36 *
38f14693
RGS
37 * Copyright (C) 1997, 1998, 2000, 2001, 2005, 2006, 2007 by Larry Wall
38 * and others
bab3dc31
NC
39 *
40 * You may distribute under the terms of either the GNU General Public
41 * License or the Artistic License, as specified in the README file.
42 *
43 * !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
44 * This file is built by overload.pl
45 */
8261f8eb
NC
46EOF
47}
48
49select C;
50print_header('overload.c');
51
52select H;
53print_header('overload.h');
54print <<'EOF';
bab3dc31
NC
55
56enum {
57EOF
58
59print " ${_}_amg,\n", foreach @enums;
60
61print <<'EOF';
62 max_amg_code
63 /* Do not leave a trailing comma here. C9X allows it, C89 doesn't. */
64};
65
bab3dc31 66#define NofAMmeth max_amg_code
8261f8eb
NC
67
68EOF
69
70print C <<'EOF';
71
bab3dc31 72#define AMG_id2name(id) (PL_AMG_names[id]+1)
82af6593 73#define AMG_id2namelen(id) (PL_AMG_namelens[id]-1)
bab3dc31 74
d279ab82
NC
75const U8 PL_AMG_namelens[NofAMmeth] = {
76EOF
77
78my $last = pop @names;
79
80print C " $_,\n" foreach map { length $_ } @names;
81
82my $lastlen = length $last;
83print C <<"EOT";
84 $lastlen
85};
86
360ea906 87const char * const PL_AMG_names[NofAMmeth] = {
bab3dc31
NC
88 /* Names kept in the symbol table. fallback => "()", the rest has
89 "(" prepended. The only other place in perl which knows about
90 this convention is AMG_id2name (used for debugging output and
91 'nomethod' only), the only other place which has it hardwired is
92 overload.pm. */
d279ab82 93EOT
bab3dc31 94
8261f8eb 95print C " \"$_\",\n" foreach map { s/(["\\"])/\\$1/g; $_ } @names;
bab3dc31 96
8261f8eb 97print C <<"EOT";
bab3dc31
NC
98 "$last"
99};
bab3dc31
NC
100EOT
101
8c798f87 102close H or die $!;
d279ab82 103close C or die $!;
8c798f87 104
bab3dc31
NC
105__DATA__
106# Fallback should be the first
107fallback ()
108
109# These 5 are the most common in the fallback switch statement in amagic_call
110to_sv (${}
111to_av (@{}
112to_hv (%{}
113to_gv (*{}
114to_cv (&{}
115
116# These have non-default cases in that switch statement
117inc (++
118dec (--
119bool_ (bool
120numer (0+
121string (""
122not (!
123copy (=
124abs (abs
125neg (neg
126iter (<>
127int (int
128
129# These 12 feature in the next switch statement
130lt (<
131le (<=
132gt (>
133ge (>=
134eq (==
135ne (!=
136slt (lt
137sle (le
138sgt (gt
139sge (ge
140seq (eq
141sne (ne
142
143nomethod (nomethod
144add (+
145add_ass (+=
146subtr (-
147subtr_ass (-=
148mult (*
149mult_ass (*=
150div (/
151div_ass (/=
152modulo (%
153modulo_ass (%=
154pow (**
155pow_ass (**=
156lshift (<<
157lshift_ass (<<=
158rshift (>>
159rshift_ass (>>=
160band (&
161band_ass (&=
162bor (|
163bor_ass (|=
164bxor (^
165bxor_ass (^=
166ncmp (<=>
167scmp (cmp
168compl (~
169atan2 (atan2
170cos (cos
171sin (sin
172exp (exp
173log (log
174sqrt (sqrt
175repeat (x
176repeat_ass (x=
177concat (.
178concat_ass (.=
179smart (~~
180# Note: Perl_Gv_AMupdate() assumes that DESTROY is the last entry
181DESTROY DESTROY