Inline::Parrot

[fglock]

Description:

update: see Inline::Parrot for the most current code.

I couldn't find an implementation of Inline::Parrot, so I thought maybe I could try to write one.

This is a slow-but-it-works version of the module that can execute Parrot Intermediate Representation (pir) code using pure Perl.

I tested this in MS Windows, with Activestate Perl 5.8.0, and a pre-built Parrot obtained from http://www.jwcs.net/developers/perl/pow/. I installed Inline using ppm.

It can execute this sample code:

use Inline Parrot;

print "Start Perl\n";
_hello( 'int count' => 5, name => 'test' );
print "End Perl\n";

__END__
__Parrot__

.sub _hello   
    .param int count
    .param string name
    print "Hello world\n"
    print count
    print " "
    print name
    print "\n" 
    ret 
.end

Output:

Start Perl
Hello world
5 test
End Perl

I've got some ideas on how to improve this, but I'd like to have some feedback, before I go too far.

There are still a lot of limitations, but most are fixable:
- the Perl parameter 'int count' should be written just 'count', but I'm not parsing the ".param" line yet.
- only 1 subroutine can be defined. This is also a simple parsing problem.
- it doesn't retrieve return values back to Perl.
- it doesn't allow positional parameters to be specified.
- there are no options for specifying the calling mode for pir.
- it doesn't pass data structures back and forth.
- you can't pass a data structure by reference - this is not likely to be fixable, because the perl and the parrot processes don't share memory.
- the current code uses temporary files for interprocess communication; it doesn't reuse the compiled code between calls; it has problems if two or more processes use the same source code. These problems are all fixable by using proper IPC with Open3 or sockets.

package Inline::Parrot;
$VERSION = '0.01';
require Inline;
@ISA = qw(Inline);
use strict;
use Carp;
use File::Spec;

sub register {
    return {
        language => 'Parrot',
        aliases => ['parrot', 'pasm', 'pir'],
        type => 'interpreted',
        suffix => 'pir',
       };
}

sub usage_config { 
    my $key = shift;
    "'$key' is not a valid config option for Inline::Parrot\n";
}

sub usage_config_bar { 
    "Invalid value for Inline::Parrot config option BAR";
}

sub validate {
    my $o = shift;
    $o->{ILSM}{PATTERN} ||= 'parrot-';
    $o->{ILSM}{BAR} ||= 0;
    while (@_) {
    my ($key, $value) = splice @_, 0, 2;
    if ($key eq 'PATTERN') {
        $o->{ILSM}{PATTERN} = $value;
        next;
    }
    if ($key eq 'BAR') {
        croak usage_config_bar
          unless $value =~ /^[01]$/;
        $o->{ILSM}{BAR} = $value;
        next;
    }
    croak usage_config($key);
    }
}

sub build {
    my $o = shift;
    my $code = $o->{API}{code};
    my $pattern = $o->{ILSM}{PATTERN};
    $code =~ s/$pattern//g;
    $code =~ s/bar-//g if $o->{ILSM}{BAR};

    my ( $sub_name ) = $code =~ m/\.sub\s+(\w+)/s; 

    my $path = File::Spec->catdir($o->{API}{install_lib},'auto',$o->{A
+PI}{modpname});
    my $obj = $o->{API}{location};
    $o->mkpath($path) unless -d $path;

    open PARROT_OBJ, "> $obj"
      or croak "Can't open $obj for output\n$!";
    print PARROT_OBJ $code;
    close \*PARROT_OBJ;
}

sub load {
    my $o = shift;
    my $obj = $o->{API}{location};
    open PARROT_OBJ, "< $obj"
      or croak "Can't open $obj for output\n$!";
    my $code = join '', <PARROT_OBJ>;
    close \*PARROT_OBJ;

    #warn "Load $code\n";
    #warn "Package $o->{API}{pkg}\n";

    my ( $sub_name ) = $code =~ m/\.sub\s+(\w+)/s;

    #warn "Sub $sub_name\n";

    my $obj_normalized = $obj;
    $obj_normalized =~ tr/\\/\//;  # Windows OS
    my $cmd = 
        " package $o->{API}{pkg} ;    \n" . 
        " sub $sub_name {             \n" .
        '
            my @param_keys;
            my $skip;
            for ( @_ ) 
            {
                push @param_keys, $_ if $skip = ! $skip;
            }
            my %param = @_;

            my $local_params;
            for ( @param_keys ) 
            {
                my $name = $_;
                $name = "string " . $name
                    unless $name =~ /\s/;
                $local_params .= "    .local $name\n";
            }

            my $value_params;
            for ( @param_keys ) 
            {
                my $name = ( split ( /\s+/, $_ ) )[-1];
                $value_params .= "    $name = \"$param{$_}\"\n";
            }

            my $arg_params;
            for ( reverse @param_keys ) 
            {
                my $name = ( split ( /\s+/, $_ ) )[-1];
                $arg_params .= "    .arg $name \n";
            }

            my $cmd = \'
.pragma fastcall
' . $code . '
.sub _start_' . $sub_name . ' @MAIN
    # print "starting parrot\\n"
    \' . $local_params . \'
    \' . $value_params . \'
    \' . $arg_params . \'
    call ' . $sub_name . '
    # print "ending parrot\\n"
    end
.end
\' ;
' . <<EOT;
            open PARROT_OBJ, ">", "$obj_normalized.pir"
              or die "Can't open $obj_normalized.pir for output\\n$!";
            print PARROT_OBJ \$cmd;
            close \*PARROT_OBJ;

            open( PARROT_RUN, "|-", "parrot $obj_normalized.pir" )
                or die "Can't open $obj_normalized.pir for output\\n$!
+";
            close( PARROT_RUN );
        }
EOT

    #warn "Cmd $cmd [end Cmd]\n";
    #warn "Eval\n" . $cmd . "\n";

    eval $cmd;
    croak "Unable to load Parrot module $obj:\n$@" if $@;
}

sub info {
    my $o = shift;
}

1;

__END__

[Ovid]

I mentioned this on the Perl 6 internals list. The only feedback I've gotten is from Leopold Toetsch. It's a public list, so I thought I'd let you know (in case you weren't on that list.)

Ovid <yeah, right> wrote:
> Haven't seen this mentioned here, but one person hacked up a quick
> Inline::Parrot

> http://www.perlmonks.org/index.pl?node_id=396890

Relly nice.

> It has some limitations and he's looking for feedback.

I'd use Parrot calling conventions. C<.pragma fastcall> is almost
untested.

> might help spur more Perl programmers to take a look at Parrot since it
> will be wrapped in a comfortable interface.

Yep.

[fglock]

I made a proper module and fixed most problems: it constructs a Parrot interpreter object, and uses it throughout the program - so that it is now much faster, and we can have global Parrot variables. You can also create and kill additional interpreters at will. It's now using Parrot-calling conventions, as suggested.

The current version is here: http://www.ipct.pucrs.br/flavio/perl/Inline-Parrot-0.04.tar.gz

Thanks for all the people who contributed with suggestions!

[fglock]

Inline::Parrot is now in CPAN - it should get indexed soon.

Please install parrot first.
Windows users can download the parrot binary from here.