[perl5.git] / overload.pl

#!/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';
die "overload.h: $!" unless open(H, ">overload.h");
binmode H;
select H;
print <<'EOF';
/* -*- buffer-read-only: t -*-
 *
 *    overload.h
 *
 *    Copyright (C) 1997, 1998, 2000, 2001, 2005 and 2006 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
 */

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
#define AMG_id2name(id) (PL_AMG_names[id]+1)

#ifdef DOINIT
EXTCONST 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.  */
EOF

my $last = pop @names;
print "    \"$_\",\n" foreach map { s/(["\\"])/\\$1/g; $_ } @names;

print <<"EOT";
    "$last"
};
#else
EXTCONST char * PL_AMG_names[NofAMmeth];
#endif /* def INITAMAGIC */
EOT

close H 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
Commit	Line	Data
bab3dc31 NC	1	#!/usr/bin/perl -w
	2
	3	#
	4	# Generate overload.h
8c798f87	5	# This allows the order of overloading constants to be changed.
bab3dc31 NC	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';
	25	die "overload.h: $!" unless open(H, ">overload.h");
	26	binmode H;
	27	select H;
	28	print <<'EOF';
	29	/* -- buffer-read-only: t --
	30	*
	31	* overload.h
	32	*
	33	* Copyright (C) 1997, 1998, 2000, 2001, 2005 and 2006 by Larry Wall and
	34	* others
	35	*
	36	* You may distribute under the terms of either the GNU General Public
	37	* License or the Artistic License, as specified in the README file.
	38	*
	39	* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
	40	* This file is built by overload.pl
	41	*/
	42
	43	enum {
	44	EOF
	45
	46	print " ${_}_amg,\n", foreach @enums;
	47
	48	print <<'EOF';
	49	max_amg_code
	50	/* Do not leave a trailing comma here. C9X allows it, C89 doesn't. */
	51	};
	52
	53
	54	#define NofAMmeth max_amg_code
	55	#define AMG_id2name(id) (PL_AMG_names[id]+1)
	56
	57	#ifdef DOINIT
	58	EXTCONST char * const PL_AMG_names[NofAMmeth] = {
	59	/* Names kept in the symbol table. fallback => "()", the rest has
	60	"(" prepended. The only other place in perl which knows about
	61	this convention is AMG_id2name (used for debugging output and
	62	'nomethod' only), the only other place which has it hardwired is
	63	overload.pm. */
	64	EOF
	65
	66	my $last = pop @names;
	67	print " \"$_\",\n" foreach map { s/(["\\"])/\\$1/g; $_ } @names;
	68
	69	print <<"EOT";
70	"$last"
71	};
72	#else
73	EXTCONST char * PL_AMG_names[NofAMmeth];
74	#endif /* def INITAMAGIC */
75	EOT
76
8c798f87 NC	77	close H or die $!;
8c798f87 NC	78
bab3dc31 NC	79	__DATA__
	80	# Fallback should be the first
	81	fallback ()
	82
	83	# These 5 are the most common in the fallback switch statement in amagic_call
	84	to_sv (${}
	85	to_av (@{}
	86	to_hv (%{}
	87	to_gv (*{}
	88	to_cv (&{}
	89
	90	# These have non-default cases in that switch statement
	91	inc (++
	92	dec (--
	93	bool_ (bool
	94	numer (0+
	95	string (""
	96	not (!
	97	copy (=
	98	abs (abs
	99	neg (neg
	100	iter (<>
	101	int (int
	102
	103	# These 12 feature in the next switch statement
	104	lt (<
	105	le (<=
	106	gt (>
	107	ge (>=
	108	eq (==
	109	ne (!=
	110	slt (lt
	111	sle (le
	112	sgt (gt
	113	sge (ge
	114	seq (eq
	115	sne (ne
	116
	117	nomethod (nomethod
	118	add (+
	119	add_ass (+=
	120	subtr (-
	121	subtr_ass (-=
	122	mult (*
	123	mult_ass (*=
	124	div (/
	125	div_ass (/=
	126	modulo (%
	127	modulo_ass (%=
	128	pow (**
	129	pow_ass (**=
	130	lshift (<<
	131	lshift_ass (<<=
	132	rshift (>>
	133	rshift_ass (>>=
	134	band (&
	135	band_ass (&=
	136	bor (\|
	137	bor_ass (\|=
	138	bxor (^
	139	bxor_ass (^=
	140	ncmp (<=>
	141	scmp (cmp
	142	compl (~
143	atan2 (atan2
144	cos (cos
145	sin (sin
146	exp (exp
147	log (log
148	sqrt (sqrt
149	repeat (x
150	repeat_ass (x=
151	concat (.
152	concat_ass (.=
153	smart (~~
154	# Note: Perl_Gv_AMupdate() assumes that DESTROY is the last entry
155	DESTROY DESTROY