Commits

patrick.michaud  committed 5be9a49

Update pynie's build system to match rakudo's.

  • Participants
  • Parent commits c1a0056

Comments (0)

Files changed (8)

File Configure.pl

-# Copyright (C) 2009, Parrot Foundation.
-# $Id: Configure.pl 37311 2009-03-11 18:04:17Z fperrad $
+#! perl
+# Copyright (C) 2009 The Perl Foundation
 
 use strict;
 use warnings;
 use 5.008;
 
-#  Get a list of parrot-configs to invoke.
-my @parrot_config_exe = (
-    'parrot/parrot_config',
-    '../../parrot_config',
-    'parrot_config',
-);
+MAIN: {
+    my %valid_options = (
+        'help'          => 'Display configuration help',
+        'parrot-config' => 'Use configuration given by parrot_config binary',
+        'gen-parrot'    => 'Automatically retrieve and build Parrot',
+    );
 
-#  Get configuration information from parrot_config
-my %config = read_parrot_config(@parrot_config_exe);
-unless (%config) {
-    die "Unable to locate parrot_config.";
+    # Get any options from the command line
+    my %options = get_command_options( \%valid_options );
+
+    # Print help if it's requested
+    if ($options{'help'}) {
+        print_help();
+        exit(0);
+    }
+
+    # Update/generate parrot build if needed
+    if ($options{'gen-parrot'}) {
+        system("$^X build/gen_parrot.pl");
+    }
+
+    # Get a list of parrot-configs to invoke.
+    my @parrot_config_exe = qw(
+        parrot/parrot_config
+        ../../parrot_config
+        parrot_config
+    );
+
+    if ($options{'parrot-config'} && $options{'parrot-config'} ne '1') {
+        @parrot_config_exe = ($options{'parrot-config'});
+    }
+
+    #  Get configuration information from parrot_config
+    my %config = read_parrot_config(@parrot_config_exe);
+    unless (%config) {
+        die <<'END';
+Unable to locate parrot_config.
+To automatically checkout (svn) and build a copy of parrot,
+try re-running Configure.pl with the '--gen-parrot' option.
+Or, use the '--parrot-config' option to explicitly specify
+the location of parrot_config.
+END
+    }
+
+#  Create the Makefile using the information we just got
+    create_makefile(%config);
+
+    my $make = $config{'make'};
+    print <<"END";
+
+You can now use '$make' to build Pynie.
+After that, you can use '$make test' to run some local tests,
+
+END
+    exit 0;
+
 }
 
-#  Create the Makefile using the information we just got
-create_makefiles(%config);
+
+#  Process command line arguments into a hash.
+sub get_command_options {
+    my $valid_options = shift;
+
+    my %options = ();
+    for my $arg (@ARGV) {
+        if ($arg =~ /^--(\w[-\w]*)(?:=(.*))?/ && $valid_options->{$1}) {
+            my ($key, $value) = ($1, $2);
+            $value = 1 unless defined $value;
+            $options{$key} = $value;
+            next;
+        }
+        die qq/Invalid option "$arg".  See "perl Configure.pl --help" for valid options.\n/;
+    }
+    return %options;
+}
+
 
 sub read_parrot_config {
     my @parrot_config_exe = @_;
         if (open my $PARROT_CONFIG, '-|', "$exe --dump") {
             print "Reading configuration information from $exe\n";
             while (<$PARROT_CONFIG>) {
-                $config{$1} = $2 if (/(\w+) => '(.*)'/);
+                if (/(\w+) => '(.*)'/) { $config{$1} = $2 }
             }
-            close $PARROT_CONFIG;
+            close $PARROT_CONFIG or die $!;
             last if %config;
         }
     }
-    %config;
+    return %config;
 }
 
 
