Commit | Line | Data |
---|---|---|
bab3dc31 | 1 | #!/usr/bin/perl -w |
bab3dc31 | 2 | # |
8bc7f08e | 3 | # Regenerate (overwriting only if changed): |
6294c161 DM |
4 | # |
5 | # overload.h | |
6ffcffbd | 6 | # overload.inc |
6294c161 DM |
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 | |
3d7c117d | 19 | require './regen/regen_lib.pl'; |
bab3dc31 NC |
20 | } |
21 | ||
22 | use strict; | |
23 | ||
24 | my (@enums, @names); | |
25 | while (<DATA>) { | |
26 | next if /^#/; | |
27 | next if /^$/; | |
28 | my ($enum, $name) = /^(\S+)\s+(\S+)/ or die "Can't parse $_"; | |
29 | push @enums, $enum; | |
30 | push @names, $name; | |
31 | } | |
32 | ||
cc49830d NC |
33 | my ($c, $h) = map { |
34 | open_new($_, '>', | |
35 | { by => 'regen/overload.pl', file => $_, style => '*', | |
36 | copyright => [1997, 1998, 2000, 2001, 2005 .. 2007, 2011] }); | |
6ffcffbd | 37 | } 'overload.inc', 'overload.h'; |
e46c382e | 38 | |
cc49830d NC |
39 | mkdir("lib/overload", 0777) unless -d 'lib/overload'; |
40 | my $p = open_new('lib/overload/numbers.pm', '>', | |
41 | { by => 'regen/overload.pl', | |
42 | file => 'lib/overload/numbers.pm', copyright => [2008] }); | |
78102347 | 43 | |
e46c382e YK |
44 | { |
45 | local $" = "\n "; | |
2d6469fe | 46 | print $p <<"EOF"; |
e46c382e YK |
47 | package overload::numbers; |
48 | ||
49 | our \@names = qw# | |
50 | @names | |
51 | #; | |
52 | ||
53 | our \@enums = qw# | |
54 | @enums | |
55 | #; | |
56 | ||
d87d3eed | 57 | { my \$i = 0; our %names = map { \$_ => \$i++ } \@names } |
e46c382e | 58 | |
d87d3eed | 59 | { my \$i = 0; our %enums = map { \$_ => \$i++ } \@enums } |
e46c382e YK |
60 | EOF |
61 | } | |
62 | ||
2d6469fe | 63 | print $h "enum {\n"; |
bab3dc31 | 64 | |
c4ac9b44 DM |
65 | for (0..$#enums) { |
66 | my $op = $names[$_]; | |
67 | $op = 'fallback' if $op eq '()'; | |
68 | $op =~ s/^\(//; | |
69 | die if $op =~ m{\*/}; | |
70 | my $l = 3 - int((length($enums[$_]) + 9) / 8); | |
71 | $l = 1 if $l < 1; | |
2d6469fe | 72 | printf $h " %s_amg,%s/* 0x%02x %-8s */\n", $enums[$_], |
218eba0d | 73 | ("\t" x $l), $_, $op; |
c4ac9b44 | 74 | } |
bab3dc31 | 75 | |
2d6469fe | 76 | print $h <<'EOF'; |
bab3dc31 NC |
77 | max_amg_code |
78 | /* Do not leave a trailing comma here. C9X allows it, C89 doesn't. */ | |
79 | }; | |
80 | ||
bab3dc31 | 81 | #define NofAMmeth max_amg_code |
8261f8eb NC |
82 | EOF |
83 | ||
08858ed2 | 84 | print $c <<'EOF'; |
bab3dc31 | 85 | #define AMG_id2name(id) (PL_AMG_names[id]+1) |
82af6593 | 86 | #define AMG_id2namelen(id) (PL_AMG_namelens[id]-1) |
bab3dc31 | 87 | |
2e1c5ef0 | 88 | static const U8 PL_AMG_namelens[NofAMmeth] = { |
d279ab82 NC |
89 | EOF |
90 | ||
91 | my $last = pop @names; | |
92 | ||
916e4025 | 93 | print $c map { " " . (length $_) . ",\n" } @names; |
d279ab82 NC |
94 | |
95 | my $lastlen = length $last; | |
08858ed2 | 96 | print $c <<"EOT"; |
d279ab82 NC |
97 | $lastlen |
98 | }; | |
99 | ||
2e1c5ef0 | 100 | static const char * const PL_AMG_names[NofAMmeth] = { |
bab3dc31 NC |
101 | /* Names kept in the symbol table. fallback => "()", the rest has |
102 | "(" prepended. The only other place in perl which knows about | |
103 | this convention is AMG_id2name (used for debugging output and | |
104 | 'nomethod' only), the only other place which has it hardwired is | |
105 | overload.pm. */ | |
d279ab82 | 106 | EOT |
bab3dc31 | 107 | |
c4ac9b44 DM |
108 | for (0..$#names) { |
109 | my $n = $names[$_]; | |
110 | $n =~ s/(["\\])/\\$1/g; | |
111 | my $l = 3 - int((length($n) + 7) / 8); | |
112 | $l = 1 if $l < 1; | |
113 | printf $c " \"%s\",%s/* %-10s */\n", $n, ("\t" x $l), $enums[$_]; | |
114 | } | |
bab3dc31 | 115 | |
08858ed2 | 116 | print $c <<"EOT"; |
bab3dc31 NC |
117 | "$last" |
118 | }; | |
bab3dc31 NC |
119 | EOT |
120 | ||
ce716c52 NC |
121 | foreach ($h, $c, $p) { |
122 | read_only_bottom_close_and_rename($_); | |
123 | } | |
bab3dc31 NC |
124 | __DATA__ |
125 | # Fallback should be the first | |
126 | fallback () | |
127 | ||
128 | # These 5 are the most common in the fallback switch statement in amagic_call | |
129 | to_sv (${} | |
130 | to_av (@{} | |
131 | to_hv (%{} | |
132 | to_gv (*{} | |
133 | to_cv (&{} | |
134 | ||
135 | # These have non-default cases in that switch statement | |
136 | inc (++ | |
137 | dec (-- | |
138 | bool_ (bool | |
139 | numer (0+ | |
140 | string ("" | |
141 | not (! | |
142 | copy (= | |
143 | abs (abs | |
144 | neg (neg | |
145 | iter (<> | |
146 | int (int | |
147 | ||
148 | # These 12 feature in the next switch statement | |
149 | lt (< | |
150 | le (<= | |
151 | gt (> | |
152 | ge (>= | |
153 | eq (== | |
154 | ne (!= | |
155 | slt (lt | |
156 | sle (le | |
157 | sgt (gt | |
158 | sge (ge | |
159 | seq (eq | |
160 | sne (ne | |
161 | ||
162 | nomethod (nomethod | |
163 | add (+ | |
164 | add_ass (+= | |
165 | subtr (- | |
166 | subtr_ass (-= | |
167 | mult (* | |
168 | mult_ass (*= | |
169 | div (/ | |
170 | div_ass (/= | |
171 | modulo (% | |
172 | modulo_ass (%= | |
173 | pow (** | |
174 | pow_ass (**= | |
175 | lshift (<< | |
176 | lshift_ass (<<= | |
177 | rshift (>> | |
178 | rshift_ass (>>= | |
179 | band (& | |
180 | band_ass (&= | |
7dd64841 FC |
181 | sband (&. |
182 | sband_ass (&.= | |
bab3dc31 NC |
183 | bor (| |
184 | bor_ass (|= | |
7dd64841 FC |
185 | sbor (|. |
186 | sbor_ass (|.= | |
bab3dc31 NC |
187 | bxor (^ |
188 | bxor_ass (^= | |
7dd64841 FC |
189 | sbxor (^. |
190 | sbxor_ass (^.= | |
bab3dc31 NC |
191 | ncmp (<=> |
192 | scmp (cmp | |
193 | compl (~ | |
7dd64841 | 194 | scompl (~. |
bab3dc31 NC |
195 | atan2 (atan2 |
196 | cos (cos | |
197 | sin (sin | |
198 | exp (exp | |
199 | log (log | |
200 | sqrt (sqrt | |
201 | repeat (x | |
202 | repeat_ass (x= | |
203 | concat (. | |
204 | concat_ass (.= | |
205 | smart (~~ | |
8c8d0d99 | 206 | ftest (-X |
d9151963 | 207 | regexp (qr |