Re: [PATCH] sv.c: consting
[p5sagit/p5-mst-13.2.git] / overload.pl
1 #!/usr/bin/perl -w
2
3 #
4 # Generate overload.h
5 # This allows the order of overloading constants to be changed.
6
7
8 BEGIN {
9     # Get function prototypes
10     require 'regen_lib.pl';
11 }
12
13 use strict;
14
15 my (@enums, @names);
16 while (<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
24 safer_unlink ('overload.h', 'overload.c');
25 die "overload.h: $!" unless open(C, ">overload.c");
26 binmode C;
27 die "overload.h: $!" unless open(H, ">overload.h");
28 binmode H;
29
30 sub print_header {
31   my $file = shift;
32   print <<"EOF";
33 /* -*- buffer-read-only: t -*-
34  *
35  *    $file
36  *
37  *    Copyright (C) 1997, 1998, 2000, 2001, 2005, 2006, 2007 by Larry Wall
38  *    and others
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  */
46 EOF
47 }
48
49 select C;
50 print_header('overload.c');
51
52 select H;
53 print_header('overload.h');
54 print <<'EOF';
55
56 enum {
57 EOF
58
59 print "    ${_}_amg,\n", foreach @enums;
60
61 print <<'EOF';
62     max_amg_code
63     /* Do not leave a trailing comma here.  C9X allows it, C89 doesn't. */
64 };
65
66 #define NofAMmeth max_amg_code
67
68 EOF
69
70 print C <<'EOF';
71
72 #define AMG_id2name(id) (PL_AMG_names[id]+1)
73 #define AMG_id2namelen(id) (PL_AMG_namelens[id]-1)
74
75 const U8 PL_AMG_namelens[NofAMmeth] = {
76 EOF
77
78 my $last = pop @names;
79
80 print C "    $_,\n" foreach map { length $_ } @names;
81
82 my $lastlen = length $last;
83 print C <<"EOT";
84     $lastlen
85 };
86
87 const char * const PL_AMG_names[NofAMmeth] = {
88   /* Names kept in the symbol table.  fallback => "()", the rest has
89      "(" prepended.  The only other place in perl which knows about
90      this convention is AMG_id2name (used for debugging output and
91      'nomethod' only), the only other place which has it hardwired is
92      overload.pm.  */
93 EOT
94
95 print C "    \"$_\",\n" foreach map { s/(["\\"])/\\$1/g; $_ } @names;
96
97 print C <<"EOT";
98     "$last"
99 };
100 EOT
101
102 close H or die $!;
103 close C or die $!;
104
105 __DATA__
106 # Fallback should be the first
107 fallback        ()
108
109 # These 5 are the most common in the fallback switch statement in amagic_call
110 to_sv           (${}
111 to_av           (@{}
112 to_hv           (%{}
113 to_gv           (*{}
114 to_cv           (&{}
115
116 # These have non-default cases in that switch statement
117 inc             (++
118 dec             (--
119 bool_           (bool
120 numer           (0+
121 string          (""
122 not             (!
123 copy            (=
124 abs             (abs
125 neg             (neg
126 iter            (<>
127 int             (int
128
129 # These 12 feature in the next switch statement
130 lt              (<
131 le              (<=
132 gt              (>
133 ge              (>=
134 eq              (==
135 ne              (!=
136 slt             (lt
137 sle             (le
138 sgt             (gt
139 sge             (ge
140 seq             (eq
141 sne             (ne
142
143 nomethod        (nomethod
144 add             (+
145 add_ass         (+=
146 subtr           (-
147 subtr_ass       (-=
148 mult            (*
149 mult_ass        (*=
150 div             (/
151 div_ass         (/=
152 modulo          (%
153 modulo_ass      (%=
154 pow             (**
155 pow_ass         (**=
156 lshift          (<<
157 lshift_ass      (<<=
158 rshift          (>>
159 rshift_ass      (>>=
160 band            (&
161 band_ass        (&=
162 bor             (|
163 bor_ass         (|=
164 bxor            (^
165 bxor_ass        (^=
166 ncmp            (<=>
167 scmp            (cmp
168 compl           (~
169 atan2           (atan2
170 cos             (cos
171 sin             (sin
172 exp             (exp
173 log             (log
174 sqrt            (sqrt
175 repeat          (x
176 repeat_ass      (x=
177 concat          (.
178 concat_ass      (.=
179 smart           (~~
180 # Note: Perl_Gv_AMupdate() assumes that DESTROY is the last entry
181 DESTROY         DESTROY