Commit 121a582a authored by Alessandro Ghedini's avatar Alessandro Ghedini

Imported Upstream version 0.1~2011.04

parent 995cb00f
*~
src/gen_*.pir
src/gen_*.pm
src/gen/*
nqp-rx/
Makefile
.*.swp
*.patch
*.pdb
Test.pir
perl6
perl6.pbc
perl6_s1.pbc
perl6.exe
perl6.exe.manifest
perl6.c
perl6.o
perl6.obj
......@@ -31,6 +33,14 @@ dynext/perl6_*.bundle
dynext/perl6_*.so
dynext/perl6_*.dll
perl6_group.?
perl6_group.obj
libparrot.dll
src/binder/bind.bundle
src/binder/bind.o
src/binder/bind.obj
src/binder/*.pdb
docs/test_summary.times
docs/test_summary.times.tmp
lib/DateTime/strftime.pir
lib/Safe.pir
rakudo_test_run.tar.gz
......@@ -53,11 +53,15 @@ D: Keeps us running
E: ask@develooper.com
N: Audrey Tang
U: audreyt
U: autrijus
U: au
E: audreyt@audreyt.org
D: Pugs, a Perl6->Parrot implementation.
N: Вячеслав Матюхин
U: mmcleric
E: me@berekuk.ru
D: Whatever-currying, colonpair fixes
N: Bernhard Schmalhofer
U: bernhard
E: Bernhard.Schmalhofer@gmx.de
......@@ -71,6 +75,11 @@ N: Bruce Gray
U: util
E: bruce.gray@acm.org
N: Bruce Keeler
U: bkeeler
D: variable interpolation into regexes
N: Bryan C. Warnock
D: The First Perl 6 Summarizer
D: Little things here and there in pre-Parrot days.
......@@ -159,6 +168,13 @@ N: Gregor N. Purdy
E: gregor@focusresearch.com
S: Sunnyvale, CA
U: ingy
N: Ingy döt Net
E: ingy@ingy.net
W: http://ingy.net/
S: Seattle, WA, USA
D: Make is() work like Perl 5; add .pm6 to extensions searched.
N: James E Keenan (Jim)
E: jkeenan@cpan.org
U: jkeenan
......@@ -218,6 +234,10 @@ N: Klaas-Jan Stol
U: kjs
E: parrotcode@gmail.com
N: Kodi Arfer
U: Kodi
W: http://arfer.net
N: Kyle Hasselbacher
E: kyleha@gmail.com
U: KyleHa
......@@ -254,10 +274,11 @@ N: Matt Diephouse
U: mdiep
E: matt@diephouse.com
N: Moritz A Lenz
N: Moritz Lenz
E: moritz@faui2k3.org
U: moritz
D: Test infrastructure for Perl 6 and Rakudo
U: moritz_
D: Test infrastructure, tests, various Rakudo features and built-ins
N: Nicholas Clark
U: nicholas
......@@ -270,6 +291,10 @@ N: Nuno 'smash' Carvalho
U: smash
E: mestre.smash@gmail.com
N: Patrick Abi Salloum
U: patrickas
E: patrick.abisalloum@gmail.com
N: Patrick R. Michaud
U: pmichaud
D: Perl 6 (Rakudo Perl) lead developer, pumpking
......@@ -299,6 +324,10 @@ D: Keeps us running
U: robert
E: robert@perl.org
N: Shrivatsan Sampathkumar
U: isBEKaml
E: nastavs@gmail.com
N: Simon Cozens
U: simon
E: simon@simon-cozens.org
......@@ -315,6 +344,17 @@ U: tene
D: Minor Rakudo patches
E: tene@allalone.org
N: Timothy Totten
U: novus
D: Temporal (DateTime/Date) modifications
E: supernovus@gmail.com
W: http://huri.net/
N: Tyler Curtis
U: tcurtis
D: $*ARGFILES
E: tyler.l.curtis@gmail.com
N: Ujwal Reddy Malipeddi
E: ujwalic@gmail.com
D: Rakudo patch
......@@ -331,4 +371,16 @@ N: Zach Morgan
E: zpmorgan@gmail.com
D: Rakudo patch
N: Tadeusz Sośnierz
U: tadzik
E: tadzikes@gmail.com
N: Arne Skjærholt
U: arnsholt
E: arnsholt@gmail.com
N: JD Horelick
U: jdhore
E: jdhore1@gmail.com
=cut
......@@ -6,10 +6,12 @@ use strict;
use warnings;
use Getopt::Long;
use Cwd;
use lib "build/lib";
use Parrot::CompareRevisions qw(compare_revs parse_revision_file read_config version_from_git_describe);
MAIN: {
my %options;
GetOptions(\%options, 'help!', 'parrot-config=s',
GetOptions(\%options, 'help!', 'parrot-config=s', 'makefile-timing!',
'gen-parrot!', 'gen-parrot-prefix=s', 'gen-parrot-option=s@');
# Print help if it's requested
......@@ -18,24 +20,19 @@ MAIN: {
exit(0);
}
# Determine the revision of Parrot we require
open my $REQ, '<', "build/PARROT_REVISION"
or 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 $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);
my @command = ($^X, "build/gen_parrot.pl", "--prefix=$prefix",
'--gc=gms', ($^O !~ /win32/i ? "--optimize" : ()), @opts);
print "Generating Parrot ...\n";
print "@command\n\n";
system @command;
system(@command) == 0
or die "Error while executing @command; aborting\n";
}
# Get a list of parrot-configs to invoke.
......@@ -45,7 +42,7 @@ MAIN: {
parrot_config
);
if (exists $options{'gen-parrot-prefix'}) {
unshift @parrot_config_exe,
@parrot_config_exe =
$options{'gen-parrot-prefix'} . '/bin/parrot_config';
}
......@@ -54,22 +51,36 @@ MAIN: {
}
# Get configuration information from parrot_config
my %config = read_parrot_config(@parrot_config_exe);
my %config = read_config(@parrot_config_exe);
# Determine the revision of Parrot we require
my $git_describe = parse_revision_file;
my $parrot_version = version_from_git_describe($git_describe);
my $parrot_errors = '';
if (!%config) {
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";
else {
if ($config{git_describe}) {
# a parrot built from git
if (compare_revs($git_describe, $config{'git_describe'}) > 0) {
$parrot_errors .= "Parrot revision $git_describe required (currently $config{'git_describe'})\n";
}
}
else {
# not built from a git repo - let's assume it's a release
if (version_int($parrot_version) > version_int($config{'VERSION'})) {
$parrot_errors .= "Parrot version $parrot_version required (currently $config{VERSION})\n";
}
}
}
if ($parrot_errors) {
die <<"END";
===SORRY!===
$parrot_errors
To automatically checkout (svn) and build a copy of parrot r$reqsvn,
To automatically clone (git) and build a copy of parrot $git_describe,
try re-running Configure.pl with the '--gen-parrot' option.
Or, use the '--parrot-config' option to explicitly specify
the location of parrot_config to be used to build Rakudo Perl.
......@@ -81,7 +92,7 @@ END
verify_parrot(%config);
# Create the Makefile using the information we just got
create_makefile(%config);
create_makefile($options{'makefile-timing'}, %config);
my $make = $config{'make'};
{
......@@ -97,7 +108,7 @@ END
You can now use '$make' to build Rakudo Perl.
After that, you can use '$make test' to run some local tests,
or '$make spectest' to check out (via svn) a copy of the Perl 6
or '$make spectest' to check out (via git) a copy of the Perl 6
official test suite and run its tests.
END
......@@ -106,27 +117,11 @@ END
}
sub read_parrot_config {
my @parrot_config_exe = @_;
my %config = ();
for my $exe (@parrot_config_exe) {
no warnings;
if (open my $PARROT_CONFIG, '-|', "$exe --dump") {
print "\nReading configuration information from $exe ...\n";
while (<$PARROT_CONFIG>) {
if (/(\w+) => '(.*)'/) { $config{$1} = $2 }
}
close $PARROT_CONFIG or die $!;
last if %config;
}
}
return %config;
}
sub verify_parrot {
print "Verifying Parrot installation...\n";
my %config = @_;
my $EXE = $config{'exe'};
my $PARROT_BIN_DIR = $config{'bindir'};
my $PARROT_VERSION = $config{'versiondir'};
my $PARROT_LIB_DIR = $config{'libdir'}.$PARROT_VERSION;
my $PARROT_SRC_DIR = $config{'srcdir'}.$PARROT_VERSION;
......@@ -135,8 +130,7 @@ sub verify_parrot {
my @required_files = (
"$PARROT_LIB_DIR/library/PGE/Perl6Grammar.pbc",
"$PARROT_LIB_DIR/library/PCT/HLLCompiler.pbc",
"$PARROT_LIB_DIR/languages/nqp/nqp.pbc",
"$PARROT_TOOLS_DIR/build/ops2c.pl",
"$PARROT_BIN_DIR/ops2c".$EXE,
"$PARROT_TOOLS_DIR/build/pmc2c.pl",
"$PARROT_SRC_DIR",
"$PARROT_SRC_DIR/pmc",
......@@ -160,16 +154,23 @@ END
# Generate a Makefile from a configuration
sub create_makefile {
my %config = @_;
my ($makefile_timing, %config) = @_;
my $maketext = slurp( 'build/Makefile.in' );
$config{'shell'} = $^O eq 'MSWin32' ? 'cmd' : 'sh';
$config{'stagestats'} = $makefile_timing ? '--stagestats' : '';
$config{'win32_libparrot_copy'} = $^O eq 'MSWin32' ? 'copy $(PARROT_BIN_DIR)\libparrot.dll .' : '';
$maketext =~ s/@(\w+)@/$config{$1}/g;
if ($^O eq 'MSWin32') {
$maketext =~ s{/}{\\}g;
$maketext =~ s{\\\*}{\\\\*}g;
$maketext =~ s{http:\S+}{ do {my $t = $&; $t =~ s'\\'/'g; $t} }eg;
$maketext =~ s{(?:git|http):\S+}{ do {my $t = $&; $t =~ s'\\'/'g; $t} }eg;
$maketext =~ s/.*curl.*/do {my $t = $&; $t =~ s'%'%%'g; $t}/meg;
}
if ($makefile_timing) {
$maketext =~ s{(?<!\\\n)^\t(?!\s*-?cd)(?=[^\n]*\S)}{\ttime }mg;
}
my $outfile = 'Makefile';
......@@ -208,8 +209,10 @@ General Options:
--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
--parrot-config=/path/to/parrot_config
Use config information from parrot_config executable
Experimental developer's options:
--makefile-timing Insert 'time' command all over in the Makefile
END
return;
......
This diff is collapsed.
This diff is collapsed.
2011.04
This diff is collapsed.
Bumping parrot revision: either in the parrot repo type 'git describe --tags',
or if you have a compiled parrot, run 'parrot_config git_describe` to get the
identifier string that you then copy into build/PARROT_REVISION
\ No newline at end of file
#!/usr/bin/perl
# Copyright (C) 2008, The Perl Foundation.
# $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";
}
......@@ -4,40 +4,32 @@
use strict;
use warnings;
use 5.008;
binmode STDOUT, ':utf8';
my @files = @ARGV;
print <<"END_SETTING";
# This file automatically generated by $0.
no Main;
END_SETTING
my %classnames;
foreach my $file (@files) {
print "# From $file\n\n";
open(my $fh, "<", $file) or die $!;
open(my $fh, "<:utf8", $file) or die "$file: $!";
local $/;
print <$fh>;
my $x = <$fh>;
close $fh;
print $x;
foreach ($x =~ /\bclass\s+(\S+)/g) { $classnames{$_}++; }
}
my @classes = ('Any');
foreach my $file (@files) {
next unless $file =~ /setting((?:[\/\\]\w+)+)\.pm$/;
my $full_modname = substr($1, 1);
push @classes, $full_modname;
print "CHECK {\n";
foreach (keys(%classnames)) {
print " Perl6::Compiler.import('$_');\n";
}
print <<"END_SETTING";
# Need to import all built-in classes and set \%*INC for each.
sub SETTING_INIT() {
END_SETTING
s/\\/\//g for @classes;
print join('', map {
my $colon_form = $_;
$colon_form =~ s/[\/\\]/::/g;
" \%*INC<$_> = 1;\n Perl6::Compiler.import('$colon_form', ':DEFAULT', ':MANDATORY');\n"
} @classes);
print "}\n";
print "\n# vim: set ft=perl6 nomodifiable :\n";
print "\n# vim: set ft=perl6 nomodifiable :\n";
#!/usr/bin/perl
# Copyright (C) 2008-2009, The Perl Foundation.
# $Id$
use strict;
use warnings;
my @binary = qw(
infix:~
infix:==
infix:eq infix:lt infix:gt infix:le infix:ge
infix:<=> infix:cmp infix:=:=
);
my @unary = qw(
prefix:++ prefix:-- postfix:++ postfix:--
);
for (@unary) {
print qq(
.namespace []
.sub '$_' :multi('Junction')
.param pmc x
.tailcall '!DISPATCH_JUNCTION'('$_', x)
.end
);
}
for (@binary) {
print qq(
.namespace []
.sub '$_' :multi('Junction', _)
.param pmc x
.param pmc y
.tailcall '!DISPATCH_JUNCTION'('$_', x, y)
.end
.sub '$_' :multi(_, 'Junction')
.param pmc x
.param pmc y
.tailcall '!DISPATCH_JUNCTION'('$_', x, y)
.end
);
}
#!/usr/bin/perl
# Copyright (C) 2008-2009, The Perl Foundation.
# $Id$
use strict;
use warnings;
my @ops = qw(
** 1 op
* 1 op
/ 'fail' op
div 'fail' op
mod 'fail' op
% 'fail' op
x 'fail' op
xx 'fail' op
min 'fail' op
max 'fail' op
+& -1 op
+< 'fail' op
+> 'fail' op
~& 'fail' op
~< 'fail' op
~> 'fail' op
?& 1 op
+ 0 op
- 0 op
~ '' op
+| 0 op
+^ 0 op
~| '' op
~^ '' op
?| 0 op
?^ 0 op
X 'list' op
!== 'False' comp
!= 'False' comp
== 'True' comp
< 'True' comp
<= 'True' comp
> 'True' comp
>= 'True' comp
~~ 'True' comp
!~~ 'False' comp
eq 'True' comp
ne 'False' comp
lt 'True' comp
le 'True' comp
gt 'True' comp
ge 'True' comp
=== 'True' comp
!=== 'False' comp
=:= 'True' comp
!=:= 'False' comp
);
my $assignfmt =
" optable.'newtok'('infix:%s=', 'equiv'=>'infix::=', 'lvalue'=>1)\n";
my $reducefmt =
" optable.'newtok'('prefix:[%s]', 'equiv'=>'infix:=')\n";
my $reversefmt =
" optable.'newtok'('infix:R%s', 'equiv'=>'infix:%s')\n";
my $hyper_no_dwim_fmt =
" optable.'newtok'(%s, 'equiv'=>'infix:%s')\n" .
" optable.'newtok'('infix:%s', 'equiv'=>'infix:%s', 'subname'=>%s)\n";
my $crossfmt =
" optable.'newtok'('infix:X%s', 'equiv'=>'infix:X')\n";
my @gtokens = ();
my @code = ();
while (@ops) {
my $opname = shift @ops;
my $identity = shift @ops;
my $op_type = shift @ops;
# Only emit assignment meta-ops for standard ops.
if ($op_type eq 'op') {
push @gtokens, sprintf( $assignfmt, $opname );
push @code, qq(
.sub 'infix:$opname='
.param pmc a
.param pmc b
.tailcall '!ASSIGNMETAOP'('$opname', a, b)
.end\n);
}
# All ops work for reductions.
push @gtokens, sprintf( $reducefmt, $opname );
my $chain = $op_type eq 'comp' ? 'CHAIN' : '';
push @code, qq(
.sub 'prefix:[$opname]'
.param pmc args :slurpy
.tailcall '!REDUCEMETAOP$chain'('$opname', $identity, args)
.end\n);
# Reverse metaops
push @gtokens, sprintf( $reversefmt, $opname, $opname );
push @code, qq(
.sub 'infix:R${opname}'
.param pmc a
.param pmc b
.tailcall 'infix:$opname'(b, a)
.end\n);
push @gtokens, sprintf( $reducefmt, "R$opname", "R$opname" );
push @code, qq(
.sub 'prefix:[R$opname]'
.param pmc args :slurpy
.tailcall '!REDUCEMETAOP$chain'('R$opname', $identity, args)
.end\n);
# Cross operators.
push @gtokens, sprintf( $crossfmt, $opname );
my $is_chaining = $op_type eq 'comp' ? 1 : 0;
push @code, qq(
.sub 'infix:X${opname}'
.param pmc args :slurpy
.tailcall '!CROSSMETAOP'('$opname', $identity, $is_chaining, args :flat)
.end\n);
# Non-dwimming hyper ops.
my $hypername = qq(unicode:"infix:\\u00ab$opname\\u00bb");
push @gtokens, sprintf($hyper_no_dwim_fmt, $hypername, $opname, ">>$opname<<", $opname, $hypername);
push @code, qq(
.sub $hypername
.param pmc a
.param pmc b
.tailcall '!HYPEROP'('$opname', a, b, 0, 0)
.end\n);
# LHS-dwimming hyper ops.
$hypername = qq(unicode:"infix:\\u00bb$opname\\u00bb");
push @gtokens, sprintf($hyper_no_dwim_fmt, $hypername, $opname, "<<$opname<<", $opname, $hypername);
push @code, qq(
.sub $hypername
.param pmc a
.param pmc b
.tailcall '!HYPEROP'('$opname', a, b, 1, 0)
.end\n);
# RHS-dwimming hyper ops.
$hypername = qq(unicode:"infix:\\u00ab$opname\\u00ab");
push @gtokens, sprintf($hyper_no_dwim_fmt, $hypername, $opname, ">>$opname>>", $opname, $hypername);
push @code, qq(