-#  Generate Makefiles from a configuration
-sub create_makefiles {
+#  Generate a Makefile from a configuration
+sub create_makefile {
     my %config = @_;
-    my %makefiles = (
-        'config/makefiles/root.in' => 'Makefile',
-#        'config/makefiles/pmc.in'  => 'src/pmc/Makefile',
-#        'config/makefiles/ops.in'  => 'src/ops/Makefile',
-    );
-    my $build_tool = $config{libdir} . $config{versiondir}
-                   . '/tools/dev/gen_makefile.pl';
 
-    foreach my $template (keys %makefiles) {
-        my $makefile = $makefiles{$template};
-        print "Creating $makefile\n";
-        system($config{perl}, $build_tool, $template, $makefile);
+    my $maketext = slurp( 'build/Makefile.in' );
+
+    $config{'win32_libparrot_copy'} = $^O eq 'MSWin32' ? 'copy $(BUILD_DIR)\libparrot.dll .' : '';
+    $maketext =~ s/@(\w+)@/$config{$1}/g;
+    if ($^O eq 'MSWin32') {
+        $maketext =~ s{/}{\\}g;
+        $maketext =~ s{http:\S+}{ do {my $t = $&; $t =~ s'\\'/'g; $t} }eg;
     }
+
+    my $outfile = 'Makefile';
+    print "Creating $outfile\n";
+    open(my $MAKEOUT, '>', $outfile) ||
+        die "Unable to write $outfile\n";
+    print {$MAKEOUT} $maketext;
+    close $MAKEOUT or die $!;
+
+    return;
+}
+
+sub slurp {
+    my $filename = shift;
+
+    open my $fh, '<', $filename or die "Unable to read $filename\n";
+    local $/ = undef;
+    my $maketext = <$fh>;
+    close $fh or die $!;
+
+    return $maketext;
+}
+
+
+#  Print some help text.
+sub print_help {
+    print <<'END';
+Configure.pl - Pynie Configure
+
+General Options:
+    --help             Show this text
+    --gen-parrot       Download and build a copy of Parrot to use
+    --parrot-config=(config)
+                       Use configuration information from config
+
+END
+
+    return;
 }
 
 # Local Variables:
 #   fill-column: 100
 # End:
 # vim: expandtab shiftwidth=4:
-

File build/Makefile.in

+# Copyright (C) 2006-2009, The Perl Foundation.
+# $Id$
+
+# arguments we want to run parrot with
+PARROT_ARGS =
+
+# values from parrot_config
+BUILD_DIR     = @build_dir@
+LOAD_EXT      = @load_ext@
+O             = @o@
+EXE           = @exe@
+MAKE          = @make_c@
+PERL          = @perl@
+RM_F          = @rm_f@
+
+# Various paths
+PARROT_DYNEXT = $(BUILD_DIR)/runtime/parrot/dynext
+PERL6GRAMMAR  = $(BUILD_DIR)/runtime/parrot/library/PGE/Perl6Grammar.pbc
+NQP           = $(BUILD_DIR)/compilers/nqp/nqp.pbc
+PCT           = $(BUILD_DIR)/runtime/parrot/library/PCT.pbc
+
+# Setup some commands
+PARROT        = $(BUILD_DIR)/parrot$(EXE)
+CAT           = $(PERL) -MExtUtils::Command -e cat
+BUILD_DYNPMC  = $(PERL) $(BUILD_DIR)/tools/build/dynpmc.pl
+BUILD_DYNOPS  = $(PERL) $(BUILD_DIR)/tools/build/dynoplibs.pl
+RECONFIGURE   = $(PERL) $(BUILD_DIR)/tools/dev/reconfigure.pl
+PBC_TO_EXE    = $(BUILD_DIR)/pbc_to_exe$(EXE)
+
+SOURCES = pynie.pir \
+  src/gen_grammar.pir \
+  src/gen_actions.pir \
+  src/gen_builtins.pir \
+  src/parser/indent.pir \
+
+
+BUILTINS_PIR = \
+  src/builtins/funcs.pir \
+  src/builtins/io.pir \
+  src/builtins/lists.pir \
+  src/builtins/oper.pir
+
+
+CLEANUPS = \
+  pynie.pbc \
+  pynie.c \
+  perl6$(O) \
+  perl6$(EXE) \
+  src/gen_*.pir \
+  src/gen_*.pm \
+
+
+# NOTE: eventually, we should remove --keep-exit-code and --fudge
+#       as the goal is that all tests must pass without fudge
+HARNESS_WITH_FUDGE = $(PERL) t/harness --fudge --keep-exit-code
+HARNESS_WITH_FUDGE_JOBS = $(HARNESS_WITH_FUDGE) --jobs
+
+
+# the default target
+all: pynie$(EXE)
+
+##  targets for building a standalone perl6.
+pynie$(EXE): $(PBC_TO_EXE) pynie.pbc
+	$(PBC_TO_EXE) pynie.pbc
+	@win32_libparrot_copy@
+
+# the Pynie compiler
+pynie.pbc: $(PARROT) $(SOURCES) $(BUILTINS_PIR)
+	$(PARROT) $(PARROT_ARGS) -o pynie.pbc pynie.pir
+
+src/gen_grammar.pir: $(PARROT) $(PERL6GRAMMAR) src/parser/grammar.pg
+	$(PARROT) $(PARROT_ARGS) $(PERL6GRAMMAR) \
+	    --output=src/gen_grammar.pir src/parser/grammar.pg
+
+src/gen_actions.pir: $(PARROT) $(NQP) $(PCT) src/parser/actions.pm
+	$(PARROT) $(PARROT_ARGS) $(NQP) --output=src/gen_actions.pir \
+	    --encoding=fixed_8 --target=pir src/parser/actions.pm
+
+src/gen_builtins.pir: $(BUILTINS_PIR)
+	$(CAT) $(BUILTINS_PIR) > src/gen_builtins.pir
+
+##  local copy of Parrot
+parrot: parrot/parrot_config build/PARROT_REVISION
+	$(PERL) build/gen_parrot.pl
+
+parrot/parrot_config:
+	@echo "Don't see parrot/parrot_config."
+
+##  testing targets
+test    : pynie$(EXE)
+	$(PERL) t/harness t/00-parrot
+
+# Run a single test
+t/*.t t/*/*.t t/*/*/*.t: all Test.pir
+	@$(HARNESS_WITH_FUDGE) --verbosity=1 $@
+
+
+##  cleaning
+clean:
+	$(RM_F) $(CLEANUPS)
+
+distclean: realclean
+
+realclean: clean
+	$(RM_F) src/utils/Makefile Makefile
+
+testclean:
+
+
+##  miscellaneous targets
+# a listing of all targets meant to be called by users
+help:
+	@echo ""
+	@echo "Following targets are available for the user:"
+	@echo ""
+	@echo "  all:               pynie.pbc"
+	@echo "                     This is the default."
+	@echo "  pynie$(EXE):       Some want a pony, others are satisfied with an executable."
+	@echo "  spectest_checkout  Performs svn checkout of official test suite."
+	@echo "  spectest_update    Performs svn update of official test suite."
+	@echo "  testable:          Create the pynie executable, compile the Test library,"
+	@echo "                     and update official test suite."
+	@echo ""
+	@echo "Testing:"
+	@echo "  test:              Run coretest and codetest."
+	@echo "  coretest:          Run rakudo's core tests."
+	@echo ""
+	@echo "Cleaning:"
+	@echo "  clean:             Basic cleaning up."
+	@echo "  distclean:         Removes also anything built, in theory."
+	@echo "  realclean:         Removes also files generated by 'Configure.pl'."
+	@echo "  testclean:         Clean up test results."
+	@echo ""
+	@echo "Misc:"
+	@echo "  help:              Print this help message."
+	@echo ""
+
+manifest:
+	echo MANIFEST >MANIFEST
+	# git ls-files | $(PERL) -ne '/^\./ || print' >>MANIFEST
+

File build/PARROT_REVISION

+37365

File build/gen_parrot.pl

+#! perl
+# Copyright (C) 2009 The Perl Foundation
+
+=head1 TITLE
+
+gen_parrot.pl - script to obtain and build Parrot for Rakudo
+
+=head2 SYNOPSIS
+
+    perl gen_parrot.pl
+
+=head2 DESCRIPTION
+
+Maintains an appropriate copy of Parrot in the parrot/ subdirectory.
+The revision of Parrot to be used in the build is given by the
+build/PARROT_REVISION file.
+
+=cut
+
+use strict;
+use warnings;
+use 5.008;
+
+#  Work out slash character to use.
+my $slash = $^O eq 'MSWin32' ? '\\' : '/';
+
+##  determine what revision of Parrot we require
+open my $REQ, "build/PARROT_REVISION"
+  || die "cannot open build/PARROT_REVISION\n";
+my $required = <$REQ>; chomp $required;
+close $REQ;
+
+{
+    no warnings;
+    if (open my $REV, '-|', "parrot${slash}parrot_config revision") {
+        my $revision = <$REV>;
+        close $REV;
+        chomp $revision;
+        if ($revision >= $required) {
+            print "Parrot r$revision already available (r$required required)\n";
+            exit(0);
+        }
+    }
+}
+
+print "Checking out Parrot r$required via svn...\n";
+system("svn checkout -r $required https://svn.parrot.org/parrot/trunk parrot");
+
+chdir('parrot');
+
+
+##  If we have a Makefile from a previous build, do a 'make realclean'
+if (-f 'Makefile') {
+    my %config = read_parrot_config();
+    my $make = $config{'make'};
+    if ($make) {
+        print "Performing '$make realclean'\n";
+        system("$make realclean");
+    }
+}
+
+##  Configure Parrot
+system("$^X Configure.pl --prefix=install");
+
+my %config = read_parrot_config();
+my $make = $config{'make'};
+
+system($make);
+
+sub read_parrot_config {
+    my %config = ();
+    if (open my $CFG, "config_lib.pasm") {
+        while (<$CFG>) {
+            if (/P0\["(.*?)"], "(.*?)"/) { $config{$1} = $2 }
+        }
+        close $CFG;
+    }
+    %config;
+}
+    

File src/parser/Actions.pm

-# $Id: Actions.pm 36833 2009-02-17 20:09:26Z allison $
-# Copyright (C) 2007, Parrot Foundation.
-
-class Pynie::Grammar::Actions;
-
-method TOP($/) {
-    my $block := PAST::Block.new( $( $<file_input> ) );
-    $block.hll('pynie');
-    make $block;
-}
-
-method file_input($/) {
-    my $past := PAST::Stmts.new( :node($/) );
-    for $<statement> {
-        $past.push( $($_) );
-    }
-    make $past;
-}
-
-method suite($/, $key) {
-    make $( $/{$key} );
-}
-
-method suite1($/) {
-    make $( $<stmt_list> );
-}
-
-method suite2($/) {
-    my $past := PAST::Stmts.new( :node($/) );
-    for $<statement> {
-        $past.push($($_));
-    }
-    make $past;
-}
-
-method statement($/, $key) {
-    make $($/{$key});
-}
-
-method stmt_list($/) {
-    my $past := PAST::Stmts.new( :node($/) );
-    for $<simple_stmt> {
-        $past.push( $($_) );
-    }
-    make $past;
-}
-
-method compound_stmt($/, $key) {
-    make $($/{$key});
-}
-
-method assert_stmt($/) {
-    ## assert exp1
-    ##
-    ## translates to:
-    ##
-    ## if __debug__:
-    ##   if not exp1
-    ##
-
-    ## XXX handle exp2.
-
-    my $exp1 := $( $<exp1> );
-
-    ## XXX change into "AssertionError"
-    my $exception := PAST::Op.new( :inline('    %r = new "Exception"') );
-
-    my $throwcode := PAST::Op.new( $exception, :pirop('throw'), :node($/) );
-
-    my $debugcode := PAST::Op.new( $exp1, $throwcode,
-                                   :pasttype('unless'),
-                                   :node($/) );
-
-    my $debugflag := PAST::Var.new( :name('__debug__'),
-                                    :scope('package'),
-                                    :viviself('Undef'),
-                                    :node($/) );
-
-    my $past := PAST::Op.new( $debugflag,
-                              $debugcode,
-                              :pasttype('if'),
-                              :node($/) );
-
-    make $past;
-}
-
-method if_stmt($/) {
-    my $cond := +$<expression> - 1;
-    my $past := PAST::Op.new( $( $<expression>[$cond] ),
-                              $( $<suite>[$cond] ),
-                              :pasttype('if'),
-                              :node( $/ )
-                            );
-    if ( $<else> ) {
-        $past.push( $( $<else>[0] ) );
-    }
-    while ($cond != 0) {
-        $cond := $cond - 1;
-        $past := PAST::Op.new( $( $<expression>[$cond] ),
-                               $( $<suite>[$cond] ),
-                               $past,
-                               :pasttype('if'),
-                               :node( $/ )
-                             );
-    }
-    make $past;
-}
-
-method while_stmt($/) {
-    my $past := PAST::Op.new( $( $<expression> ),
-                              $( $<suite> ),
-                              :pasttype('while'),
-                              :node( $/ )
-                            );
-    if $<else> {
-        ##  handle 'else' clause
-        $past := PAST::Stmts.new( $past,
-                                  $( $<else>[0] ),
-                                  :node( $/ )
-                                );
-    }
-    make $past;
-}
-
-method for_stmt($/) {
-    # translates to:
-    # $P0 = new 'Iterator', <expression_list>
-    # while $P0:
-    #   i = shift $P0
-    #   ...
-
-    # XXX implement complex for syntax
-
-    # XXX right now this uses a Block rather than Stmts so that $iter's scope
-    # XXX is confined to this 'for'. Better to use Stmts and make $iter an anonymous register.
-    #my $past := PAST::Stmts.new( :node($/) );
-    my $past := PAST::Block.new( :blocktype('immediate'), :node($/) );
-
-    # create iterator
-    my $list := $( $<expression_list> );
-    my $iter := PAST::Var.new(     :name('iter'), :scope('register'), :node($/) );
-    my $iterdecl := PAST::Var.new( :name('iter'), :scope('register'), :node($/), :isdecl(1) );
-    $past.push( $iterdecl );
-    $past.push( PAST::Op.new( $iter, $list,
-                              :inline('    %0 = new "Iterator", %1'),
-                              :node($/) ) );
-
-    # make loop body
-    my $tgt := $( $<target> );
-    my $loop := PAST::Stmts.new( :node($/) );
-    my $shifted := PAST::Op.new( $iter,
-                                 :inline('    %r = shift %0'),
-                                 :node($/) );
-    $loop.push( PAST::Op.new( $tgt, $shifted, :pasttype('bind'), :node($/) ) );
-    $loop.push( $( $<suite> ) );
-
-    $past.push( PAST::Op.new( $iter, $loop,
-                              :pasttype('while'),
-                              :node($/) ) );
-    make $past;
-}
-
-method parameter_list($/) {
-    ## the only place for parameters to live is in a function block;
-    ## create that here already.
-    my $past := PAST::Block.new( :blocktype('declaration'), :node($/) );
-
-    ## handle normal parameters
-    for $<defparameter> {
-        $past.push( $($_) );
-    }
-
-    ## handle '*' <identifier>
-    if $<excess_positional_parameter> {
-        my $slurpparam := $( $<excess_positional_parameter> );
-        $past.push( $slurpparam );
-    }
-    ## handle '**' <identifier>
-    if $<excess_keyword_parameter> {
-        my $dictparam := $( $<excess_keyword_parameter> );
-        $past.push( $dictparam );
-    }
-    make $past;
-}
-
-method defparameter($/) {
-    my $past := $( $<parameter> );
-    $past.scope('parameter');
-
-    ## add the default value for this parameter, if any
-    if $<expression> {
-        my $defaultvalue := $( $<expression>[0] );
-        $past.viviself( $defaultvalue );
-    }
-    make $past;
-}
-
-method parameter($/, $key) {
-    make $( $/{$key} )
-}
-
-method sublist($/) {
-    ## XXX
-}
-
-method excess_positional_parameter($/) {
-    ## a :slurpy argument
-    my $past := $( $<identifier> );
-    $past.scope('parameter');
-    $past.slurpy(1);
-    make $past;
-}
-
-method excess_keyword_parameter($/) {
-    ## a :named, :slurpy argument
-    my $past := $( $<identifier> );
-    $past.scope('parameter');
-    $past.slurpy(1);
-    $past.named(1);
-    make $past;
-}
-
-method lambda_form($/) {
-    my $past;
-    if $<parameter_list> {
-        $past := $( $<parameter_list>[0] );
-    }
-    else { # if no parameters, create a block here:
-        $past := PAST::Block.new( :blocktype('declaration'), :node($/) );
-    }
-
-    my $expr := $( $<expression> );
-
-    ## add a return statement to this block
-    $past.push( PAST::Op.new( $expr, :pasttype('return'), :node($/) ) );
-    $past.control('return_pir');
-    make $past;
-}
-
-method funcdef($/) {
-    my $past;
-
-    if $<parameter_list> {
-        $past := $( $<parameter_list>[0] );
-    }
-    else {
-        $past := PAST::Block.new( :blocktype('declaration'), :node($/) );
-    }
-    my $name := $( $<funcname> );
-    $past.name( $name.name() );
-    $past.push( $($<suite>) );
-
-    $past.control('return_pir');
-    make $past;
-}
-
-method funcname($/) {
-    make $( $<identifier> );
-}
-
-method argument_list($/) {
-    my $past;
-
-    if $<positional_arguments> {
-        $past := $( $<positional_arguments> );
-    }
-    else {
-        $past := PAST::Op.new( :pasttype('call'), :node($/) );
-    }
-
-    if $<keyword_arguments> {
-        for $( $<keyword_arguments> ) {
-        ## XXX should this be: for @( $<keyword_arguments> )??
-            $past.push( $_ );
-        }
-    }
-
-    make $past;
-}
-
-method positional_arguments($/) {
-    my $past := PAST::Op.new( :pasttype('call'), :node($/) );
-    for $<expression> {
-        $past.push($($_));
-    }
-    make $past;
-}
-
-method keyword_arguments($/) {
-    my $past := PAST::Op.new( :pasttype('call'), :node($/) );
-    for $<keyword_item> {
-        $past.push($($_));
-    }
-    make $past;
-}
-
-method keyword_item($/) {
-    my $past := $( $<expression> );
-    my $name := $( $<identifier> );
-
-    ## XXX why doesn't this work??
-    #$past.named( $name.name() );
-    #make PAST::Val.new( :value('100'), :named('x'), :node($/) );
-    make $past;
-}
-
-method classname($/) {
-    make $( $<identifier> );
-}
-
-method classdef($/) {
-    ## a class definition is a set of statements
-    my $past := PAST::Stmts.new( :node($/) );
-
-    ## create an anonymous sub that generates the class
-    my $cdef  := PAST::Block.new( :blocktype('declaration'), :node($/) );
-    my $cname := $( $<classname> );
-    my $pir   := '    $P0 = newclass "' ~ $cname.name() ~ '"';
-    $cdef.push( PAST::Op.new( :inline($pir) ) );
-    $cdef.pirflags(':init :anon');
-
-    ## handle parents, if available
-    if $<inheritance> {
-        my $parent    := $( $<inheritance>[0] );
-        my $pir       := '    addparent $P0, %0';
-        my $addparent := PAST::Op.new( $parent, :inline($pir), :node($/) );
-        $cdef.push($addparent);
-    }
-    $past.push($cdef);
-
-    ## handle class contents
-    my $suite := $( $<suite> );
-
-    make $past;
-}
-
-method del_stmt($/) {
-    our $?BLOCK;
-
-    my $targets := $( $<target_list> );
-
-    my $past := PAST::Stmts.new( :node($/) );
-
-    my $pir := "    .local pmc ns\n"
-             ~ '    ns = get_hll_namespace';
-
-    $past.push( PAST::Op.new( :inline($pir), :node($/) ) );
-    for @($targets) {
-        $pir := '    delete ns["' ~ $_.name() ~ '"]';
-        $past.push( PAST::Op.new( :inline($pir), :node($/) ) );
-    }
-
-    make $past;
-}
-
-method pass_stmt($/) {
-    ## pass statement doesn't do anything, but do create a PAST
-    ## node to prevent special case code.
-    make PAST::Op.new( :inline('    # pass'), :node($/) );
-}
-
-method raise_stmt($/) {
-    ## XXX finish this
-    my $numexpr := +$<expression>;
-
-    ## think of better structure to handle this:
-    if $numexpr == 0 {
-
-    }
-    elsif $numexpr == 1 {
-
-    }
-    elsif $numexpr == 2 {
-        #my $exctype  := $( $<expression> );
-        #my $excvalue := $( $<expression> );
-    }
-    elsif $numexpr == 3 {
-
-    } # else will never happen.
-
-    ## XXX for now this'll do:
-    my $exc  := PAST::Op.new( :inline('    %r = new "Exception"'), :node($/) );
-    my $pir  := '    throw %0';
-    my $past := PAST::Op.new( $exc, :inline($pir), :node($/) );
-
-    make $past;
-}
-
-method try_stmt($/, $key) {
-    make $( $/{$key} );
-}
-
-method try1_stmt($/) {
-    # XXX implement except params, else, finally
-    my $try := $($<try>);
-    my $handler := $($<except>);
-    my $past := PAST::Op.new( $try,
-                              $handler,
-                              :pasttype('try'),
-                              :node($/) );
-    make $past;
-}
-
-method simple_stmt($/, $key) {
-    make $( $/{$key} );
-}
-
-method expression_stmt($/) {
-    make $( $<expression_list> );
-}
-
-method return_stmt($/) {
-    my $past := PAST::Op.new( :pasttype('return'), :node($/) );
-    if $<expression_list> {
-        my $retvals := $( $<expression_list>[0] );
-        $past.push($retvals);
-    }
-    make $past;
-}
-
-method global_stmt($/) {
-    our $?BLOCK;
-    for $<identifier> {
-        $?BLOCK.symbol( $( $_ ).name(), :scope('package') );
-    }
-    ## make a no-op
-    make PAST::Op.new( :inline('    # global declaration'), :node($/) );
-}
-
-method expression_list($/) {
-    my $past;
-    if (+$<expression> == 1) {
-        $past := $( $<expression>[0] );
-    }
-    else {
-        $past := PAST::Op.new( :name('listmaker'), :node($/) );
-        for $<expression> {
-            $past.push( $($_) );
-        }
-    }
-    make $past;
-}
-
-
-method identifier($/) {
-    make PAST::Var.new( :name( ~$/ ),
-                        :scope('package'),
-                        :node($/) );
-}
-
-
-method print_stmt($/) {
-    my $past := PAST::Op.new( :name('printnl'), :node($/) );
-    for $<expression> {
-        $past.push( $($_) );
-    }
-    if $/[0] {
-        $past.name('print');
-    }
-    make $past;
-}
-
-
-method expression($/, $key) {
-    ## XXX incomplete.
-    if $key eq 'lambda_form' {
-        make $( $<lambda_form> );
-    }
-    else {
-        make $( $<or_test>[0] );
-    }
-}
-
-method test($/, $key) {
-    make $( $/{$key} );
-}
-
-method or_test($/) {
-    my $count := +$<and_test> - 1;
-    my $past := $( $<and_test>[$count] );
-    while $count != 0 {
-        $count := $count - 1;
-        $past := PAST::Op.new( $($<and_test>[$count]),
-                                  $past,
-                                  :pasttype('unless') );
-    }
-    make $past;
-}
-
-method and_test($/) {
-    my $count := +$<not_test> - 1;
-    my $past := $( $<not_test>[$count] );
-    while $count != 0 {
-        $count := $count - 1;
-        $past := PAST::Op.new( $($<not_test>[$count]),
-                                  $past,
-                                  :pasttype('if') );
-    }
-    make $past;
-}
-
-
-method not_test($/) {
-    my $past := $( $<in_test> );
-    for $<nots> {
-        $past := PAST::Op.new( $past, :pirop('not II'), :node($/) );
-    }
-    make $past;
-}
-
-
-method in_test($/) {
-    make $($<is_test>[0]);
-}
-
-
-method is_test($/) {
-    make $($<comparison>[0]);
-}
-
-method comparison($/, $key) {
-    if ($key eq 'end') {
-        make $($<expr>);
-    }
-    else {
-        my $past := PAST::Op.new( :name($<type>),
-                                  :pasttype($<top><pasttype>),
-                                  :pirop($<top><pirop>),
-                                  :lvalue($<top><lvalue>),
-                                  :node($/)
-                                );
-        for @($/) {
-            $past.push( $($_) );
-        }
-        make $past;
-    }
-}
-
-method list_iter($/, $key) {
-    make $( $/{$key} );
-}
-
-method list_for($/) {
-    ## XXX
-}
-
-method list_if($/) {
-    ## XXX
-}
-
-method primary($/) {
-    my $past := $( $<atom> );
-    ## $past is the first child of each <postop>, so unshift it
-    ## so it ends up at the front of the list.
-    for $<postop> {
-        my $postop := $($_);
-        $postop.unshift($past);
-        $past := $postop;
-    }
-    make $past;
-}
-
-method postop($/, $key) {
-    make $( $/{$key} );
-}
-
-method call($/, $key) {
-    # XXX fix this.
-    #make $( $/{$key} );
-    if $<argument_list> {
-        make $( $<argument_list>[0] );
-    }
-    else {
-        make PAST::Op.new( :pasttype('call'), :node($/) );
-    }
-}
-
-method attributeref($/) {
-    my $attr := $($<identifier>);
-    $attr.scope('attribute');
-    make $attr;
-}
-
-method methodcall($/) {
-    my $attrname := $($<identifier>).name();
-    my $call := $($<call>);
-    $call.pasttype('callmethod');
-    $call.name($attrname);
-    make $call;
-}
-
-method subscription($/) {
-    make PAST::Var.new( $( $<tuple_or_scalar> ), :scope('keyed'));
-}
-
-method atom($/, $key) {
-    make $( $/{$key} );
-}
-
-method literal($/, $key) {
-    make $( $/{$key} );
-}
-
-method integer($/) {
-    make PAST::Val.new( :value( ~$/ ), :returns('Integer'), :node($/) );
-}
-
-method floatnumber($/) {
-    make PAST::Val.new( :value( ~$/ ), :returns('Float'), :node($/) );
-}
-
-method stringliteral($/, $key) {
-    make $( $/{$key} );
-}
-
-method shortstring($/) {
-    make PAST::Val.new( :value( ~$/[0] ), :node($/) );
-}
-
-method parenth_form($/) {
-    if +$<tuple_or_scalar> {
-    make $( $<tuple_or_scalar>[0] );
-    }
-    else {
-        make PAST::Op.new( :name('tuplemaker'),
-                           :pasttype('call'));
-    }
-}
-
-method assignment_stmt($/) {
-    my $lhs     := $( $<target_list> );
-    my $explist := $( $<expression_list> );
-    my $past    := PAST::Stmts.new( :node($/) );
-
-# XXX For now, we'll only support single assignment.
-#    for @($lhs) {
-#        my $rhs := $explist.shift();
-#        $past.push( PAST::Op.new( $_, $rhs, :pasttype('bind'), :node($/) ) );
-#    }
-    $past := PAST::Op.new( $lhs.shift(), $explist, :pasttype('bind'), :node($/) );
-
-    make $past;
-}
-
-method augop($/, $key) {
-    make PAST::Op.new( :pirop($key), :node($/) );
-}
-
-method augmented_assignment_stmt($/) {
-    my $past := $($<augop>);
-    $past.push( $($<target>) );
-    $past.push( $($<expression>) );
-    make $past;
-}
-
-method target_list($/) {
-    my $past := PAST::VarList.new( :node($/) );
-    for $<target> {
-        $past.push( $($_) );
-    }
-    make $past;
-}
-
-method target($/, $key) {
-    my $past := $( $/{$key} );
-    $past.lvalue(1);
-    make $past;
-}
-
-method list_literal($/) {
-    my $past := PAST::Op.new( :name('listmaker'), :pasttype('call'), :node($/) );
-    for $<expression> {
-        $past.push( $($_) );
-    }
-    make $past;
-}
-
-method list_display($/, $key) {
-    make $( $/{$key} );
-}
-
-method dict_display($/) {
-    if $<key_datum_list> {
-        make $( $<key_datum_list>[0] );
-    }
-    else {
-        ## if there's no list of key_datum items, have 'dictmaker' return an empty
-        ## dictionary.
-        make PAST::Op.new( :name('dictmaker'), :pasttype('call'), :node($/) );
-    }
-}
-
-method key_datum_list($/) {
-    my $past := PAST::Op.new( :name('dictmaker'), :pasttype('call'), :node($/) );
-    for $<key_datum> {
-        $past.push( $( $_ ) );
-    }
-    make $past;
-}
-
-method key_datum($/) {
-    my $key   := $( $<key> );
-    my $value := $( $<value> );
-    ## this only works if $key /has/ a name() method
-    ## XXX need for some generic solution for all PAST node types.
-    my $hashedkey := PAST::Val.new( :value($key.name()) );
-    $value.named($hashedkey);
-    make $value;
-}
-
-method tuple_or_scalar($/, $key) {
-    make $( $/{$key} );
-}
-
-method tuple_constructor($/) {
-    my $past := PAST::Op.new( :name('tuplemaker'), :pasttype('call'), :node($/) );
-    for $<expression> {
-        $past.push( $($_) );
-    }
-    make $past;
-}

File src/parser/Grammar.pg

-## $Id: Grammar.pg 35834 2009-01-20 18:52:51Z pmichaud $
-
-## TITLE
-##     Pynie::Grammar -- a grammar for parsing Python
-##
-## DESCRIPTION
-##
-## These are a set of rules for parsing programs written in Python.
-## Many of the rules are derived from the "Python Language Reference
-## Manual", version 2.5 by Guido van Rossum (Fred L. Drake, Jr., Editor).
-## Available online at http://docs.python.org/ref/ and
-## http://docs.python.org/ref/grammar.txt .
-
-grammar Pynie::Grammar is PCT::Grammar;
-
-token TOP {
-    <.indent_zero>
-    <file_input>
-    {*}
-}
-
-token newline { [ <.ws> \n ]+ }
-
-token ws {
-    [ ^^
-      [ \h* '#' \N* ]? ]
-    ||
-    [ \h*   [ '#' \N* ]? ]
-}
-
-token file_input {
-    ^ [ <.newline> | <statement> ]*
-    [ $ || <.panic: 'syntax_error'> ]
-    {*}
-}
-
-token suite {
-    | <suite1> {*}               #= suite1
-    | <suite2> {*}               #= suite2
-}
-
-token suite1 {
-    <stmt_list> <.newline> {*}
-}
-
-token suite2 {
-    <.newline> <.indent> <statement>
-    [ <.indent_same> <statement> ]*
-    [ <.dedent> | <.panic: 'IndentationError: unindent does not match any outer indentation level'> ]
-    {*}
-}
-
-token statement {
-    | <compound_stmt> {*}                        #= compound_stmt
-    | <stmt_list> <.newline> {*}                 #= stmt_list
-}
-
-token stmt_list {
-    <simple_stmt> [ ';' <simple_stmt> ]* ';'?
-    {*}
-}
-
-token compound_stmt {
-    | <if_stmt> {*}                              #= if_stmt
-    | <while_stmt> {*}                           #= while_stmt
-    | <for_stmt> {*}                             #= for_stmt
-    | <try_stmt> {*}                             #= try_stmt
-    | <with_stmt>
-    | <funcdef> {*}                              #= funcdef
-    | <classdef> {*}                             #= classdef
-}
-
-rule if_stmt {
-    'if' <expression> ':' <suite>
-    [ 'elif' <expression> ':' <suite> ]*
-    [ 'else' ':' $<else>=<suite> ]?
-    {*}
-}
-
-rule while_stmt {
-    'while' <expression> ':' <suite>
-    [ 'else' ':' <else=suite> ]?
-    {*}
-}
-
-rule for_stmt {
-    'for' <target> 'in' <expression_list> ':' <suite>
-#    'for' <target_list> 'in' <expression_list> ':' <suite>
-#    [ 'else' ':' <suite> ]?
-    {*}
-}
-
-rule try_stmt {
-    | <try1_stmt> {*}                   #= try1_stmt
-    | <try2_stmt>
-}
-
-rule try1_stmt {
-    'try' ':' <try=suite>
-    'except' ':' <except=suite>
-#    'except' [ <expression> [ ',' <target> ]? ]? ':' <suite>
-#    [ 'else' ':' <suite> ]?
-#    [ 'finally' ':' <suite> ]?
-    {*}
-}
-
-rule try2_stmt {
-    'try' ':' <suite>
-    'finally' ':' <suite>
-}
-
-rule with_stmt {
-    'with' <expression> [ 'as' <target> ]? ':' <suite>
-}
-
-rule funcdef {
-    <decorators>? 'def' <funcname> '(' <parameter_list>? ')'
-    ':' <suite>
-    {*}
-}
-
-rule decorators {
-    <decorator>+
-}
-
-rule decorator {
-    '@' <dotted_name> [ '(' [ <argument_list> ','? ]? ')' ]? <.newline>
-}
-
-rule argument_list {
-    [
-      [ <keyword_arguments>
-      | <positional_arguments> ',' <keyword_arguments>
-      | <positional_arguments>
-      ]
-        [ ',' <excess_positional_argument> ]?
-        [ ',' <excess_keyword_argument> ]?
-    | <keyword_arguments>
-        [ ',' <excess_positional_argument> ]?
-        [ ',' <excess_keyword_argument> ]?
-    | <excess_positional_argument>
-        [ ',' <excess_keyword_argument> ]?
-    | <excess_keyword_argument>
-    ]
-    {*}
-}
-
-
-rule excess_keyword_argument {
-    '**' <expression>
-}
-
-rule excess_positional_argument {
-    '*' <expression>
-}
-
-rule positional_arguments {
-    <expression> [ ',' <expression> ]*
-    {*}
-}
-
-rule keyword_arguments {
-    <keyword_item> [ ',' <keyword_item> ]*
-    {*}
-}
-
-rule keyword_item {
-    <identifier> '=' <expression>
-    {*}
-}
-
-rule dotted_name {
-    <identifier> [ '.' <identifier> ]*
-}
-
-rule funcname {
-    <identifier> {*}
-}
-
-rule parameter_list {
-    [ <defparameter> ',' ]*
-    [ <excess_positional_parameter> ',' <excess_keyword_parameter>
-    | <excess_positional_parameter>
-    | <excess_keyword_parameter>
-    | <defparameter> ','?
-    ]
-    {*}
-}
-
-rule excess_positional_parameter {
-    '*' <identifier>
-    {*}
-}
-
-rule excess_keyword_parameter {
-    '**' <identifier>
-    {*}
-}
-
-rule defparameter {
-    <parameter> [ '=' <expression> ]?
-    {*}
-}
-
-rule sublist {
-    <parameter> [ ',' <parameter> ]* ','?
-}
-
-rule parameter {
-    | <identifier> {*}             #= identifier
-    | '(' <sublist> ')'            #= sublist
-}
-
-
-rule classdef {
-    'class' <classname> <inheritance>? ':' <suite>
-    {*}
-}
-
-rule classname {
-    <identifier> {*}
-}
-
-rule inheritance {
-    '(' <expression_list>? ')'
-}
-
-
-rule lambda_form {
-    'lambda' <parameter_list>? ':' <expression>
-    {*}
-}
-
-token simple_stmt {
-    | <assert_stmt> {*}                          #= assert_stmt
-    | <assignment_stmt> {*}                      #= assignment_stmt
-    | <augmented_assignment_stmt> {*}            #= augmented_assignment_stmt
-    | <expression_stmt> {*}                      #= expression_stmt
-    | <pass_stmt> {*}                            #= pass_stmt
-    | <del_stmt> {*}                             #= del_stmt
-    | <print_stmt> {*}                           #= print_stmt
-    | <return_stmt> {*}                          #= return_stmt
-    | <yield_stmt>
-    | <raise_stmt> {*}                           #= raise_stmt
-    | <break_stmt>
-    | <continue_stmt>
-    | <import_stmt>
-    | <global_stmt> {*}                          #= global_stmt
-    | <exec_stmt>
-}
-
-rule expression_stmt {
-    <expression_list> {*}
-}
-
-rule assert_stmt {
-    'assert' <exp1=expression> [ ',' <exp2=expression> ]?
-    {*}
-}
-
-rule assignment_stmt {
-    <target_list> '=' <expression_list>
-    {*}
-}
-
-rule augmented_assignment_stmt {
-    <target> <augop> <expression>
-    {*}
-}
-
-rule target_list {
-    <target> [ ',' <target> ]* ','?
-    {*}
-}
-
-rule target {
-    | '(' <target_list> ')'
-    | '[' <target_list> ']'
-    | <identifier> {*}                           #= identifier
-    #| <primary> <attributeref>
-    #| <primary> <subscription>
-    #| <primary> <slicing>
-}
-
-rule call {
-    '(' <argument_list>? ')' {*}                                  #= argument_list
-    #| '(' [ <argument_list>? ','? ]? ')' {*}
-    #| '(' [ <argument_list> ','? | <test> <genexpr_for> ] ')'
-}
-
-rule attributeref {
-    '.' <identifier>
-    {*}
-}
-
-rule methodcall {
-    '.' <identifier> <call>
-    {*}
-}
-
-rule subscription {
-    '[' <tuple_or_scalar> ']' {*}
-}
-
-rule slicing {
-    | <simple_slicing>
-    | <extended_slicing>
-}
-
-rule simple_slicing {
-    '[' <short_slice> ']'
-}
-
-rule extended_slicing {
-    '[' <slice_list> ']'
-}
-
-rule slice_list {
-    <slice_item> [ ',' <slice_item> ]* ','?
-}
-
-rule slice_item {
-    <expression> | <proper_slice> | '...'
-}
-
-rule proper_slice {
-    | <short_slice>
-    | <long_slice>
-}
-
-rule short_slice {
-    [<start=expression>]? ':' [<end=expression>]?
-}
-
-rule long_slice {
-    <short_slice> ':' <expression>?
-}
-
-token identifier { <!reserved> [ <.alpha> | '_' ] \w* {*} }
-
-token name { <!reserved> <[a..z]> [ <alpha> | '_' ]* }
-
-rule print_stmt {
-    'print' [ <expression> [ ',' <expression> ]* ( ',' )? ]?
-    {*}
-}
-
-rule pass_stmt {
-    'pass' {*}
-}
-
-rule del_stmt {
-    'del' <target_list> {*}
-}
-
-rule return_stmt {
-    'return' <expression_list>?
-    {*}
-}
-
-rule yield_stmt {
-    'yield' <expression_list>
-}
-
-rule break_stmt {
-    'break'
-}
-
-rule continue_stmt {
-    'continue'
-}
-
-rule raise_stmt {
-    'raise' [ <expression>
-              [ ',' <expression>
-                [ ',' <expression> ]?
-              ]?
-            ]?
-    {*}
-}
-
-rule global_stmt {
-    'global' <identifier> [ ',' <identifier> ]*
-    {*}
-}
-
-rule exec_stmt {
-    'exec' <expression>
-    [ 'in' <expression> [ ',' <expression> ]? ]?
-}
-
-rule import_stmt {
-    | 'import' <module> <import_alias>?
-      [ ',' <module> <import_alias>? ]*
-    | <import_module> <identifier> <import_alias>?
-      [ ',' <identifier> <import_alias>? ]*
-    | <import_module> '(' <identifier> <import_alias>?
-      [ ',' <identifier> <import_alias>? ]* ','? ')'
-    | <import_module> '*'
-}
-
-rule import_module {
-    'from' <module> 'import'
-}
-
-rule import_alias {
-    'as' <name>
-}
-
-rule module {
-    [ <identifier> '.' ]* <identifier>
-}
-
-token literal {
-    | <stringliteral> {*}                        #= stringliteral
-    | <imagnumber>
-    | <floatnumber> {*}                          #= floatnumber
-    | <longinteger>
-    | <integer> {*}                              #= integer
-}
-
-token integer {
-    [
-    | '0' <[0..7]>+
-    | '0' <[xX]> [ \d | <[a..f]> | <[A..F]> ]+
-    | <[1..9]> \d* | '0'
-    ]
-    {*}
-}
-
-token intpart { \d+ }
-
-token longinteger { <integer> <[lL]> }
-
-token imagnumber { [ <floatnumber> | <intpart> ] <[jJ]> }
-
-token floatnumber {
-    [ \d* '.' \d+ [ <[eE]> <[+\-]>? \d+ ]?
-    | \d+ '.' [ <[eE]> <[+\-]>? \d+ ]?
-    | \d+ <[eE]> <[+\-]>? \d+
-    ]
-    {*}
-}
-
-token stringliteral {
-    <stringprefix>?
-    [ <longstring> {*}                           #= longstring
-    | <shortstring> {*}                          #= shortstring
-    ]
-}
-
-token shortstring {
-    [
-    | \" ( [ \\ . | <-["\n]> ]* ) \"
-    | \' ( [ \\ . | <-['\n]> ]* ) \'
-    ]
-    {*}
-}
-
-regex longstring {
-    | \"\"\" ( [ \\ . | . ]* ) \"\"\"
-    | \'\'\' ( [ \\ . | . ]* ) \'\'\'
-}
-
-
-token stringprefix {
-    $<prefix>=['r'|'u'|'ur'|'R'|'U'|'UR'|'Ur'|'uR']
-}
-
-rule expression_list {
-     <expression> [',' <expression> ]* ','? {*}
-}
-
-rule tuple_or_scalar {
-    | <tuple_constructor> {*} #= tuple_constructor
-    | <expression> {*}        #= expression
-}
-
-rule tuple_constructor {
-      <expression> ',' [ <expression> [ ',' <expression> ]* ','? ]? {*}
-}
-
-rule list_display {
-    '['
-        [ <list_literal> {*}       #= list_literal
-        # | <list_comprehension> {*} #= list_comprehension
-        ]
-     ']'
-}
-
-rule list_literal {
-     [ <expression> [',' <expression> ]* ','? ]?
-     {*}
-}
-
-rule list_comprehension {
-     <expression> <list_iter>+
-}
-
-rule list_iter {
-    | <list_for> {*}           #= list_for
-    | <list_if> {*}            #= list_if
-}
-
-rule list_for {
-    'for' <expression_list> 'in' <testlist>
-    <list_iter>?
-}
-
-rule list_if {
-    'if' <test>
-    <list_iter>?
-}
-
-rule test {
-    | <or_test> {*}             #= or_test
-    | <lambda_form> {*}         #= lambda_form
-}
-
-rule testlist {
-    <test> [ ',' <test> ]* ','?
-}
-
-token augop {
-    | '+='  {*}         #= add
-    | '-='  {*}         #= sub
-    | '*='  {*}         #= mul
-    | '/='  {*}         #= div
-    | '\%=' {*}         #= mod
-#    | '**=' {*}         #= pow
-    | '>>=' {*}         #= shr
-    | '<<=' {*}         #= shl
-    | '&='  {*}         #= band
-    | '^='  {*}         #= bxor
-    | '|='  {*}         #= bor
-}
-
-rule primary {
-    <atom> <postop>*
-    {*}
-}
-
-rule postop {
-    | <methodcall> {*}         #= methodcall
-    | <attributeref> {*}       #= attributeref
-    | <subscription> {*}       #= subscription
-    #| <slicing>
-    | <call> {*}               #= call
-}
-
-
-rule atom {
-    | <identifier> {*}                           #= identifier
-    | <literal> {*}                              #= literal
-    | <parenth_form> {*}                         #= parenth_form
-    | <list_display> {*}                         #= list_display
-   #| <generator_expression>           #   ""
-    | <dict_display> {*}                         #= dict_display
-   #| <string_conversion>              #   ""
-}
-
-rule parenth_form {
-    '(' <tuple_or_scalar>? ')'
-    {*}
-}
-
-rule generator_expression {
-    '(' <test> <genexpr_for> ')'
-}
-
-rule genexpr_for {
-    'for' <expression_list> 'in' <test>
-    <genexpr_iter>?
-}
-
-rule genexpr_iter {
-    | <genexpr_for>
-    | <genexpr_if>
-}
-
-rule genexpr_if {
-    'if' <test> <genexpr_iter>?
-}
-
-rule dict_display {
-    '{' <key_datum_list>? '}'
-    {*}
-}
-
-rule key_datum_list {
-    <key_datum> [ ',' <key_datum> ]* ','?
-    {*}
-}
-
-rule key_datum {
-    <key=expression> ':' <value=expression>
-    {*}
-}
-
-rule string_conversion {
-    '`' <expression_list> '`'
-}
-
-# Evaluation order of expressions is based on the table as provided in
-# http://docs.python.org/ref/summary.html
-#
-#
-rule expression {
-    | <or_test> [ 'if' <or_test> 'else' <test> ]?  {*}     #= or_test
-    | <lambda_form> {*}                                    #= lambda_form
-}
-
-rule or_test {
-    <and_test> [ 'or' <and_test> ]*
-    {*}
-}
-
-rule and_test {
-    <not_test> [ 'and' <not_test> ]*
-    {*}
-}
-
-rule not_test {
-    [$<nots>='not']* <in_test> {*}
-}
-
-rule in_test {
-    <is_test> [ ['not']? 'in' <is_test> ]*
-    {*}
-}
-
-rule is_test {
-    <comparison> [ 'is' ['not']? <comparison> ]*
-    {*}
-}
-
-token 'comparison' is optable { ... }
-
-proto 'term:'      is precedence('=')    is parsed(&primary) { ... }
-proto infix:<**>   is looser('term:')        { ... }
-proto prefix:<~>   is looser(infix:<**>)     { ... }
-proto prefix:<+>   is looser(prefix:<~>)     { ... }
-proto prefix:<->   is equiv(prefix:<+>)  is pirop('neg')     { ... }
-proto infix:<*>    is looser(prefix:<+>) is pirop('mul')     { ... }
-proto infix:</>    is equiv(infix:<*>)   is pirop('div')     { ... }
-proto infix:<//>   is equiv(infix:<*>)   is pirop('fdiv')    { ... }
-proto infix:<%>    is equiv(infix:<*>)   is pirop('mod')     { ... }
-proto infix:<+>    is looser(infix:<*>)  is pirop('add')     { ... }
-proto infix:<->    is equiv(infix:<+>)   is pirop('sub')     { ... }
-
-proto infix:«<<»   is looser(infix:<+>)  is pirop('shl')     { ... }
-proto infix:«>>»   is equiv(infix:«<<»)  is pirop('shr')     { ... }
-proto infix:<&>    is looser(infix:«<<»)     { ... }
-proto infix:<^>    is looser(infix:<&>)      { ... }
-proto infix:<|>    is looser(infix:<^>)      { ... }
-
-proto infix:<==>   is looser(infix:<|>)      { ... }
-proto infix:<!=>   is equiv(infix:<==>)      { ... }
-proto infix:«<=»   is equiv(infix:<==>)      { ... }
-proto infix:«>=»   is equiv(infix:<==>)      { ... }
-proto infix:«<»    is equiv(infix:<==>)      { ... }
-proto infix:«>»    is equiv(infix:<==>)      { ... }
-
-
-## Python reserved words and keywords
-
-token reserved {
-    <keyword> | 'None'
-}
-
-token keyword {
-    [ 'and'   | 'assert' | 'break'  | 'class'  | 'continue' | 'def'
-    | 'del'   | 'elif'   | 'else'   | 'except' | 'exec'     | 'finally'
-    | 'for'   | 'from'   | 'global' | 'if'     | 'import'   | 'in'
-    | 'is'    | 'lambda' | 'not'    | 'or'     | 'pass'     | 'print'
-    | 'raise' | 'return' | 'try'    | 'while'  | 'with'     | 'yield' ] >>
-}
-
-## vim: expandtab sw=4

