Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number
 
PerlMonks  

Inline::Parrot

by fglock (Vicar)
on Oct 06, 2004 at 06:46 UTC ( #396890=snippet: print w/ replies, xml ) Need Help??

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__
Comment on Inline::Parrot
Download Code
Replies are listed 'Best First'.
Re: Inline::Parrot
by Ovid (Cardinal) on Oct 07, 2004 at 15:35 UTC

    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.

    Cheers,
    Ovid

    New address of my CGI Course.

Re: Inline::Parrot
by fglock (Vicar) on Oct 08, 2004 at 21:55 UTC

    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!

Re: Inline::Parrot
by fglock (Vicar) on Oct 13, 2004 at 14:29 UTC

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

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

Back to Snippets Section

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: snippet [id://396890]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others taking refuge in the Monastery: (12)
As of 2015-07-31 09:17 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (276 votes), past polls