[svn:parrot] r40879 - trunk/tools/dev

dukeleto at svn.parrot.org dukeleto at svn.parrot.org
Sun Aug 30 20:09:46 UTC 2009


Author: dukeleto
Date: Sun Aug 30 20:09:35 2009
New Revision: 40879
URL: https://trac.parrot.org/parrot/changeset/40879

Log:
[tools] The Parrot Shell is a rapid prototyping tool for writing Parrot code

Added:
   trunk/tools/dev/parrot_shell.pl

Added: trunk/tools/dev/parrot_shell.pl
==============================================================================
--- /dev/null	00:00:00 1970	(empty, because file is newly added)
+++ trunk/tools/dev/parrot_shell.pl	Sun Aug 30 20:09:35 2009	(r40879)
@@ -0,0 +1,169 @@
+#! perl
+# Copyright (C) 2009, Parrot Foundation.
+# $Id$
+
+use 5.008;
+use strict;
+use warnings;
+use FindBin qw($Bin);
+use lib "$Bin/../lib";    # install location
+use lib "$Bin/../../lib"; # build location
+use IO::File ();
+use File::Spec;
+use Parrot::Config;
+use File::Temp qw/ tempfile /;
+
+=head1 NAME
+
+tools/dev/parrot_shell.pl - The Parrot Shell
+
+=head1 SYNOPSIS
+
+    % perl tools/dev/parrot_shell.pl
+
+=head1 DESCRIPTION
+
+The Parrot Shell allows you to rapidly prototype Parrot code. It wraps your code
+in a ".sub main" and ".end", so you don't have to, unless your code begins with
+".sub". It reads code from STDIN until it sees a line containing a single ".",
+which is how you tell parrot_shell to run the code you are giving to it:
+
+Example:
+    parrot_shell 0> $I0 = 42
+    $N1 = sqrt $I0
+    say $N1
+    .
+    Output:
+    6.48074069840786
+
+    parrot_shell 1> quit
+    Thanks for visiting the Parrot Shell, come back soon!
+
+Each numbered Parrot Shell session is run in it's own interpreter, so no registers
+or variables are shared/leaked between them.
+
+=cut
+
+my $parrot;
+my $session_no = 0;
+
+BEGIN {
+    $parrot = File::Spec->catfile( ".", "parrot");
+    unless (-e $parrot) {
+        warn "$parrot not found, attempting to use an installed parrot";
+        $parrot = 'parrot';
+    }
+    my $exefile = $parrot . $PConfig{exe};
+}
+
+show_welcome();
+
+while(1) {
+    my $code;
+    show_prompt($session_no);
+
+    while( my $line = <STDIN> ) {
+        exit_shell() if $line =~ m/^q(uit)?$/;
+
+        if ($line =~ m/^h(elp)?$/) {
+            show_help();
+            show_prompt($session_no) if !defined $code;
+            next;
+        }
+        if ($line =~ m/^\s*\.\s*$/) { # Run it, baby!
+            print eval_snippet($code);
+            last;
+        } else {
+            $code .= $line;
+        }
+    }
+
+    $session_no++;
+}
+
+sub show_welcome {
+    print <<BIENVENIDO;
+Welcome to the Parrot Shell, it's experimental!
+Type h or help for some basic help
+Type q or quit to flee the madness
+BIENVENIDO
+
+}
+
+sub show_prompt {
+    my ($session_no) = @_;
+    print "\nparrot_shell $session_no> ";
+}
+sub exit_shell {
+    print "Thanks for visiting the Parrot Shell, come back soon!\n";
+    exit 0;
+}
+
+sub show_help {
+    print <<'EX';
+
+The Parrot Shell allows you to rapidly prototype Parrot code. It wraps your code
+in a ".sub main" and ".end", so you don't have to, unless your code begins with
+".sub". It reads code from STDIN until it sees a line containing a single ".",
+which is how you tell parrot_shell to run the code you are giving to it:
+
+Example:
+    parrot_shell> $I0 = 42
+    $N1 = sqrt $I0
+    say $N1
+    .
+    Output:
+    6.48074069840786
+EX
+}
+
+sub eval_snippet {
+    my ($snippet) = @_;
+    my $codefn   = get_tempfile();
+    my $stdoutfn = get_tempfile();
+    my $f        = IO::File->new(">$codefn");
+
+    $f->print(normalize_snippet($snippet));
+    $f->close();
+
+    system("$parrot $codefn >$stdoutfn 2>&1");
+
+    handle_errors($?) if $?;
+
+    $f = IO::File->new($stdoutfn);
+
+    my $output = join( '', <$f> );
+    return "Output:\n$output";
+}
+
+sub handle_errors {
+    my ($exit_code) = @_;
+    if ($exit_code == -1) {
+        print "Error: failed to execute: $!\n";
+    } elsif ($exit_code & 127) {
+        printf "Error: child died with signal %d, %s coredump\n",
+            ($exit_code & 127),  ($exit_code & 128) ? 'with' : 'without';
+    } else {
+        printf "Error: child exited with value %d\n", $? >> 8;
+    }
+}
+
+sub get_tempfile {
+    my (undef, $name)   = tempfile( CLEANUP => 1);
+    return $name;
+}
+
+sub normalize_snippet {
+    my ($snippet) = @_;
+
+    if ($snippet =~ m/^\.sub/) {
+        # don't wrap snippet
+        return $snippet;
+    } else {
+        return <<SNIP;
+.sub main :main
+$snippet
+.end
+SNIP
+    }
+}


More information about the parrot-commits mailing list