I sat down with Dan yesterday and finally got my head around his idea of
the multiple forms of some of the vtable methods. Unfortunately, this
kinda interrupts what I was doing implementing Perl scalar PMCs. :)
Anyway, instead of having an array of five different ways to add things
together, each function taking two PMCs, what we actually want is *true*
multimethods: one form which takes a PMC and an INTVAL, a PMC and a
BIGINT, a PMC and another PMC, etc.
(This means that the implementation of the op add_p_p_i is trivial, for
instance.)
I also finally now understand the "same as you" type - it means "I
am passing you a PMC which is guaranteed to be in the same class as you
- you may break the abstraction and directly fiddle with its data
pointer."
The following patch reworks vtable.h to implement this. It now means
that the still going on in classes/ is out of date; genclass.pl will
need updating and I need to toss what I've written in the C files.
But that's cool, because it allows me to convince myself that we ought
to use several different vtables to represent a Perl scalar. (which is
*obviously* the Right Way, but once I start doing something my way, it's
non-trivial to convince me to change... ;)
Here's the patch, anyhow:
Index: Makefile.in
===================================================================
RCS file: /home/perlcvs/parrot/Makefile.in,v
retrieving revision 1.48
diff -d -u -r1.48 Makefile.in
--- Makefile.in 2001/11/15 22:29:59 1.48
+++ Makefile.in 2001/11/16 15:29:00
@@ -12,11 +12,14 @@
O_FILES = global_setup$(O) interpreter$(O) parrot$(O) register$(O) \
core_ops$(O) memory$(O) packfile$(O) stacks$(O) string$(O) encoding$(O) \
-chartype$(O) runops_cores$(O) trace$(O) vtable_ops$(O) pmc$(O) classes/intclass$(O) \
+chartype$(O) runops_cores$(O) trace$(O) vtable_ops$(O) pmc$(O) \
encodings/singlebyte$(O) encodings/utf8$(O) encodings/utf16$(O) \
encodings/utf32$(O) chartypes/unicode$(O) chartypes/usascii$(O) resources$(O) \
platform$(O)
+# classes/intclass.o and classes/scalarclass.o removed for now, while
+# multimethods are being reworked
+
#DO NOT ADD C COMPILER FLAGS HERE
#Add them in Configure.pl--look for the
#comment 'ADD C COMPILER FLAGS HERE'
@@ -91,7 +94,8 @@
encoding/utf32$(O): $(H_FILES)
-classes/intclass$(O): $(H_FILES)
+# classes/intclass$(O): $(H_FILES)
+# classes/scalarclass$(O): $(H_FILES)
interpreter$(O): interpreter.c $(H_FILES)
Index: make_vtable_ops.pl
===================================================================
RCS file: /home/perlcvs/parrot/make_vtable_ops.pl,v
retrieving revision 1.5
diff -d -u -r1.5 make_vtable_ops.pl
--- make_vtable_ops.pl 2001/10/28 08:29:59 1.5
+++ make_vtable_ops.pl 2001/11/16 15:29:00
@@ -25,6 +25,7 @@
sub multimethod {
my $type = $vtable{$_[0]}{meth_type};
return "" if $type eq "unique";
+ return ""; # Spike it for now, until I'm convinced of how to do this
return '[$3->vtable->num_type]' if $type eq "num";
return '[$3->vtable->string_type]' if $type eq "str";
die "Coding error - undefined type $type\n";
Index: vtable.tbl
===================================================================
RCS file: /home/perlcvs/parrot/vtable.tbl,v
retrieving revision 1.7
diff -d -u -r1.7 vtable.tbl
--- vtable.tbl 2001/11/15 21:24:43 1.7
+++ vtable.tbl 2001/11/16 15:29:00
@@ -11,6 +11,9 @@
# string void frob INTVAL foo STRING bar
#
# Note that we don't include the source "PMC* pmc" - that's done implicitly.
+#
+# "value" in non-unique methods (multimethods) is a magic name. Its type
+# will be replaced appropriately.
unique INTVAL type
unique STRING* name
@@ -26,19 +29,19 @@
unique BOOLVAL get_bool
unique void* get_value
unique BOOLVAL is_same PMC* pmc2
-int void set_integer INTVAL integer
-float void set_number FLOATVAL number
-str void set_string STRING* string
+int void set_integer INTVAL value
+float void set_number FLOATVAL value
+str void set_string STRING* value
unique void set_value void* value
-num void add PMC* other PMC* dest
-num void subtract PMC* other PMC* dest
-num void multiply PMC* other PMC* dest
-num void divide PMC* other PMC* dest
-num void modulus PMC* other PMC* dest
-str void concatenate PMC* other PMC* dest
-unique BOOLVAL is_equal PMC* other
-unique void logical_or PMC* other PMC* dest
-unique void logical_and PMC* other PMC* dest
-unique void logical_not PMC* other
-str void match PMC* other REGEX* re
-str void repeat PMC* other PMC* dest
+num void add PMC* value PMC* dest
+num void subtract PMC* value PMC* dest
+num void multiply PMC* value PMC* dest
+num void divide PMC* value PMC* dest
+num void modulus PMC* value PMC* dest
+str void concatenate PMC* value PMC* dest
+unique BOOLVAL is_equal PMC* value
+unique void logical_or PMC* value PMC* dest
+unique void logical_and PMC* value PMC* dest
+unique void logical_not PMC* value
+str void match PMC* value REGEX* re
+str void repeat PMC* value PMC* dest
Index: Parrot/Vtable.pm
===================================================================
RCS file: /home/perlcvs/parrot/Parrot/Vtable.pm,v
retrieving revision 1.7
diff -d -u -r1.7 Vtable.pm
--- Parrot/Vtable.pm 2001/10/28 08:29:59 1.7
+++ Parrot/Vtable.pm 2001/11/16 15:29:00
@@ -4,12 +4,22 @@
@Parrot::Vtable::ISA = qw(Exporter);
@Parrot::Vtable::EXPORT = qw(parse_vtable vtbl_defs vtbl_struct vtbl_enumerate);
-my(%type_counts) = (unique => 1,
- int => 5,
- float =>5,
- num =>7,
- str => 5);
+my(%expand) = (
+ unique => [""], # Dummy element, so we go through the loop exactly once
+ int => [qw[object native bigint same]],
+ float => [qw[object native bigfloat same]],
+ num => [qw[object int bigint float bigfloat same]],
+ str => [qw[object native unicode other same]]
+);
+
+my (%types) = (
+ int => ["PMC *", "INTVAL", "BIGINT", "PMC *"],
+ float => ["PMC *", "FLOATVAL", "BIGFLOAT", "PMC *"],
+ num => ["PMC *", "INTVAL", "BIGINT", "FLOATVAL", "BIGFLOAT", "PMC *"],
+ str => ["PMC *", "STRING *", "STRING *", "STRING *", "PMC *"]
+);
+
sub parse_vtable {
my (%vtbl, @order);
open IN, shift || "vtable.tbl" or die "Can't open vtable table! $!\n";
@@ -22,38 +32,44 @@
my $meth_type = shift @line; # Method type
my $tn = shift @line; # Type and name;
my ($type, $name) = $tn =~ /(.*?)\s+(\w+)/;
- $vtbl{$name}{type} = $type;
- $vtbl{$name}{meth_type} = $meth_type;
- $vtbl{$name}{proto} = "$type (*$name)(struct Parrot_Interp *interpreter, PMC*
pmc";
- for (@line) {
- my ($argtype, $argname) = /(.*?)\s+(\w+)/;
- push @{$vtbl{$name}{args}},
- { type => $argtype, name => $argname };
- $vtbl{$name}{proto} .= ", $_";
+
+ # You are in a maze of twisty multimethods, all different.
+ for my $i (0..$#{$expand{$meth_type}}) {
+ my $expand_name = $name;
+
+ # If we're in a multimethod, we need to expand the name if
+ # it's not the default argument type of "object".
+ $expand_name .= "_".$expand{$meth_type}[$i]
+ unless $meth_type eq "unique"
+ or $expand{$meth_type}[$i] eq "object"; # as a default
+
+ $vtbl{$expand_name}{type} = $type;
+ $vtbl{$expand_name}{proto} = "$type (*$expand_name)(struct Parrot_Interp
+*interpreter, PMC* pmc";
+
+ # Parse the function parameters
+ for (@line) {
+ my ($argtype, $argname) = /(.*?)\s+(\w+)$/;
+
+ # In multimethods, we need to rewrite the type of
+ # parameters called "value".
+ $argtype = $types{$meth_type}[$i]
+ if $argname eq "value" and $meth_type ne "unique";
+
+ # Add the function parameters to the prototype
+ push @{$vtbl{$expand_name}{args}},
+ { type => $argtype, name => $argname };
+ $vtbl{$expand_name}{proto} .= ", $argtype $argname";
+ }
+ $vtbl{$expand_name}{proto} .=")";
+
+ # So they're ordered according to their position in the file
+ push @order, $expand_name;
}
- $vtbl{$name}{proto} .=")";
- push @order, $name;
}
$vtbl{order} = [@order];
return %vtbl;
}
-# This code is unused, but I'm keeping it around in case
-# we ever go back to using array-based vtables.
-sub vtbl_defs {
- my %vtbl = @_;
- my $rv;
- my $offset = 0;
-
- # First, typedef all the methods.
- for (@{$vtbl{order}}) {
- my $decl = "VTABLE_" . uc($_);
- $rv .= "#define $decl $offset\n";
- $offset += $type_counts{$vtbl{$_}{meth_type}};
- }
- return $rv;
-}
-
sub vtbl_struct {
my %vtbl = @_;
my $rv;
@@ -85,14 +101,14 @@
return $rv;
}
-# Returns an array of [type, name, prototype, variations] arrays
+# Returns an array of [type, name, prototype] arrays
sub vtbl_enumerate {
my %vtbl = @_;
my @rv;
for (@{$vtbl{order}}) {
my $proto = $vtbl{$_}{proto};
$proto =~ s/\(\*$_\)/$_ /;
- push @rv, [ "${_}_method_t", $_, $proto, $type_counts{$vtbl{$_}{meth_type}}];
+ push @rv, [ "${_}_method_t", $_, $proto];
}
return @rv;
}
Index: include/parrot/parrot.h
===================================================================
RCS file: /home/perlcvs/parrot/include/parrot/parrot.h,v
retrieving revision 1.12
diff -d -u -r1.12 parrot.h
--- include/parrot/parrot.h 2001/11/02 12:11:16 1.12
+++ include/parrot/parrot.h 2001/11/16 15:29:00
@@ -64,6 +64,8 @@
typedef unsigned char BOOLVAL;
typedef void STRING_FUNCS;
typedef void REGEX;
+typedef void BIGINT;
+typedef void BIGFLOAT;
#include "parrot/global_setup.h"
#include "parrot/interpreter.h"
--
>Almost any animal is capable learning a stimulus/response association,
>given enough repetition.
Experimental observation suggests that this isn't true if double-clicking
is involved. - Lionel, Malcolm Ray, asr.
