Commit | Line | Data |
---|---|---|
bab3dc31 | 1 | #!/usr/bin/perl -w |
bab3dc31 | 2 | # |
8bc7f08e | 3 | # Regenerate (overwriting only if changed): |
6294c161 DM |
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 | |
17 | BEGIN { | |
18 | # Get function prototypes | |
19 | require 'regen_lib.pl'; | |
20 | } | |
21 | ||
22 | use strict; | |
23 | ||
e46c382e YK |
24 | use File::Spec::Functions qw(catdir catfile);; |
25 | ||
bab3dc31 NC |
26 | my (@enums, @names); |
27 | while (<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 | ||
81372052 JC |
35 | safer_unlink (catfile(qw(lib overload numbers.pm))); |
36 | my $c = safer_open("overload.c-new"); | |
37 | my $h = safer_open("overload.h-new"); | |
e46c382e YK |
38 | mkdir("lib/overload") unless -d catdir(qw(lib overload)); |
39 | my $p = safer_open(catfile(qw(lib overload numbers.pm))); | |
40 | ||
41 | ||
42 | select $p; | |
43 | ||
44 | { | |
45 | local $" = "\n "; | |
46 | print <<"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 | ||
60 | package overload::numbers; | |
61 | ||
62 | our \@names = qw# | |
63 | @names | |
64 | #; | |
65 | ||
66 | our \@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 | |
74 | EOF | |
75 | } | |
76 | ||
8261f8eb NC |
77 | |
78 | sub 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 |
94 | EOF |
95 | } | |
96 | ||
08858ed2 | 97 | select $c; |
8261f8eb NC |
98 | print_header('overload.c'); |
99 | ||
08858ed2 | 100 | select $h; |
8261f8eb NC |
101 | print_header('overload.h'); |
102 | print <<'EOF'; | |
bab3dc31 NC |
103 | |
104 | enum { | |
105 | EOF | |
106 | ||
107 | print " ${_}_amg,\n", foreach @enums; | |
108 | ||
109 | print <<'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 | |
116 | EOF | |
117 | ||
08858ed2 | 118 | print $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 | 123 | static const U8 PL_AMG_namelens[NofAMmeth] = { |
d279ab82 NC |
124 | EOF |
125 | ||
126 | my $last = pop @names; | |
127 | ||
08858ed2 | 128 | print $c " $_,\n" foreach map { length $_ } @names; |
d279ab82 NC |
129 | |
130 | my $lastlen = length $last; | |
08858ed2 | 131 | print $c <<"EOT"; |
d279ab82 NC |
132 | $lastlen |
133 | }; | |
134 | ||
2e1c5ef0 | 135 | static 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 | 141 | EOT |
bab3dc31 | 142 | |
08858ed2 | 143 | print $c " \"$_\",\n" foreach map { s/(["\\"])/\\$1/g; $_ } @names; |
bab3dc31 | 144 | |
08858ed2 | 145 | print $c <<"EOT"; |
bab3dc31 NC |
146 | "$last" |
147 | }; | |
bab3dc31 NC |
148 | EOT |
149 | ||
08858ed2 NC |
150 | safer_close($h); |
151 | safer_close($c); | |
e46c382e | 152 | safer_close($p); |
81372052 JC |
153 | rename_if_different("overload.c-new", "overload.c"); |
154 | rename_if_different("overload.h-new","overload.h"); | |
8c798f87 | 155 | |
bab3dc31 NC |
156 | __DATA__ |
157 | # Fallback should be the first | |
158 | fallback () | |
159 | ||
160 | # These 5 are the most common in the fallback switch statement in amagic_call | |
161 | to_sv (${} | |
162 | to_av (@{} | |
163 | to_hv (%{} | |
164 | to_gv (*{} | |
165 | to_cv (&{} | |
166 | ||
167 | # These have non-default cases in that switch statement | |
168 | inc (++ | |
169 | dec (-- | |
170 | bool_ (bool | |
171 | numer (0+ | |
172 | string ("" | |
173 | not (! | |
174 | copy (= | |
175 | abs (abs | |
176 | neg (neg | |
177 | iter (<> | |
178 | int (int | |
179 | ||
180 | # These 12 feature in the next switch statement | |
181 | lt (< | |
182 | le (<= | |
183 | gt (> | |
184 | ge (>= | |
185 | eq (== | |
186 | ne (!= | |
187 | slt (lt | |
188 | sle (le | |
189 | sgt (gt | |
190 | sge (ge | |
191 | seq (eq | |
192 | sne (ne | |
193 | ||
194 | nomethod (nomethod | |
195 | add (+ | |
196 | add_ass (+= | |
197 | subtr (- | |
198 | subtr_ass (-= | |
199 | mult (* | |
200 | mult_ass (*= | |
201 | div (/ | |
202 | div_ass (/= | |
203 | modulo (% | |
204 | modulo_ass (%= | |
205 | pow (** | |
206 | pow_ass (**= | |
207 | lshift (<< | |
208 | lshift_ass (<<= | |
209 | rshift (>> | |
210 | rshift_ass (>>= | |
211 | band (& | |
212 | band_ass (&= | |
213 | bor (| | |
214 | bor_ass (|= | |
215 | bxor (^ | |
216 | bxor_ass (^= | |
217 | ncmp (<=> | |
218 | scmp (cmp | |
219 | compl (~ | |
220 | atan2 (atan2 | |
221 | cos (cos | |
222 | sin (sin | |
223 | exp (exp | |
224 | log (log | |
225 | sqrt (sqrt | |
226 | repeat (x | |
227 | repeat_ass (x= | |
228 | concat (. | |
229 | concat_ass (.= | |
230 | smart (~~ | |
8c8d0d99 | 231 | ftest (-X |
d9151963 | 232 | regexp (qr |
bab3dc31 NC |
233 | # Note: Perl_Gv_AMupdate() assumes that DESTROY is the last entry |
234 | DESTROY DESTROY |