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