Hi there,
I played again a little with the vtables.
I noticed that all *.pmc function implement the methods type and name
are implemented the same way. Then I was wondering if its possible to
autogenerate this functions in the pmc2c.pl
This patch implements autogeneration of this functions, and therefor
they are deleted from the *.pmc files. genclass.pl will not generate
them any more. If the user really wants to implement this functions
then he can add them to the pmc-file and this will replace the
autogenerated one.
Index: classes/parrotpointer.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/parrotpointer.pmc,v
retrieving revision 1.6
diff -u -r1.6 parrotpointer.pmc
--- classes/parrotpointer.pmc 22 Jan 2002 01:04:52 -0000 1.6
+++ classes/parrotpointer.pmc 3 Feb 2002 19:52:14 -0000
@@ -14,13 +14,6 @@
#define POINTER_ERROR internal_exception(PARROT_POINTER_ERROR, "An illegal operation
was performed on a ParrotPointer (vtable function at %s line %d).\n", __FILE__,
__LINE__);
pmclass ParrotPointer {
- INTVAL type () {
- return 0;
- }
-
- STRING* name () {
- return whoami;
- }
void init () {
SELF->data=NULL;
Index: classes/perlarray.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlarray.pmc,v
retrieving revision 1.10
diff -u -r1.10 perlarray.pmc
--- classes/perlarray.pmc 2 Feb 2002 04:06:05 -0000 1.10
+++ classes/perlarray.pmc 3 Feb 2002 19:52:14 -0000
@@ -14,14 +14,6 @@
pmclass PerlArray {
- INTVAL type () {
- return 0;
- }
-
- STRING* name() {
- return whoami;
- }
-
void init () {
SELF->data = key_new(INTERP);
key_set_size(INTERP,SELF->data,0);
Index: classes/perlhash.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlhash.pmc,v
retrieving revision 1.7
diff -u -r1.7 perlhash.pmc
--- classes/perlhash.pmc 2 Feb 2002 04:06:05 -0000 1.7
+++ classes/perlhash.pmc 3 Feb 2002 19:52:14 -0000
@@ -14,14 +14,6 @@
pmclass PerlHash {
- INTVAL type () {
- return 0;
- }
-
- STRING* name() {
- return whoami;
- }
-
void init () {
SELF->data = key_new(INTERP);
key_set_size(INTERP,SELF->data,0);
Index: classes/perlint.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlint.pmc,v
retrieving revision 1.15
diff -u -r1.15 perlint.pmc
--- classes/perlint.pmc 22 Jan 2002 01:04:53 -0000 1.15
+++ classes/perlint.pmc 3 Feb 2002 19:52:14 -0000
@@ -14,14 +14,6 @@
pmclass PerlInt {
- INTVAL type () {
- return 0;
- }
-
- STRING* name() {
- return whoami;
- }
-
void init () {
SELF->cache.int_val = 0;
}
Index: classes/perlnum.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlnum.pmc,v
retrieving revision 1.17
diff -u -r1.17 perlnum.pmc
--- classes/perlnum.pmc 22 Jan 2002 01:04:53 -0000 1.17
+++ classes/perlnum.pmc 3 Feb 2002 19:52:14 -0000
@@ -13,17 +13,9 @@
#include "parrot/parrot.h"
pmclass PerlNum {
-
- INTVAL type () {
- return 0;
- }
-
- STRING* name() {
- return whoami;
- }
void init () {
- SELF->cache.num_val = 0.0;
+ SELF->cache.num_val = 0.0;
}
void clone (PMC* dest) {
Index: classes/perlstring.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlstring.pmc,v
retrieving revision 1.15
diff -u -r1.15 perlstring.pmc
--- classes/perlstring.pmc 22 Jan 2002 01:04:53 -0000 1.15
+++ classes/perlstring.pmc 3 Feb 2002 19:52:14 -0000
@@ -14,14 +14,6 @@
pmclass PerlString {
- INTVAL type () {
- return 0;
- }
-
- STRING* name() {
- return whoami;
- }
-
void init () {
SELF->cache.struct_val = string_make(INTERP,NULL,0,NULL,0,NULL);
}
Index: classes/perlundef.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlundef.pmc,v
retrieving revision 1.6
diff -u -r1.6 perlundef.pmc
--- classes/perlundef.pmc 22 Jan 2002 01:04:53 -0000 1.6
+++ classes/perlundef.pmc 3 Feb 2002 19:52:15 -0000
@@ -14,13 +14,6 @@
pmclass PerlUndef {
- INTVAL type () {
- }
-
- STRING* name () {
- return whoami;
- }
-
void init () {
/* Nothing */
}
Index: classes/genclass.pl
===================================================================
RCS file: /cvs/public/parrot/classes/genclass.pl,v
retrieving revision 1.8
diff -u -r1.8 genclass.pl
--- classes/genclass.pl 30 Jan 2002 18:02:23 -0000 1.8
+++ classes/genclass.pl 3 Feb 2002 19:52:15 -0000
@@ -7,10 +7,11 @@
my %vtbl = parse_vtable("$FindBin::Bin/../vtable.tbl");
my $classname = shift;
die "No classname given!\n" unless $classname;
+my $classname_lc = lc $classname;
-my $DOLLAR = '$';
+my $DOLLAR = "\$";
print <<EOF;
-/* ${classname}.pmc
+/* ${classname_lc}.pmc
* Copyright: (When this is determined...it will go here)
* CVS Info
* ${DOLLAR}Id${DOLLAR}
@@ -28,8 +29,12 @@
EOF
+my @autogenerated = ('type', 'name');
+
my $decls;
for (vtbl_enumerate(%vtbl)) {
+ my $name = $_->[1];
+ next if grep { $name eq $_ } @autogenerated;
my $proto = $_->[2];
my $thisproto = $proto;
# I am Jack's crufty code
Index: classes/pmc2c.pl
===================================================================
RCS file: /cvs/public/parrot/classes/pmc2c.pl,v
retrieving revision 1.11
diff -u -r1.11 pmc2c.pl
--- classes/pmc2c.pl 31 Jan 2002 21:00:40 -0000 1.11
+++ classes/pmc2c.pl 3 Feb 2002 19:52:15 -0000
@@ -11,6 +11,7 @@
use lib "$FindBin::Bin/../lib";
use Parrot::Vtable;
use strict;
+use Data::Dumper;
my %default = parse_vtable("$FindBin::Bin/../vtable.tbl");
my $signature_re = qr{
@@ -27,6 +28,35 @@
\(([^\(]*)\) #parameters
}sx;
+my %autogenerated = (
+ type => \&gen_type,
+ name => \&gen_name
+ );
+
+sub gen_type {
+ my ($classname, $method) = @_;
+
+ return <<"EOC";
+INTVAL Parrot_${classname}_${method}
+ {
+ return enum_class_${classname};
+ }
+
+EOC
+}
+
+sub gen_name {
+ my ($classname, $method) = @_;
+
+ return <<"EOC";
+STRING* Parrot_${classname}_${method}
+ {
+ return whoami;
+ }
+
+EOC
+}
+
sub extract_balanced {
my $balance = 0;
my $lines = 0;
@@ -187,12 +217,12 @@
my @methods;
my $OUT = '';
- my $HOUT = <<"EOC";
+ my $HOUT = <<"EOH";
/* Do not edit - automatically generated from '$pmcfile' by $0 */
-EOC
+EOH
my %defaulted;
-
+
while ($classblock =~ s/($signature_re)//) {
$lineno += count_newlines($1);
my ($type, $methodname, $parameters) = ($2,$3,$4);
@@ -223,9 +253,9 @@
push @methods, $methodname;
};
- @methods = map { "Parrot_$methodloc->{$_}_$_" } @{ $default{order} };
+ my @methods_full = map { "Parrot_$methodloc->{$_}_$_" } @{ $default{order} };
- my $methodlist = join (",\n ", @methods);
+ my $methodlist = join (",\n ", @methods_full);
my $initname = "Parrot_$classname" . "_class_init";
my %visible_supers;
@@ -236,9 +266,16 @@
# No, include yourself to check your headers match your bodies
# (and gcc -W... is happy then)
# next if $class eq $classname;
- $includes .= qq(#include "\L$class.h"\n);
+ $includes .= "#include \"\L$class.h\"\n";
}
+ foreach my $method (keys %autogenerated) {
+ if (!grep {$_ eq $method} @methods) {
+ $OUT = "/* $method is autogenerated */\n"
+ . &{$autogenerated{$method}} ($classname, $method)
+ . $OUT;
+ }
+ }
$OUT = <<EOC . $OUT;
/* Do not edit - automatically generated from '$pmcfile' by $0 */
--
Juergen Boemmels [EMAIL PROTECTED]
Fachbereich Physik Tel: ++49-(0)631-205-2817
Universitaet Kaiserslautern Fax: ++49-(0)631-205-3906
PGP Key fingerprint = 9F 56 54 3D 45 C1 32 6F 23 F6 C7 2F 85 93 DD 47
