On Sun, 14 Jul 2002, Mike Lambert wrote:
> There currently is a 'morph' vtable entry, which I believe is intended to
> morph from one vtable type to another. I think it'd be better to implement
> this function properly than to use macros (talk to Robert ;), especially
> considering that certain vtables might have special morphing
> requirements, such as setting PMC_is_buffer_ptr_FLAG.

The macro is my way of saying "I don't know how this should be done, but
adding a bunch of if's around every place where we change something's type
is definitely _not_ the way."  It's not a permanent solution, but it's a
solution that will fix the immediate problem without changing the way
things are done, and which can easily be changed if we decide to do
something different -- just re-define the macro to call your Function du
Jour.

> Of course, morph seems to be unimplemented, and my attempt at
> implementing it ran into a problem, which I brought up here:
> http:[EMAIL PROTECTED]/msg09317.html

In that thread you bemoan our lack of multi-dispatch, which appears to be
changing...

> a) morph will break horribly when we deal with tied variables, since it
> will have to reimplement *every* PMC method to avoid any morphing.

To me this is the killer -- what's the point of a morph method if you give
the object no data, but just a desired type?  I agree with you, Mike, that
it's easier at that point to just create a new PMC of the type you want.
What would be nice is some sort of PMC->accept(PMC * thing) method, so you
could create a temporary value, then throw it at the target.  By default,
this would replace the target by the temporary.  I suspect we'll be using
multiple dispatch to deal with this, so whatever is done in the short term
may be moot.  In any case, just reaching in and modifying someone else's
vtable is bad.

While we're on the subject of gripes...  What do you think this code
sequence should do:

        new P0, .PerlUndef
        new P1, .PerlUndef
        set P0, 1.5
        set P1, 1
        lt P1, P0, LESS
        gt P0, P1, GREATER
        branch ITS_A_WASH

That's right -- (!(P1 < P0) && (P0 > P1)), because the lt truncates P0's
value, but the gt turns P1 into a float.  Blech.  And if one of them
happens to be a string, things get even more interesting.  I've got a
patch to promote everything to FLOATVAL before doing numeric comparisons,
which solves at least some cases.  Is it worth putting in, when we know it
will come right back out once multiple dispatch is in?  In any case, I've
attached a test to compare what parrot's Perl* types do with what Perl
does, just so we know where we stand.

/s
#! perl -w

use Parrot::Test tests => 36;
use strict;

my %things;

BEGIN {
    $things{PerlString} = ['"1"', '"00001"', '"1.5"', '"-3"', '"banana"'];
    $things{PerlNum} = ['1.0000', '1.00001', '2.34', '1.4999999', '-3.1',
                        '.000000001'];
    $things{PerlInt} = ['1', '2', '4', '0', '-3'];
}

foreach my $types ([qw(PerlNum PerlInt)],
                   [qw(PerlNum PerlString)],
                   [qw(PerlNum PerlNum)],
                   [qw(PerlInt PerlInt)],
                   [qw(PerlInt PerlString)],
                   [qw(PerlInt PerlNum)]) {

    foreach my $op (qw(gt lt ge le eq ne)) {
        my ($code, $output) = gen_test($op, @$types);
        output_is($code, $output, "operator $op");
    }
}

my %ops;

BEGIN { %ops = qw(gt > lt < ge >= le <= eq == ne !=); }

sub gen_test {
    no warnings 'numeric';
    my ($op, $a, $b) = @_;
    my @as = @{$things{$a}};
    my @bs = @{$things{$b}};
    my $code;
    my $reg = 0;
    for (@as) {
        $code .= <<END;
        new P$reg, .$a
        set P$reg, $_
END
        ++$reg;
    }
    for (@bs) {
        $code .= <<END;
        new P$reg, .$b
        set P$reg, $_
END
        ++$reg;
    }
    my $label = 0;

    # String vs. float.
    for my $i (0 .. $#as) {
        for my $j (@as .. @as + $#bs) {
            if (eval $as[$i].$ops{$op}.$bs[$j - @as]) {
                $code .= <<END;
        $op P$i, P$j, good_$label
        print "$op "
        print P$i
        print " "
        print P$j
        print " should be TRUE!\\n"
good_$label:
END
            } else {
                $code .= <<END;
        $op P$i, P$j, bad_$label
good_$label:
        branch end_$label
bad_$label:
        print "$op "
        print P$i
        print " "
        print P$j
        print " should be FALSE!\\n"
end_$label:
END
            }
            ++$label;
        }
    }
    $code .= "\nend\n";
    return ($code, '');
}

Reply via email to