#!/usr/bin/perl -w
#
# Generate overload.h
# This allows the order of overloading constants to be changed.
#
BEGIN {
# Get function prototypes
require 'regen_lib.pl';
}
use strict;
my (@enums, @names);
while (<DATA>) {
next if /^#/;
next if /^$/;
my ($enum, $name) = /^(\S+)\s+(\S+)/ or die "Can't parse $_";
push @enums, $enum;
push @names, $name;
}
safer_unlink ('overload.h', 'overload.c');
die "overload.h: $!" unless open(C, ">overload.c");
binmode C;
die "overload.h: $!" unless open(H, ">overload.h");
binmode H;
sub print_header {
my $file = shift;
print <<"EOF";
/* -*- buffer-read-only: t -*-
*
* $file
*
* Copyright (C) 1997, 1998, 2000, 2001, 2005, 2006, 2007 by Larry Wall
* and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
* This file is built by overload.pl
*/
EOF
}
select C;
print_header('overload.c');
select H;
print_header('overload.h');
print <<'EOF';
enum {
EOF
print " ${_}_amg,\n", foreach @enums;
print <<'EOF';
max_amg_code
/* Do not leave a trailing comma here. C9X allows it, C89 doesn't. */
};
#define NofAMmeth max_amg_code
EOF
print C <<'EOF';
#define AMG_id2name(id) (PL_AMG_names[id]+1)
#define AMG_id2namelen(id) (PL_AMG_namelens[id]-1)
const U8 PL_AMG_namelens[NofAMmeth] = {
EOF
my $last = pop @names;
print C " $_,\n" foreach map { length $_ } @names;
my $lastlen = length $last;
print C <<"EOT";
$lastlen
};
char * const PL_AMG_names[NofAMmeth] = {
/* Names kept in the symbol table. fallback => "()", the rest has
"(" prepended. The only other place in perl which knows about
this convention is AMG_id2name (used for debugging output and
'nomethod' only), the only other place which has it hardwired is
overload.pm. */
EOT
print C " \"$_\",\n" foreach map { s/(["\\"])/\\$1/g; $_ } @names;
print C <<"EOT";
"$last"
};
EOT
close H or die $!;
close C or die $!;
__DATA__
# Fallback should be the first
fallback ()
# These 5 are the most common in the fallback switch statement in amagic_call
to_sv (${}
to_av (@{}
to_hv (%{}
to_gv (*{}
to_cv (&{}
# These have non-default cases in that switch statement
inc (++
dec (--
bool_ (bool
numer (0+
string (""
not (!
copy (=
abs (abs
neg (neg
iter (<>
int (int
# These 12 feature in the next switch statement
lt (<
le (<=
gt (>
ge (>=
eq (==
ne (!=
slt (lt
sle (le
sgt (gt
sge (ge
seq (eq
sne (ne
nomethod (nomethod
add (+
add_ass (+=
subtr (-
subtr_ass (-=
mult (*
mult_ass (*=
div (/
div_ass (/=
modulo (%
modulo_ass (%=
pow (**
pow_ass (**=
lshift (<<
lshift_ass (<<=
rshift (>>
rshift_ass (>>=
band (&
band_ass (&=
bor (|
bor_ass (|=
bxor (^
bxor_ass (^=
ncmp (<=>
scmp (cmp
compl (~
atan2 (atan2
cos (cos
sin (sin
exp (exp
log (log
sqrt (sqrt
repeat (x
repeat_ass (x=
concat (.
concat_ass (.=
smart (~~
# Note: Perl_Gv_AMupdate() assumes that DESTROY is the last entry
DESTROY DESTROY