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