[svn:parrot] r42890 - in branches/cs_csr_merge: . lib/Parrot lib/Parrot/Test runtime/parrot/library t/native_pbc/testdata t/pmc tools/dev
chromatic at svn.parrot.org
chromatic at svn.parrot.org
Fri Dec 4 19:28:44 UTC 2009
Author: chromatic
Date: Fri Dec 4 19:28:43 2009
New Revision: 42890
URL: https://trac.parrot.org/parrot/changeset/42890
Log:
Merged branch 'master' into cs_csr_merge_local.
Deleted:
branches/cs_csr_merge/lib/Parrot/Test/Cardinal.pm
branches/cs_csr_merge/lib/Parrot/Test/Perl6.pm
Modified:
branches/cs_csr_merge/MANIFEST
branches/cs_csr_merge/lib/Parrot/Manifest.pm
branches/cs_csr_merge/runtime/parrot/library/distutils.pir
branches/cs_csr_merge/t/native_pbc/testdata/number.pasm
branches/cs_csr_merge/t/native_pbc/testdata/string.pasm
branches/cs_csr_merge/t/pmc/bigint.t
branches/cs_csr_merge/tools/dev/create_language.pl
Modified: branches/cs_csr_merge/MANIFEST
==============================================================================
--- branches/cs_csr_merge/MANIFEST Fri Dec 4 17:26:19 2009 (r42889)
+++ branches/cs_csr_merge/MANIFEST Fri Dec 4 19:28:43 2009 (r42890)
@@ -1,7 +1,7 @@
# ex: set ro:
# $Id$
#
-# generated by tools/dev/mk_manifest_and_skip.pl Tue Dec 1 09:00:46 2009 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Fri Dec 4 00:06:29 2009 UT
#
# See below for documentation on the format of this file.
#
@@ -1169,11 +1169,9 @@
lib/Parrot/Revision.pm [devel]lib
lib/Parrot/SearchOps.pm [devel]lib
lib/Parrot/Test.pm [devel]lib
-lib/Parrot/Test/Cardinal.pm [devel]lib
lib/Parrot/Test/Harness.pm [devel]lib
lib/Parrot/Test/PGE.pm [devel]lib
lib/Parrot/Test/PIR_PGE.pm [devel]lib
-lib/Parrot/Test/Perl6.pm [devel]lib
lib/Parrot/Test/Pod.pm [devel]lib
lib/Parrot/Test/Pod/Utils.pm [devel]lib
lib/Parrot/Test/Util.pm [devel]lib
@@ -1779,6 +1777,8 @@
t/native_pbc/string_7.pbc [test]
t/native_pbc/testdata/README []doc
t/native_pbc/testdata/annotations.pir [test]
+t/native_pbc/testdata/number.pasm [test]
+t/native_pbc/testdata/string.pasm [test]
t/oo/attributes.t [test]
t/oo/composition.t [test]
t/oo/inheritance.t [test]
@@ -2152,7 +2152,7 @@
tools/dev/branch_status.pl []
tools/dev/cc_flags.pl []
tools/dev/checkdepend.pl []
-tools/dev/create_language.pl []
+tools/dev/create_language.pl [devel]
tools/dev/debian_docs.sh []
tools/dev/fetch_languages.pl []
tools/dev/gen_charset_tables.pl []
Modified: branches/cs_csr_merge/lib/Parrot/Manifest.pm
==============================================================================
--- branches/cs_csr_merge/lib/Parrot/Manifest.pm Fri Dec 4 17:26:19 2009 (r42889)
+++ branches/cs_csr_merge/lib/Parrot/Manifest.pm Fri Dec 4 19:28:43 2009 (r42890)
@@ -284,6 +284,7 @@
tools/build/ops2c.pl [devel]
tools/build/pmc2c.pl [devel]
tools/dev/mk_language_shell.pl [devel]
+ tools/dev/create_language.pl [devel]
tools/dev/pbc_to_exe.pir [devel]
tools/dev/gen_makefile.pl [devel]
tools/dev/reconfigure.pl [devel]
Deleted: branches/cs_csr_merge/lib/Parrot/Test/Cardinal.pm
==============================================================================
--- branches/cs_csr_merge/lib/Parrot/Test/Cardinal.pm Fri Dec 4 19:28:43 2009 (r42889)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,94 +0,0 @@
-# $Id$
-# Copyright (C) 2006-2007, Parrot Foundation.
-
-package Parrot::Test::Cardinal;
-use strict;
-use warnings;
-use File::Basename;
-
-=head1 NAME
-
-Parrot::Test::Cardinal
-
-=head1 DESCRIPTION
-
-Provide language specific testing routines here.
-
-This is currently alarmingly similar to the generated subs in Parrot::Test.
-Perhaps someone can do a better job of delegation here.
-
-=cut
-
-sub new {
- return bless {};
-}
-
-sub output_is {
- my ( $self, $code, $output, $desc ) = @_;
-
- my $count = $self->{builder}->current_test + 1;
- $desc = 'Cardinal Test' unless $desc;
-
- my $lang_f = File::Spec->rel2abs( Parrot::Test::per_test( '.rb', $count ) );
- my $out_f = File::Spec->rel2abs( Parrot::Test::per_test( '.out', $count ) );
- my $cardinal_out_f = File::Spec->rel2abs( Parrot::Test::per_test( '.cardinal.out', $count ) );
- my $cardinal_out_debug_f =
- File::Spec->rel2abs( Parrot::Test::per_test( '.cardinal.debug.out', $count ) );
- my $parrotdir = dirname $self->{parrot};
-
- Parrot::Test::write_code_to_file( $code, $lang_f );
-
- my $args = $ENV{TEST_PROG_ARGS} || '';
-
- my $ruby_cmd = "ruby $lang_f";
- my $ruby_exit_code = Parrot::Test::run_command(
- $ruby_cmd,
- CD => $self->{relpath},
- STDOUT => $out_f,
- STDERR => $out_f
- );
- my $ruby_output = Parrot::Test::slurp_file($out_f);
-
- my $cardinal_cmd = "$self->{parrot} $args languages/cardinal/cardinal.pbc $lang_f";
- my $cardinal_exit_code = Parrot::Test::run_command(
- $cardinal_cmd,
- CD => $self->{relpath},
- STDOUT => $cardinal_out_f,
- STDERR => $cardinal_out_f
- );
- my $cardinal_output = Parrot::Test::slurp_file($cardinal_out_f);
-
- my $pass = $self->{builder}->is_eq( $cardinal_output, $ruby_output, $desc );
- $self->{builder}->diag("'$ruby_cmd' failed with exit code $ruby_exit_code")
- if $ruby_exit_code and not $pass;
- $self->{builder}->diag("'$cardinal_cmd' failed with exit code $cardinal_exit_code")
- if $cardinal_exit_code and not $pass;
-
- if ( not $pass ) {
- my $cardinal_debug_cmd = "$self->{parrot} $args languages/cardinal/cardinal.pbc -d $lang_f";
- my $cardinal_debug_exit_code = Parrot::Test::run_command(
- $cardinal_debug_cmd,
- CD => $self->{relpath},
- STDOUT => $cardinal_out_debug_f,
- STDERR => $cardinal_out_debug_f
- );
- my $cardinal_debug_output = Parrot::Test::slurp_file($cardinal_out_debug_f);
- }
-
- unless ( $ENV{POSTMORTEM} ) {
-
- #unlink $lang_f;
- unlink $out_f;
- unlink $cardinal_out_f;
- }
- return $pass;
-}
-
-1;
-
-# Local Variables:
-# mode: cperl
-# cperl-indent-level: 4
-# fill-column: 100
-# End:
-# vim: expandtab shiftwidth=4:
Deleted: branches/cs_csr_merge/lib/Parrot/Test/Perl6.pm
==============================================================================
--- branches/cs_csr_merge/lib/Parrot/Test/Perl6.pm Fri Dec 4 19:28:43 2009 (r42889)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,168 +0,0 @@
-# $Id$
-
-# Copyright (C) 2006-2007, Parrot Foundation.
-
-=head1 NAME
-
-Parrot::Test::Perl6 -- testing routines for languages/perl6
-
-=head1 SYNOPSIS
-
- use Parrot::Test::Perl6 tests => 3;
-
- perl6_output_is(<<'CODE', <<'OUTPUT', 'hello, world!');
- say 'hello, world!';
- CODE
- hello, world!
- OUTPUT
-
- perl6_stderr_like($code, qr/$expected/, $desc);
-
- perl6_stdout_isnt($code, qr/$expected/, $desc);
-
-=head1 DESCRIPTION
-
-This module provides Perl6 test functions. It has been heavily refactored
-from Parrot::Test. Hopefully,similar refactoring will be carried out in
-Parrot::Test someday soon.
-
-=cut
-
-package Parrot::Test::Perl6;
-
-use strict;
-use warnings;
-
-use File::Basename;
-use File::Spec;
-use Parrot::Config;
-
-require Exporter;
-require Parrot::Test;
-require Test::Builder;
-require Test::More;
-
-our @EXPORT = qw( plan skip );
-
-my $lang = 'perl6';
-my $streams = {
- output => sub { return ( STDOUT => $_[0], STDERR => $_[0] ) },
- stdout => sub { return ( STDOUT => $_[0], STDERR => File::Spec->devnull ) },
- stderr => sub { return ( STDOUT => File::Spec->devnull, STDERR => $_[0] ) },
-};
-my $tests = {
- is => 'is_eq',
- like => 'like',
- isnt => 'isnt_eq',
-};
-
-## create a map of test names and info
-my $test_map = {};
-for my $t ( keys %{$tests} ) {
- for my $s ( keys %$streams ) {
- $test_map->{ join( '_' => $lang, $s, $t ) } = {
- lang => $lang,
- stream => { name => $s, data => $streams->{$s}, },
- test => { name => $t, data => $tests->{$t}, },
- };
- }
-}
-
-push @EXPORT => keys %{$test_map};
-
-use base qw( Parrot::Test Exporter );
-
-my $b = Test::Builder->new();
-
-my $path_to_parrot = $INC{"Parrot/Config.pm"};
-$path_to_parrot =~ s:lib/Parrot/Config.pm$::;
-$path_to_parrot = File::Spec->curdir()
- if $path_to_parrot eq '';
-
-my $parrot = File::Spec->catfile( $path_to_parrot, 'parrot' . $PConfig{exe} );
-
-my $perl6 = File::Spec->catfile( $path_to_parrot, qw/ languages perl6 p6shell.pir /, );
-
-sub import {
- my ( $class, $plan, @args ) = @_;
- $b->plan( $plan, @args );
- __PACKAGE__->export_to_level( 2, __PACKAGE__ );
-}
-
-sub set_test_info {
- my $next_test_num = 1 + $b->current_test();
- my $f_out = Parrot::Test::per_test( '.out', $next_test_num );
- my $f_code = Parrot::Test::per_test( '.p6', $next_test_num );
- $f_code = File::Spec->rel2abs($f_code);
-
- return ( $next_test_num, $f_out, $f_code );
-}
-
-sub _generate_functions {
- my ($package) = @_;
-
- for my $func ( keys %$test_map ) {
- no strict 'refs';
-
- *{ $package . '::' . $func } = sub ($$;$%) {
- my ( $code, $expected, $desc, %extra ) = @_;
-
- Parrot::Test::convert_line_endings($code);
-
- ## set a default description
- $desc = sprintf '(%s line %s)' => ( caller() )[ 1, 2 ]
- unless $desc;
-
- my ( $test_num, $f_out, $f_code ) = set_test_info();
-
- ## get test arguments from environment
- my $args = $ENV{TEST_PROG_ARGS} || '';
-
- Parrot::Test::write_code_to_file( $code, $f_code );
-
- ## build the command and set the run options
- my $cmd = qq{$parrot $args $perl6 "$f_code"};
- my $run_options = {
- CD => '.',
- $test_map->{$func}->{stream}->{data}->($f_out),
- };
-
- ## run the command and capture the exit code
- my $exit_code = Parrot::Test::run_command( $cmd, %{$run_options}, );
-
- ## read in the command output
- my $actual_output = Parrot::Test::slurp_file($f_out);
-
- ## tell Test::Builder if the test is marked as a todo-item
- my $call_pkg = $b->exported_to() || '';
- local *{ $call_pkg . '::TODO' } = ## no critic Variables::ProhibitConditionalDeclarations
- \$extra{todo}
- if defined $extra{todo};
-
- ## run Test::Builder's test on actual vs. expected output
- my $method = $test_map->{$func}->{test}->{data};
- my $pass = $b->$method( $actual_output, $expected, $desc );
-
- ## print diagnostic info if the test fails
- $b->diag("'$cmd' failed with exit code $exit_code")
- if $exit_code and not $pass;
-
- unless ( $ENV{POSTMORTEM} ) {
- unlink $f_out;
- }
-
- return $pass;
- };
- }
-}
-
-__PACKAGE__->_generate_functions();
-
-$_ ^= ~{ AUTHOR => 'particle' };
-
-# Local Variables:
-# mode: cperl
-# cperl-indent-level: 4
-# fill-column: 100
-# End:
-# vim: expandtab shiftwidth=4:
Modified: branches/cs_csr_merge/runtime/parrot/library/distutils.pir
==============================================================================
--- branches/cs_csr_merge/runtime/parrot/library/distutils.pir Fri Dec 4 17:26:19 2009 (r42889)
+++ branches/cs_csr_merge/runtime/parrot/library/distutils.pir Fri Dec 4 19:28:43 2009 (r42890)
@@ -235,6 +235,8 @@
.const 'Sub' _update = '_update'
register_step('update', _update)
+ .const 'Sub' _patch = '_patch'
+ register_step('patch', _patch)
.const 'Sub' _install = '_install'
register_step('install', _install)
@@ -1635,6 +1637,70 @@
=back
+=head3 Step patch
+
+The following Version Control System are handled :
+
+=over 4
+
+=cut
+
+.sub '_patch' :anon
+ .param pmc kv :slurpy :named
+ $S0 = get_vcs()
+ unless $S0 == 'cvs' goto L1
+ .tailcall _patch_cvs(kv :flat :named)
+ L1:
+ unless $S0 == 'git' goto L2
+ .tailcall _patch_git(kv :flat :named)
+ L2:
+ unless $S0 == 'hg' goto L3
+ .tailcall _patch_hg(kv :flat :named)
+ L3:
+ unless $S0 == 'svn' goto L4
+ .tailcall _patch_svn(kv :flat :named)
+ L4:
+ die "Don't known how to create a patch."
+.end
+
+=item CVS
+
+=cut
+
+.sub '_patch_cvs' :anon
+ .param pmc kv :slurpy :named
+ system('cvs diff', 1 :named('verbose'))
+.end
+
+=item Git
+
+=cut
+
+.sub '_patch_git' :anon
+ .param pmc kv :slurpy :named
+ system('git diff', 1 :named('verbose'))
+.end
+
+=item Mercurial
+
+=cut
+
+.sub '_patch_hg' :anon
+ .param pmc kv :slurpy :named
+ system('hg diff', 1 :named('verbose'))
+.end
+
+=item SVN
+
+=cut
+
+.sub '_patch_svn' :anon
+ .param pmc kv :slurpy :named
+ system('svn diff', 1 :named('verbose'))
+.end
+
+=back
+
=head3 Step test
If t/harness exists, run : t/harness
@@ -3606,6 +3672,15 @@
.sub 'setenv'
.param string name
.param string value
+ .param int verbose :named('verbose') :optional
+ .param int has_verbose :opt_flag
+ unless has_verbose goto L1
+ unless verbose goto L1
+ print "setenv "
+ print name
+ print " = "
+ say value
+ L1:
new $P0, 'Env'
$P0[name] = value
.end
Modified: branches/cs_csr_merge/t/native_pbc/testdata/number.pasm
==============================================================================
--- branches/cs_csr_merge/t/native_pbc/testdata/number.pasm Fri Dec 4 17:26:19 2009 (r42889)
+++ branches/cs_csr_merge/t/native_pbc/testdata/number.pasm Fri Dec 4 19:28:43 2009 (r42890)
@@ -1,3 +1,6 @@
+# Copyright (C) 2009, Parrot Foundation.
+# $Id$
+
set N0, 1.0
set N1, 4.0
set N2, 16.0
@@ -78,3 +81,9 @@
print N25
print "\n"
end
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
Modified: branches/cs_csr_merge/t/native_pbc/testdata/string.pasm
==============================================================================
--- branches/cs_csr_merge/t/native_pbc/testdata/string.pasm Fri Dec 4 17:26:19 2009 (r42889)
+++ branches/cs_csr_merge/t/native_pbc/testdata/string.pasm Fri Dec 4 19:28:43 2009 (r42890)
@@ -1,3 +1,6 @@
+# Copyright (C) 2009, Parrot Foundation.
+# $Id$
+
set S1, "abc"
set S2, "EE"
bors S0, S1, S2
@@ -8,3 +11,9 @@
print S2
print "\n"
end
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
Modified: branches/cs_csr_merge/t/pmc/bigint.t
==============================================================================
--- branches/cs_csr_merge/t/pmc/bigint.t Fri Dec 4 17:26:19 2009 (r42889)
+++ branches/cs_csr_merge/t/pmc/bigint.t Fri Dec 4 19:28:43 2009 (r42890)
@@ -78,17 +78,16 @@
goto ret
NoLibGMP:
- ok(1, 'No BigInt Lib configured')
- skip(44)
+ say 'No BigInt Lib configured'
+ skip(45)
exit 0
OldLibGMP:
print 'Buggy GMP version ['
print $S3
say '] with huge digit multiply - please upgrade'
- ok(0)
- skip(44)
- exit 1
+ skip(45)
+ exit 0
ret:
.end
Modified: branches/cs_csr_merge/tools/dev/create_language.pl
==============================================================================
--- branches/cs_csr_merge/tools/dev/create_language.pl Fri Dec 4 17:26:19 2009 (r42889)
+++ branches/cs_csr_merge/tools/dev/create_language.pl Fri Dec 4 19:28:43 2009 (r42890)
@@ -23,14 +23,14 @@
README
Configure.pl
- xyz.pir
build/Makefile.in
- build/gen_builtins_pir.pl
build/gen_parrot.pl
- src/pct/grammar.pg
- src/pct/grammar-oper.pg
- src/pct/actions.pm
- src/builtins/say.pir
+ src/Xyz.pir
+ src/Xyz/Grammar.pm
+ src/Xyz/Actions.pm
+ src/Xyz/Compiler.pm
+ src/Xyz/Runtime.pm
+ src/gen/.gitignore
t/harness
t/00-sanity.t
@@ -40,6 +40,8 @@
If all goes well, after creating the language shell one can simply
change to the language directory and type
+ $ perl Configure.pl [--gen-parrot]
+ $ make
$ make test
to verify that the new language compiles and configures properly.
@@ -61,15 +63,48 @@
my $lclang = lc $lang;
my $uclang = uc $lang;
-## the name and revision of the script, for use in the generated README
+## the name of the script, for use in the generated README and "reverse"
my $script = $0;
-my $rev = '$Revision$';
-$rev =~ s/^\D*(\d+)\D*$/r$1/;
## get the path from the command line, or if not supplied then
## use languages/$lclang.
my $path = $ARGV[1] || $lclang;
+my $option = $ARGV[2] || '';
+
+if ($option eq 'reverse') {
+ ## instead of using this script to generate the files into $path,
+ ## use the files in $path to generate a new version of this script.
+ open my $fh0, '<', $script or die "Unable to read $script";
+ while (<$fh0>) {
+ print $_;
+ last if /^__DATA__/;
+ }
+ while (<$fh0>) {
+ last if /^__DATA__$/;
+ if (/^__(.*?)__$/) {
+ print;
+ $_ = $1;
+ s{\@lang\@} {$lang}g;
+ s{\@lclang\@} {$lclang}ig;
+ s{\@UCLANG\@} {$uclang}ig;
+ open my $fh, '<', "$path/$_" or die "Unable to read $path/$_";
+ while (<$fh>) {
+ s{$lang} {\@lang\@}g;
+ s{$lclang} {\@lclang\@}g;
+ s{$uclang} {\@UCLANG\@}g;
+ s{$script} {\@script\@}g;
+ print;
+ }
+ close $fh;
+ }
+ }
+ print;
+ while (<$fh0>) { print; }
+ close $fh0;
+ exit 0;
+}
+
## now loop through the file information (see below), substituting
## any instances of @lang@, @lclang@, @UCLANG@, and @Id@ with
## the language name or the svn id tag. If the line has the form
@@ -80,13 +115,16 @@
s{\@lang\@} {$lang}g;
s{\@lclang\@} {$lclang}ig;
s{\@UCLANG\@} {$uclang}ig;
- s{\@Id\@} {\$Id\$}ig;
s{\@script\@} {$script}ig;
- s{\@rev\@} {$rev}ig;
if (/^__(.*)__$/) { start_new_file("$path/$1"); }
elsif ($fh) { print $fh $_; }
}
-## close the last file
+
+## generate build/PARROT_REVISION
+start_new_file("$path/build/PARROT_REVISION");
+my $rev = '$Revision$';
+$rev =~ s/^\D*(\d+)\D*$/$1/;
+print $fh "$rev\n";
close($fh) if $fh;
print <<"END";
@@ -95,7 +133,7 @@
To do an initial build and test of the language:
cd $path
- perl Configure.pl
+ perl Configure.pl [--gen-parrot]
make
make test
@@ -132,19 +170,104 @@
__DATA__
__README__
-Language '@lang@' was created with @script@, @rev at .
+=head1 @lang@
+
+This is @lang@, a compiler for the Parrot virtual machine.
+
+=head2 Build requirements (installing from source)
+
+For building @lang@ you need at least a C compiler, a C<make> utility,
+and Perl 5.8 or newer. To automatically obtain and build Parrot
+you may also need a subversion (svn) client.
+
+=head2 Building and invoking @lang@
+
+We generally recommend downloading @lang@ directly from
+[XXX: fill in this information for @lang@].
+
+Once you have a copy of @lang@, build it as follows:
+
+ $ cd @lclang@
+ $ perl Configure.pl --gen-parrot
+ $ make
+
+This will create a "@lclang@" or "@lclang at .exe" executable in the
+current directory. Programs can then be run from the build
+directory using a command like:
+
+ $ ./@lclang@ <source>
+
+The C<--gen-parrot> option above tells Configure.pl to automatically
+download and build the most appropriate version of Parrot into
+a local "parrot/" subdirectory, install that Parrot into
+the "parrot_install/" subdirectory, and use that for building
+ at lang@. It's okay to use the C<--gen-parrot> option on later
+invocations of Configure.pl; the configure system will re-build
+Parrot only if a newer version is needed for whatever version
+of @lang@ you're working with.
+
+You can use C<--parrot-config=/path/to/parrot_config> instead
+of C<--gen-parrot> to use an already installed Parrot for building
+ at lang@. This installed Parrot must include its development
+environment; typically this is done via Parrot's C<make install>
+target or by installing prebuilt C<parrot-devel> and/or C<libparrot-dev>
+packages. The version of the already installed Parrot must satisfy a
+minimum specified by @lang@ -- Configure.pl will verify this for you.
+
+Once built, @lang@'s C<make install> target will install @lang@
+and its libraries into the Parrot installation that was used to
+create it. Until this step is performed, the "@lclang@" executable
+created by C<make> above can only be reliably run from the root of
+ at lang@'s build directory. After C<make install> is performed,
+the installed executable can be run from any directory (as long as
+the Parrot installation that was used to create it remains intact).
+If the @lang@ compiler is invoked without an explicit script to
+run, it enters a small interactive mode that allows statements
+to be executed from the command line. Each line entered is treated
+as a separate compilation unit, however (which means that subroutines
+are preserved after they are defined, but variables are not).
+
+=head2 Running the test suite
+
+Entering C<make test> will run a test suite that comes bundled
+with @lang at . This is a simple suite of tests, designed to make sure
+that the compiler is basically working and that it's capable of
+running a simple test harness.
+
+If you want to run the tests in parallel, you need to install a
+fairly recent version of the Perl 5 module L<Test::Harness> (3.16
+works for sure).
+
+=head2 Where to get help or answers to questions
+
+=head2 Reporting bugs
+
+=head2 Submitting patches
+
+=head2 How the compiler works
+
+See F<docs/compiler_overview.pod>.
+
+=head1 AUTHOR
+
+=cut
+
+## vim: expandtab sw=4 ft=pod tw=70:
__Configure.pl__
#! perl
+# Copyright (C) 2009 The Perl Foundation
+
use 5.008;
use strict;
use warnings;
use Getopt::Long;
+use Cwd;
MAIN: {
my %options;
GetOptions(\%options, 'help!', 'parrot-config=s',
- 'gen-parrot!', 'gen-parrot-option=s@');
+ 'gen-parrot!', 'gen-parrot-prefix=s', 'gen-parrot-option=s@');
# Print help if it's requested
if ($options{'help'}) {
@@ -152,10 +275,20 @@
exit(0);
}
+ # Determine the revision of Parrot we require
+ open my $REQ, "build/PARROT_REVISION"
+ || die "cannot open build/PARROT_REVISION\n";
+ my ($reqsvn, $reqpar) = split(' ', <$REQ>);
+ $reqsvn += 0;
+ close $REQ;
+
# Update/generate parrot build if needed
if ($options{'gen-parrot'}) {
my @opts = @{ $options{'gen-parrot-option'} || [] };
- my @command = ($^X, "build/gen_parrot.pl", @opts);
+ my $prefix = $options{'gen-parrot-prefix'} || cwd()."/parrot_install";
+ # parrot's Configure.pl mishandles win32 backslashes in --prefix
+ $prefix =~ s{\\}{/}g;
+ my @command = ($^X, "build/gen_parrot.pl", "--prefix=$prefix", ($^O !~ /win32/i ? "--optimize" : ()), @opts);
print "Generating Parrot ...\n";
print "@command\n\n";
@@ -164,31 +297,59 @@
# Get a list of parrot-configs to invoke.
my @parrot_config_exe = qw(
- parrot/parrot_config
+ parrot_install/bin/parrot_config
../../parrot_config
parrot_config
);
+ if (exists $options{'gen-parrot-prefix'}) {
+ unshift @parrot_config_exe,
+ $options{'gen-parrot-prefix'} . '/bin/parrot_config';
+ }
if ($options{'parrot-config'} && $options{'parrot-config'} ne '1') {
@parrot_config_exe = ($options{'parrot-config'});
}
- # Get configuration information from 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,
+
+ my $parrot_errors = '';
+ if (!%config) {
+ $parrot_errors .= "Unable to locate parrot_config\n";
+ }
+ elsif ($reqsvn > $config{'revision'} &&
+ ($reqpar eq '' || version_int($reqpar) > version_int($config{'VERSION'}))) {
+ $parrot_errors .= "Parrot revision r$reqsvn required (currently r$config{'revision'})\n";
+ }
+
+ if ($parrot_errors) {
+ die <<"END";
+===SORRY!===
+$parrot_errors
+To automatically checkout (svn) and build a copy of parrot r$reqsvn,
try re-running Configure.pl with the '--gen-parrot' option.
Or, use the '--parrot-config' option to explicitly specify
-the location of parrot_config.
+the location of parrot_config to be used to build @lang at .
+
END
}
-# Create the Makefile using the information we just got
- create_makefile(%config);
+ # Verify the Parrot installation is sufficient for building @lang@
+ verify_parrot(%config);
+ # Create the Makefile using the information we just got
+ create_makefile(%config);
my $make = $config{'make'};
+
+ {
+ no warnings;
+ print "Cleaning up ...\n";
+ if (open my $CLEAN, '-|', "$make clean") {
+ my @slurp = <$CLEAN>;
+ close $CLEAN;
+ }
+ }
+
print <<"END";
You can now use '$make' to build @lang at .
@@ -210,7 +371,7 @@
while (<$PARROT_CONFIG>) {
if (/(\w+) => '(.*)'/) { $config{$1} = $2 }
}
- close $PARROT_CONFIG;
+ close $PARROT_CONFIG or die $!;
last if %config;
}
}
@@ -218,21 +379,47 @@
}
+sub verify_parrot {
+ print "Verifying Parrot installation...\n";
+ my %config = @_;
+ my $PARROT_VERSION = $config{'versiondir'};
+ my $PARROT_BIN_DIR = $config{'bindir'};
+ my $PARROT_LIB_DIR = $config{'libdir'}.$PARROT_VERSION;
+ my $PARROT_SRC_DIR = $config{'srcdir'}.$PARROT_VERSION;
+ my $PARROT_INCLUDE_DIR = $config{'includedir'}.$PARROT_VERSION;
+ my $PARROT_TOOLS_DIR = "$PARROT_LIB_DIR/tools";
+ my @required_files = (
+ "$PARROT_BIN_DIR/parrot-nqp"
+ );
+ my @missing;
+ for my $reqfile (@required_files) {
+ push @missing, " $reqfile" unless -e $reqfile;
+ }
+ if (@missing) {
+ my $missing = join("\n", @missing);
+ die <<"END";
+
+===SORRY!===
+I'm missing some needed files from the Parrot installation:
+$missing
+(Perhaps you need to use Parrot's "make install" or
+install the "parrot-devel" package for your system?)
+
+END
+ }
+}
+
# Generate a Makefile from a configuration
sub create_makefile {
my %config = @_;
my $maketext = slurp( 'build/Makefile.in' );
- $config{'win32_libparrot_copy'} = $^O eq 'MSWin32' ? 'copy $(BUILD_DIR)\libparrot.dll .' : '';
+ $config{'win32_libparrot_copy'} = $^O eq 'MSWin32' ? 'copy $(PARROT_BIN_DIR)\libparrot.dll .' : '';
$maketext =~ s/@(\w+)@/$config{$1}/g;
if ($^O eq 'MSWin32') {
- # use backslashes.
$maketext =~ s{/}{\\}g;
- # wildcards (for clean rules) need an additional backslash,
- # see Rakudo http://rt.perl.org/rt3/Ticket/Display.html?id=65006
$maketext =~ s{\\\*}{\\\\*}g;
- # use forward slashes again for HTTP URLs
$maketext =~ s{http:\S+}{ do {my $t = $&; $t =~ s'\\'/'g; $t} }eg;
}
@@ -257,6 +444,10 @@
return $maketext;
}
+sub version_int {
+ sprintf('%d%03d%03d', split(/\./, $_[0]))
+}
+
# Print some help text.
sub print_help {
@@ -265,11 +456,11 @@
General Options:
--help Show this text
- --parrot-config=(config)
- Use configuration information from config
--gen-parrot Download and build a copy of Parrot to use
--gen-parrot-option='--option=value'
Set parrot config option when using --gen-parrot
+ --parrot-config=(config)
+ Use configuration information from config
END
return;
@@ -281,161 +472,124 @@
# fill-column: 100
# End:
# vim: expandtab shiftwidth=4:
-
-__build/PARROT_REVISION__
- at rev@
__build/Makefile.in__
+# Copyright (C) 2006-2009, The Perl Foundation.
# $Id$
-# arguments we want to run parrot with
-PARROT_ARGS =
+PARROT_ARGS =
# values from parrot_config
-BUILD_DIR = @build_dir@
-LOAD_EXT = @load_ext@
-O = @o@
+PARROT_BIN_DIR = @bindir@
+PARROT_VERSION = @versiondir@
+PARROT_INCLUDE_DIR = @includedir@$(PARROT_VERSION)
+PARROT_LIB_DIR = @libdir@$(PARROT_VERSION)
+PARROT_SRC_DIR = @srcdir@$(PARROT_VERSION)
+PARROT_LIBRARY_DIR = $(PARROT_LIB_DIR)/library
+HAS_ICU = @has_icu@
+
+CC = @cc@
+CFLAGS = @ccflags@ @cc_shared@ @cc_debug@ @ccwarn@ @cc_hasjit@ @cg_flag@ @gc_flag@
EXE = @exe@
-MAKE = @make_c@
+LD = @ld@
+LDFLAGS = @ldflags@ @ld_debug@
+LD_LOAD_FLAGS = @ld_load_flags@
+LIBPARROT = @inst_libparrot_ldflags@
+O = @o@
+LOAD_EXT = @load_ext@
PERL = @perl@
+CP = @cp@
+MV = @mv@
RM_F = @rm_f@
-HAS_ICU = @has_icu@
+MKPATH = $(PERL) -MExtUtils::Command -e mkpath
+CHMOD = $(PERL) -MExtUtils::Command -e chmod
-# 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
-PMC_DIR = src/pmc
-OPSDIR = src/ops
-OPSLIB = @lclang@
-OPS_FILE = src/ops/@lclang at .ops
-
-# 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
-PBC_TO_EXE = $(BUILD_DIR)/pbc_to_exe$(EXE)
-
-SOURCES = @lclang at .pir \
- src/gen_grammar.pir \
- src/gen_actions.pir \
- src/gen_builtins.pir \
- $(@uclang at _GROUP)
-
-BUILTINS_PIR = \
- src/builtins/say.pir \
-
-# PMCS = @lclang@
-# PMC_SOURCES = $(PMC_DIR)/@lclang at .pmc
-# @uclang at _GROUP = $(PMC_DIR)/@lclang at _group$(LOAD_EXT)
+# locations of parrot resources
+PARROT = $(PARROT_BIN_DIR)/parrot$(EXE)
+PARROT_NQP = $(PARROT_BIN_DIR)/parrot-nqp$(EXE)
+PBC_TO_EXE = $(PARROT_BIN_DIR)/pbc_to_exe$(EXE)
+PARROT_TOOLS_DIR = $(PARROT_LIB_DIR)/tools
+PARROT_PERL_LIB = $(PARROT_TOOLS_DIR)/lib
+
+ at UCLANG@_LANG_DIR = $(PARROT_LIB_DIR)/languages/@lclang@
+
+ at UCLANG@_EXE = @lclang@$(EXE)
+ at UCLANG@_PBC = @lclang at .pbc
+ at UCLANG@_G_PIR = src/gen/@lclang at -grammar.pir
+ at UCLANG@_A_PIR = src/gen/@lclang at -actions.pir
+ at UCLANG@_C_PIR = src/gen/@lclang at -compiler.pir
+ at UCLANG@_R_PIR = src/gen/@lclang at -runtime.pir
+
+ at UCLANG@_SOURCES = \
+ src/@lang at .pir \
+ $(@UCLANG at _G_PIR) \
+ $(@UCLANG at _A_PIR) \
+ $(@UCLANG at _C_PIR) \
+ $(@UCLANG at _R_PIR) \
CLEANUPS = \
- @lclang at .pbc \
- @lclang at .c \
*.manifest \
*.pdb \
- @lclang@$(O) \
- @lclang@$(EXE) \
- src/gen_*.pir \
- src/gen_*.pm \
- $(PMC_DIR)/*.h \
- $(PMC_DIR)/*.c \
- $(PMC_DIR)/*.dump \
- $(PMC_DIR)/*$(O) \
- $(PMC_DIR)/*$(LOAD_EXT) \
- $(PMC_DIR)/*.exp \
- $(PMC_DIR)/*.ilk \
- $(PMC_DIR)/*.manifest \
- $(PMC_DIR)/*.pdb \
- $(PMC_DIR)/*.lib \
- $(PMC_DIR)/objectref.pmc \
- $(OPSDIR)/*.h \
- $(OPSDIR)/*.c \
- $(OPSDIR)/*$(O) \
- $(OPSDIR)/*$(LOAD_EXT) \
-
-HARNESS = $(PERL) t/harness --keep-exit-code --icu=$(HAS_ICU)
-HARNESS_JOBS = $(HARNESS) --jobs
-
-# the default target
-all: @lclang@$(EXE)
-
-installable: installable_ at lclang@$(EXE)
-
-## targets for building a standalone executable
- at lclang@$(EXE): @lclang at .pbc
- $(PBC_TO_EXE) @lclang at .pbc
- @win32_libparrot_copy@
-
-installable_ at lclang@$(EXE): @lclang at .pbc
- $(PBC_TO_EXE) @lclang at .pbc --install
-
-# the compiler .pbc
- at lclang@.pbc: Makefile $(PARROT) $(SOURCES) $(BUILTINS_PIR)
- $(PARROT) $(PARROT_ARGS) -o @lclang at .pbc @lclang at .pir
-
-src/gen_grammar.pir: $(PARROT) $(PERL6GRAMMAR) src/pct/grammar.pg src/pct/grammar-oper.pg
- $(PARROT) $(PARROT_ARGS) $(PERL6GRAMMAR) \
- --output=src/gen_grammar.pir \
- src/pct/grammar.pg src/pct/grammar-oper.pg
-
-src/gen_actions.pir: $(PARROT) $(NQP) $(PCT) src/pct/actions.pm
- $(PARROT) $(PARROT_ARGS) $(NQP) --output=src/gen_actions.pir \
- --encoding=fixed_8 --target=pir src/pct/actions.pm
-
-src/gen_builtins.pir: Makefile build/gen_builtins_pir.pl
- $(PERL) build/gen_builtins_pir.pl $(BUILTINS_PIR) > src/gen_builtins.pir
-
-$(@uclang at _GROUP): Makefile $(PARROT) $(PMC_SOURCES)
- cd $(PMC_DIR) && $(BUILD_DYNPMC) generate $(PMCS)
- cd $(PMC_DIR) && $(BUILD_DYNPMC) compile $(PMCS)
- cd $(PMC_DIR) && $(BUILD_DYNPMC) linklibs $(PMCS)
- cd $(PMC_DIR) && $(BUILD_DYNPMC) copy --destination=$(PARROT_DYNEXT) $(PMCS)
-
-src/ops/@lclang at _ops$(LOAD_EXT) : $(PARROT) $(OPS_FILE)
- @cd $(OPSDIR) && $(BUILD_DYNOPS) generate $(OPSLIB)
- @cd $(OPSDIR) && $(BUILD_DYNOPS) compile $(OPSLIB)
- @cd $(OPSDIR) && $(BUILD_DYNOPS) linklibs $(OPSLIB)
- @cd $(OPSDIR) && $(BUILD_DYNOPS) copy "--destination=$(PARROT_DYNEXT)" $(OPSLIB)
-
-## 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."
-
-test: @lclang@$(EXE)
- $(PERL) t/harness t/
-
-# Run a single test
-t/*.t t/*/*.t t/*/*/*.t: all Test.pir
- @$(HARNESS_WITH_FUDGE) --verbosity=1 $@
+ *.c\
+ *.o\
+ $(@UCLANG at _EXE) \
+ $(@UCLANG at _PBC) \
+ src/gen/*.pir \
+
+default: $(@UCLANG at _EXE)
+
+all: $(@UCLANG at _EXE)
+
+$(@UCLANG at _EXE) : $(@UCLANG at _SOURCES)
+ $(PARROT) -o $(@UCLANG at _PBC) src/@lang at .pir
+ $(PBC_TO_EXE) $(@UCLANG at _PBC)
+
+$(@UCLANG at _G_PIR): src/@lang@/Grammar.pm
+ $(PARROT_NQP) --target=pir -o $(@UCLANG at _G_PIR) src/@lang@/Grammar.pm
+$(@UCLANG at _A_PIR): src/@lang@/Actions.pm
+ $(PARROT_NQP) --target=pir -o $(@UCLANG at _A_PIR) src/@lang@/Actions.pm
+$(@UCLANG at _C_PIR): src/@lang@/Compiler.pm
+ $(PARROT_NQP) --target=pir -o $(@UCLANG at _C_PIR) src/@lang@/Compiler.pm
+$(@UCLANG at _R_PIR): src/@lang@/Runtime.pm
+ $(PARROT_NQP) --target=pir -o $(@UCLANG at _R_PIR) src/@lang@/Runtime.pm
+
+## testing
+
+test: $(@UCLANG at _EXE)
+ $(PERL) t/harness t
+
+## installation
+
+install: all
+ $(MKPATH) $(DESTDIR)$(@UCLANG at _LANG_DIR)
+ $(CP) $(@UCLANG at _PBC) $(DESTDIR)$(@UCLANG at _LANG_DIR)
+ $(CP) $(@UCLANG at _EXE) $(DESTDIR)$(PARROT_BIN_DIR)
+ $(CHMOD) 755 $(DESTDIR)$(PARROT_BIN_DIR)/$(@UCLANG at _EXE)
+
+## cleaning
-## cleaning
clean:
$(RM_F) $(CLEANUPS)
distclean: realclean
realclean: clean
- $(RM_F) src/utils/Makefile Makefile
+ $(RM_F) 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: @lclang at .exe"
+ @echo " all: $(@UCLANG at _EXE)"
@echo " This is the default."
+ @echo " $(@UCLANG at _EXE): The @lang@ compiler."
+ @echo " install: Install compiler into Parrot."
@echo ""
@echo "Testing:"
- @echo " test: Run Rakudo's sanity tests."
+ @echo " test: Run tests."
@echo ""
@echo "Cleaning:"
@echo " clean: Basic cleaning up."
@@ -447,47 +601,13 @@
@echo " help: Print this help message."
@echo ""
-Makefile: build/Makefile.in
- @echo ""
- @echo "warning: Makefile is out of date... re-run Configure.pl"
- @echo ""
-
-manifest:
- echo MANIFEST >MANIFEST
- git ls-files | $(PERL) -ne '/^\./ || print' >>MANIFEST
-
-release: manifest
- [ -n "$(VERSION)" ] || ( echo "\nTry 'make release VERSION=yyyymm'\n\n"; exit 1 )
- [ -d @lclang at -$(VERSION) ] || ln -s . @lclang at -$(VERSION)
- $(PERL) -ne 'print "@lclang at -$(VERSION)/$$_"' MANIFEST | \
- tar -zcv -T - -f @lclang at -$(VERSION).tar.gz
- rm @lclang at -$(VERSION)
-
-__build/gen_builtins_pir.pl__
-#!/usr/bin/perl
-# $Id$
-
-use strict;
-use warnings;
-
-my @files = @ARGV;
-
-print <<"END_PRELUDE";
-# This file automatically generated by $0.
-
-END_PRELUDE
-
-foreach my $file (@files) {
- print ".include '$file'\n";
-}
-
-
__build/gen_parrot.pl__
#! perl
+# Copyright (C) 2009 The Perl Foundation
=head1 TITLE
-gen_parrot.pl - script to obtain and build Parrot
+gen_parrot.pl - script to obtain and build Parrot for Rakudo
=head2 SYNOPSIS
@@ -511,23 +631,24 @@
## determine what revision of Parrot we require
open my $REQ, "build/PARROT_REVISION"
|| die "cannot open build/PARROT_REVISION\n";
-my $required = 0+<$REQ>;
+my ($reqsvn, $reqpar) = split(' ', <$REQ>);
+$reqsvn += 0;
close $REQ;
{
no warnings;
- if (open my $REV, '-|', "parrot${slash}parrot_config revision") {
+ if (open my $REV, '-|', "parrot_install${slash}bin${slash}parrot_config revision") {
my $revision = 0+<$REV>;
close $REV;
- if ($revision >= $required) {
- print "Parrot r$revision already available (r$required required)\n";
+ if ($revision >= $reqsvn) {
+ print "Parrot r$revision already available (r$reqsvn required)\n";
exit(0);
}
}
}
-print "Checking out Parrot r$required via svn...\n";
-system(qw(svn checkout -r), $required , qw(https://svn.parrot.org/parrot/trunk parrot));
+print "Checking out Parrot r$reqsvn via svn...\n";
+system(qw(svn checkout -r), $reqsvn , qw(https://svn.parrot.org/parrot/trunk parrot));
chdir('parrot');
@@ -550,7 +671,11 @@
print "\nBuilding Parrot ...\n";
my %config = read_parrot_config();
my $make = $config{'make'} or exit(1);
-system($make);
+my @make_opts;
+if ($ENV{GNU_MAKE_JOBS}) {
+ push @make_opts, '-j', $ENV{GNU_MAKE_JOBS}
+}
+system($make, 'install-dev', @make_opts);
sub read_parrot_config {
my %config = ();
@@ -563,278 +688,155 @@
%config;
}
-__ at lclang@.pir__
-=head1 TITLE
-
- at lclang@.pir - A @lang@ compiler.
-
-=head2 Description
-
-This is the base file for the @lang@ compiler.
-
-This file includes the parsing and grammar rules from
-the src/ directory, loads the relevant PGE libraries,
-and registers the compiler under the name '@lang@'.
-
-=head2 Functions
-
-=over 4
-
-=item onload()
-
-Creates the @lang@ compiler using a C<PCT::HLLCompiler>
-object.
-
-=cut
-
+__src/@lang at .pir__
.HLL '@lclang@'
-.namespace [ '@lang@';'Compiler' ]
-
-.loadlib '@lclang at _group'
+.namespace []
.sub '' :anon :load :init
- load_bytecode 'PCT.pbc'
- .local pmc parrotns, hllns, exports
- parrotns = get_root_namespace ['parrot']
- hllns = get_hll_namespace
- exports = split ' ', 'PAST PCT PGE'
- parrotns.'export_to'(hllns, exports)
-.end
-
-.include 'src/gen_grammar.pir'
-.include 'src/gen_actions.pir'
+ load_bytecode 'HLL.pbc'
-.sub 'onload' :anon :load :init
- $P0 = get_hll_global ['PCT'], 'HLLCompiler'
- $P1 = $P0.'new'()
- $P1.'language'('@lclang@')
- $P0 = get_hll_namespace ['@lang@';'Grammar']
- $P1.'parsegrammar'($P0)
- $P0 = get_hll_namespace ['@lang@';'Grammar';'Actions']
- $P1.'parseactions'($P0)
+ .local pmc hllns, parrotns, imports
+ hllns = get_hll_namespace
+ parrotns = get_root_namespace ['parrot']
+ imports = split ' ', 'PAST PCT HLL Regex Hash'
+ parrotns.'export_to'(hllns, imports)
.end
-=item main(args :slurpy) :main
-
-Start compilation by passing any command line C<args>
-to the @lang@ compiler.
-
-=cut
+.include 'src/gen/@lclang at -grammar.pir'
+.include 'src/gen/@lclang at -actions.pir'
+.include 'src/gen/@lclang at -compiler.pir'
+.include 'src/gen/@lclang at -runtime.pir'
+.namespace []
.sub 'main' :main
.param pmc args
- $P0 = compreg '@lclang@'
+ $P0 = compreg '@lang@'
+ # Cannot tailcall here. (TT #1029)
$P1 = $P0.'command_line'(args)
+ .return ($P1)
.end
-
-.include 'src/gen_builtins.pir'
-
-=back
-
-=cut
-
-# Local Variables:
-# mode: pir
-# fill-column: 100
-# End:
-# vim: expandtab shiftwidth=4 ft=pir:
-
-__src/pct/grammar.pg__
-# @Id@
-
+__src/@lang@/Grammar.pm__
=begin overview
-This is the grammar for @lang@ written as a sequence of Perl 6 rules.
+This is the grammar for @lang@ in Perl 6 rules.
=end overview
-grammar @lang@::Grammar is PCT::Grammar;
+grammar @lang@::Grammar is HLL::Grammar;
-rule TOP {
- <statement>*
- [ $ || <panic: 'Syntax error'> ]
- {*}
+token TOP {
+ <statementlist>
+ [ $ || <.panic: "Syntax error"> ]
}
-## this <ws> rule treats # as "comment to eol"
-## you may want to replace it with something appropriate
+## Lexer items
+
+# This <ws> rule treats # as "comment to eol".
token ws {
<!ww>
[ '#' \N* \n? | \s+ ]*
}
-rule statement {
- 'say' <expression> [ ',' <expression> ]* ';'
- {*}
-}
-
-rule value {
- | <integer> {*} #= integer
- | <quote> {*} #= quote
-}
-
-token integer { \d+ {*} }
+## Statements
-token quote {
- [ \' <string_literal: '\'' > \' | \" <string_literal: '"' > \" ]
- {*}
-}
+rule statementlist { [ <statement> | <?> ] ** ';' }
-## terms
-token term {
- | <value> {*} #= value
+rule statement {
+ | <statement_control>
+ | <EXPR>
}
-rule expression is optable { ... }
-
-__src/pct/grammar-oper.pg__
-# @Id@
-
-## expressions and operators
-proto 'term:' is precedence('=') is parsed(&term) { ... }
+proto token statement_control { <...> }
+rule statement_control:sym<say> { <sym> [ <EXPR> ] ** ',' }
+rule statement_control:sym<print> { <sym> [ <EXPR> ] ** ',' }
-## multiplicative operators
-proto infix:<*> is looser(term:) is pirop('mul') { ... }
-proto infix:</> is equiv(infix:<*>) is pirop('div') { ... }
+## Terms
-## additive operators
-proto infix:<+> is looser(infix:<*>) is pirop('add') { ... }
-proto infix:<-> is equiv(infix:<+>) is pirop('sub') { ... }
+token term:sym<integer> { <integer> }
+token term:sym<quote> { <quote> }
-__src/pct/actions.pm__
-# @Id@
+proto token quote { <...> }
+token quote:sym<'> { <?[']> <quote_EXPR: ':q'> }
+token quote:sym<"> { <?["]> <quote_EXPR: ':qq'> }
-=begin comments
+## Operators
- at lang@::Grammar::Actions - ast transformations for @lang@
+INIT {
+ @lang@::Grammar.O(':prec<u>, :assoc<left>', '%multiplicative');
+ @lang@::Grammar.O(':prec<t>, :assoc<left>', '%additive');
+}
-This file contains the methods that are used by the parse grammar
-to build the PAST representation of an @lang@ program.
-Each method below corresponds to a rule in F<src/parser/grammar.pg>,
-and is invoked at the point where C<{*}> appears in the rule,
-with the current match object as the first argument. If the
-line containing C<{*}> also has a C<#= key> comment, then the
-value of the comment is passed as the second argument to the method.
+token circumfix:sym<( )> { '(' <.ws> <EXPR> ')' }
-=end comments
+token infix:sym<*> { <sym> <O('%multiplicative, :pirop<mul>')> }
+token infix:sym</> { <sym> <O('%multiplicative, :pirop<div>')> }
-class @lang@::Grammar::Actions;
+token infix:sym<+> { <sym> <O('%additive, :pirop<add>')> }
+token infix:sym<-> { <sym> <O('%additive, :pirop<sub>')> }
+__src/@lang@/Actions.pm__
+class @lang@::Actions is HLL::Actions;
method TOP($/) {
- my $past := PAST::Block.new( :blocktype('declaration'), :node( $/ ), :hll('@lang@') );
- for $<statement> {
- $past.push( $_.ast );
- }
- make $past;
+ make PAST::Block.new( $<statementlist>.ast , :hll<@lclang@>, :node($/) );
}
-
-method statement($/) {
- my $past := PAST::Op.new( :name('say'), :pasttype('call'), :node( $/ ) );
- for $<expression> {
- $past.push( $_.ast );
- }
+method statementlist($/) {
+ my $past := PAST::Stmts.new( :node($/) );
+ for $<statement> { $past.push( $_.ast ); }
make $past;
}
-## expression:
-## This is one of the more complex transformations, because
-## our grammar is using the operator precedence parser here.
-## As each node in the expression tree is reduced by the
-## parser, it invokes this method with the operator node as
-## the match object and a $key of 'reduce'. We then build
-## a PAST::Op node using the information provided by the
-## operator node. (Any traits for the node are held in $<top>.)
-## Finally, when the entire expression is parsed, this method
-## is invoked with the expression in $<expr> and a $key of 'end'.
-method expression($/, $key) {
- if ($key eq 'end') {
- make $<expr>.ast;
- }
- else {
- my $past := PAST::Op.new( :name($<type>),
- :pasttype($<top><pasttype>),
- :pirop($<top><pirop>),
- :lvalue($<top><lvalue>),
- :node($/)
- );
- for @($/) {
- $past.push( $_.ast );
- }
- make $past;
- }
+method statement($/) {
+ make $<statement_control> ?? $<statement_control>.ast !! $<EXPR>.ast;
}
-
-## term:
-## Like 'statement' above, the $key has been set to let us know
-## which term subrule was matched.
-method term($/, $key) {
- make $/{$key}.ast;
+method statement_control:sym<say>($/) {
+ my $past := PAST::Op.new( :name<say>, :pasttype<call>, :node($/) );
+ for $<EXPR> { $past.push( $_.ast ); }
+ make $past;
}
-
-method value($/, $key) {
- make $/{$key}.ast;
+method statement_control:sym<print>($/) {
+ my $past := PAST::Op.new( :name<print>, :pasttype<call>, :node($/) );
+ for $<EXPR> { $past.push( $_.ast ); }
+ make $past;
}
+method term:sym<integer>($/) { make $<integer>.ast; }
+method term:sym<quote>($/) { make $<quote>.ast; }
-method integer($/) {
- make PAST::Val.new( :value( ~$/ ), :returns('Integer'), :node($/) );
-}
+method quote:sym<'>($/) { make $<quote_EXPR>.ast; }
+method quote:sym<">($/) { make $<quote_EXPR>.ast; }
+method circumfix:sym<( )>($/) { make $<EXPR>.ast; }
-method quote($/) {
- make PAST::Val.new( :value( $<string_literal>.ast ), :node($/) );
-}
-
-
-# Local Variables:
-# mode: cperl
-# cperl-indent-level: 4
-# fill-column: 100
-# End:
-# vim: expandtab shiftwidth=4:
-
-__src/builtins/say.pir__
-# @Id@
-
-=head1
-
-say.pir -- simple implementation of a say function
-
-=cut
-
-.namespace []
-
-.sub 'say'
- .param pmc args :slurpy
- .local pmc it
- it = iter args
- iter_loop:
- unless it goto iter_end
- $P0 = shift it
- print $P0
- goto iter_loop
- iter_end:
- print "\n"
- .return ()
-.end
+__src/@lang@/Compiler.pm__
+class @lang@::Compiler is HLL::Compiler;
+INIT {
+ @lang@::Compiler.language('@lang@');
+ @lang@::Compiler.parsegrammar(@lang@::Grammar);
+ @lang@::Compiler.parseactions(@lang@::Actions);
+}
+__src/@lang@/Runtime.pm__
+# language-specific runtime functions go here
-# Local Variables:
-# mode: pir
-# fill-column: 100
-# End:
-# vim: expandtab shiftwidth=4 ft=pir:
+sub print(*@args) {
+ pir::print(pir::join('', @args));
+ 1;
+}
+sub say(*@args) {
+ pir::say(pir::join('', @args));
+ 1;
+}
+__src/gen/.gitignore__
+*
__t/harness__
#! perl
-# $Id$
-
use strict;
use warnings;
@@ -933,7 +935,6 @@
say 'ok ', 2;
say 'ok ', 2 + 1;
say 'ok', ' ', 4;
-
__DATA__
More information about the parrot-commits
mailing list