File src/parser/actions.pm

+# $Id: Actions.pm 36833 2009-02-17 20:09:26Z allison $
+# Copyright (C) 2007, Parrot Foundation.
+
+class Pynie::Grammar::Actions;
+
+method TOP($/) {
+    my $block := PAST::Block.new( $( $<file_input> ) );
+    $block.hll('pynie');
+    make $block;
+}
+
+method file_input($/) {
+    my $past := PAST::Stmts.new( :node($/) );
+    for $<statement> {
+        $past.push( $($_) );
+    }
+    make $past;
+}
+
+method suite($/, $key) {
+    make $( $/{$key} );
+}
+
+method suite1($/) {
+    make $( $<stmt_list> );
+}
+
+method suite2($/) {
+    my $past := PAST::Stmts.new( :node($/) );
+    for $<statement> {
+        $past.push($($_));
+    }
+    make $past;
+}
+
+method statement($/, $key) {
+    make $($/{$key});
+}
+
+method stmt_list($/) {
+    my $past := PAST::Stmts.new( :node($/) );
+    for $<simple_stmt> {
+        $past.push( $($_) );
+    }
+    make $past;
+}
+
+method compound_stmt($/, $key) {
+    make $($/{$key});
+}
+
+method assert_stmt($/) {
+    ## assert exp1
+    ##
+    ## translates to:
+    ##
+    ## if __debug__:
+    ##   if not exp1
+    ##
+
+    ## XXX handle exp2.
+
+    my $exp1 := $( $<exp1> );
+
+    ## XXX change into "AssertionError"
+    my $exception := PAST::Op.new( :inline('    %r = new "Exception"') );
+
+    my $throwcode := PAST::Op.new( $exception, :pirop('throw'), :node($/) );
+
+    my $debugcode := PAST::Op.new( $exp1, $throwcode,
+                                   :pasttype('unless'),
+                                   :node($/) );
+
+    my $debugflag := PAST::Var.new( :name('__debug__'),
+                                    :scope('package'),
+                                    :viviself('Undef'),
+                                    :node($/) );
+
+    my $past := PAST::Op.new( $debugflag,
+                              $debugcode,
+                              :pasttype('if'),
+                              :node($/) );
+
+    make $past;
+}
+
+method if_stmt($/) {
+    my $cond := +$<expression> - 1;
+    my $past := PAST::Op.new( $( $<expression>[$cond] ),
+                              $( $<suite>[$cond] ),
+                              :pasttype('if'),
+                              :node( $/ )
+                            );
+    if ( $<else> ) {
+        $past.push( $( $<else>[0] ) );
+    }
+    while ($cond != 0) {
+        $cond := $cond - 1;
+        $past := PAST::Op.new( $( $<expression>[$cond] ),
+                               $( $<suite>[$cond] ),
+                               $past,
+                               :pasttype('if'),
+                               :node( $/ )
+                             );
+    }
+    make $past;
+}
+
+method while_stmt($/) {
+    my $past := PAST::Op.new( $( $<expression> ),
+                              $( $<suite> ),
+                              :pasttype('while'),
+                              :node( $/ )
+                            );
+    if $<else> {
+        ##  handle 'else' clause
+        $past := PAST::Stmts.new( $past,
+                                  $( $<else>[0] ),
+                                  :node( $/ )
+                                );
+    }
+    make $past;
+}
+
+method for_stmt($/) {
+    # translates to:
+    # $P0 = new 'Iterator', <expression_list>
+    # while $P0:
+    #   i = shift $P0
+    #   ...
+
+    # XXX implement complex for syntax
+
+    # XXX right now this uses a Block rather than Stmts so that $iter's scope
+    # XXX is confined to this 'for'. Better to use Stmts and make $iter an anonymous register.
+    #my $past := PAST::Stmts.new( :node($/) );
+    my $past := PAST::Block.new( :blocktype('immediate'), :node($/) );
+
+    # create iterator
+    my $list := $( $<expression_list> );
+    my $iter := PAST::Var.new(     :name('iter'), :scope('register'), :node($/) );
+    my $iterdecl := PAST::Var.new( :name('iter'), :scope('register'), :node($/), :isdecl(1) );
+    $past.push( $iterdecl );
+    $past.push( PAST::Op.new( $iter, $list,
+                              :inline('    %0 = new "Iterator", %1'),
+                              :node($/) ) );
+
+    # make loop body
+    my $tgt := $( $<target> );
+    my $loop := PAST::Stmts.new( :node($/) );
+    my $shifted := PAST::Op.new( $iter,
+                                 :inline('    %r = shift %0'),
+                                 :node($/) );
+    $loop.push( PAST::Op.new( $tgt, $shifted, :pasttype('bind'), :node($/) ) );
+    $loop.push( $( $<suite> ) );
+
+    $past.push( PAST::Op.new( $iter, $loop,
+                              :pasttype('while'),
+                              :node($/) ) );
+    make $past;
+}
+
+method parameter_list($/) {
+    ## the only place for parameters to live is in a function block;
+    ## create that here already.
+    my $past := PAST::Block.new( :blocktype('declaration'), :node($/) );
+
+    ## handle normal parameters
+    for $<defparameter> {
+        $past.push( $($_) );
+    }
+
+    ## handle '*' <identifier>
+    if $<excess_positional_parameter> {
+        my $slurpparam := $( $<excess_positional_parameter> );
+        $past.push( $slurpparam );
+    }
+    ## handle '**' <identifier>
+    if $<excess_keyword_parameter> {
+        my $dictparam := $( $<excess_keyword_parameter> );
+        $past.push( $dictparam );
+    }
+    make $past;
+}
+
+method defparameter($/) {
+    my $past := $( $<parameter> );
+    $past.scope('parameter');
+
+    ## add the default value for this parameter, if any
+    if $<expression> {
+        my $defaultvalue := $( $<expression>[0] );
+        $past.viviself( $defaultvalue );
+    }
+    make $past;
+}
+
+method parameter($/, $key) {
+    make $( $/{$key} )
+}
+
+method sublist($/) {
+    ## XXX
+}
+
+method excess_positional_parameter($/) {
+    ## a :slurpy argument
+    my $past := $( $<identifier> );
+    $past.scope('parameter');
+    $past.slurpy(1);
+    make $past;
+}
+
+method excess_keyword_parameter($/) {
+    ## a :named, :slurpy argument
+    my $past := $( $<identifier> );
+    $past.scope('parameter');
+    $past.slurpy(1);
+    $past.named(1);
+    make $past;
+}
+
+method lambda_form($/) {
+    my $past;
+    if $<parameter_list> {
+        $past := $( $<parameter_list>[0] );
+    }
+    else { # if no parameters, create a block here:
+        $past := PAST::Block.new( :blocktype('declaration'), :node($/) );
+    }
+
+    my $expr := $( $<expression> );
+
+    ## add a return statement to this block
+    $past.push( PAST::Op.new( $expr, :pasttype('return'), :node($/) ) );
+    $past.control('return_pir');
+    make $past;
+}
+
+method funcdef($/) {
+    my $past;
+
+    if $<parameter_list> {
+        $past := $( $<parameter_list>[0] );
+    }
+    else {
+        $past := PAST::Block.new( :blocktype('declaration'), :node($/) );
+    }
+    my $name := $( $<funcname> );
+    $past.name( $name.name() );
+    $past.push( $($<suite>) );
+
+    $past.control('return_pir');
+    make $past;
+}
+
+method funcname($/) {
+    make $( $<identifier> );
+}
+
+method argument_list($/) {
+    my $past;
+
+    if $<positional_arguments> {
+        $past := $( $<positional_arguments> );
+    }
+    else {
+        $past := PAST::Op.new( :pasttype('call'), :node($/) );
+    }
+
+    if $<keyword_arguments> {
+        for $( $<keyword_arguments> ) {
+        ## XXX should this be: for @( $<keyword_arguments> )??
+            $past.push( $_ );
+        }
+    }
+
+    make $past;
+}
+
+method positional_arguments($/) {
+    my $past := PAST::Op.new( :pasttype('call'), :node($/) );
+    for $<expression> {
+        $past.push($($_));
+    }
+    make $past;
+}
+
+method keyword_arguments($/) {
+    my $past := PAST::Op.new( :pasttype('call'), :node($/) );
+    for $<keyword_item> {
+        $past.push($($_));
+    }
+    make $past;
+}
+
+method keyword_item($/) {
+    my $past := $( $<expression> );
+    my $name := $( $<identifier> );
+
+    ## XXX why doesn't this work??
+    #$past.named( $name.name() );
+    #make PAST::Val.new( :value('100'), :named('x'), :node($/) );
+    make $past;
+}
+
+method classname($/) {
+    make $( $<identifier> );
+}
+
+method classdef($/) {
+    ## a class definition is a set of statements
+    my $past := PAST::Stmts.new( :node($/) );
+
+    ## create an anonymous sub that generates the class
+    my $cdef  := PAST::Block.new( :blocktype('declaration'), :node($/) );
+    my $cname := $( $<classname> );
+    my $pir   := '    $P0 = newclass "' ~ $cname.name() ~ '"';
+    $cdef.push( PAST::Op.new( :inline($pir) ) );
+    $cdef.pirflags(':init :anon');
+
+    ## handle parents, if available
+    if $<inheritance> {
+        my $parent    := $( $<inheritance>[0] );
+        my $pir       := '    addparent $P0, %0';
+        my $addparent := PAST::Op.new( $parent, :inline($pir), :node($/) );
+        $cdef.push($addparent);
+    }
+    $past.push($cdef);
+
+    ## handle class contents
+    my $suite := $( $<suite> );
+
+    make $past;
+}
+
+method del_stmt($/) {
+    our $?BLOCK;
+
+    my $targets := $( $<target_list> );
+
+    my $past := PAST::Stmts.new( :node($/) );
+
+    my $pir := "    .local pmc ns\n"
+             ~ '    ns = get_hll_namespace';
+
+    $past.push( PAST::Op.new( :inline($pir), :node($/) ) );
+    for @($targets) {
+        $pir := '    delete ns["' ~ $_.name() ~ '"]';
+        $past.push( PAST::Op.new( :inline($pir), :node($/) ) );
+    }
+
+    make $past;
+}
+
+method pass_stmt($/) {
+    ## pass statement doesn't do anything, but do create a PAST
+    ## node to prevent special case code.
+    make PAST::Op.new( :inline('    # pass'), :node($/) );
+}
+
+method raise_stmt($/) {
+    ## XXX finish this
+    my $numexpr := +$<expression>;
+
+    ## think of better structure to handle this:
+    if $numexpr == 0 {
+
+    }