[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