This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update IPC::Cmd to 0.40
[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
NC
72#define AMG_id2name(id) (PL_AMG_names[id]+1)
73
8261f8eb 74char * const PL_AMG_names[NofAMmeth] = {
bab3dc31
NC
75 /* Names kept in the symbol table. fallback => "()", the rest has
76 "(" prepended. The only other place in perl which knows about
77 this convention is AMG_id2name (used for debugging output and
78 'nomethod' only), the only other place which has it hardwired is
79 overload.pm. */
80EOF
81
82my $last = pop @names;
8261f8eb 83print C " \"$_\",\n" foreach map { s/(["\\"])/\\$1/g; $_ } @names;
bab3dc31 84
8261f8eb 85print C <<"EOT";
bab3dc31
NC
86 "$last"
87};
bab3dc31
NC
88EOT
89
8c798f87
NC
90close H or die $!;
91
bab3dc31
NC
92__DATA__
93# Fallback should be the first
94fallback ()
95
96# These 5 are the most common in the fallback switch statement in amagic_call
97to_sv (${}
98to_av (@{}
99to_hv (%{}
100to_gv (*{}
101to_cv (&{}
102
103# These have non-default cases in that switch statement
104inc (++
105dec (--
106bool_ (bool
107numer (0+
108string (""
109not (!
110copy (=
111abs (abs
112neg (neg
113iter (<>
114int (int
115
116# These 12 feature in the next switch statement
117lt (<
118le (<=
119gt (>
120ge (>=
121eq (==
122ne (!=
123slt (lt
124sle (le
125sgt (gt
126sge (ge
127seq (eq
128sne (ne
129
130nomethod (nomethod
131add (+
132add_ass (+=
133subtr (-
134subtr_ass (-=
135mult (*
136mult_ass (*=
137div (/
138div_ass (/=
139modulo (%
140modulo_ass (%=
141pow (**
142pow_ass (**=
143lshift (<<
144lshift_ass (<<=
145rshift (>>
146rshift_ass (>>=
147band (&
148band_ass (&=
149bor (|
150bor_ass (|=
151bxor (^
152bxor_ass (^=
153ncmp (<=>
154scmp (cmp
155compl (~
156atan2 (atan2
157cos (cos
158sin (sin
159exp (exp
160log (log
161sqrt (sqrt
162repeat (x
163repeat_ass (x=
164concat (.
165concat_ass (.=
166smart (~~
167# Note: Perl_Gv_AMupdate() assumes that DESTROY is the last entry
168DESTROY DESTROY