diff --git a/src/Perl6/Grammar.nqp b/src/Perl6/Grammar.nqp index 9ebe66e3c8e..e420906bdc2 100644 --- a/src/Perl6/Grammar.nqp +++ b/src/Perl6/Grammar.nqp @@ -2353,6 +2353,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD { :my %*ATTR_USAGES; :my $*REPR; :my $*VER; + :my $*API; :my $*AUTH; # Default to our scoped. @@ -2386,6 +2387,9 @@ grammar Perl6::Grammar is HLL::Grammar does STD { 'parsing package version', -> { $*W.find_symbol(['Version']).new($adverb.value) }); } + elsif $key eq 'api' { + $*API := $adverb.value; + } elsif $key eq 'auth' { $*AUTH := $adverb.value; } @@ -2435,6 +2439,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD { if @name { %args := $fullname; %args := $*VER; + %args := $*API; %args := $*AUTH; } if $*REPR ne '' { @@ -2472,7 +2477,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD { return nqp::elems(@params) > 1 || !@params[0]; } $*PACKAGE := $package := $*W.pkg_create_mo($/, $*W.resolve_mo($/, $*PKGDECL), - :name($fullname), :ver($*VER), :auth($*AUTH), :repr($*REPR), + :name($fullname), :ver($*VER), :api($*API), :auth($*AUTH), :repr($*REPR), :group($group), :signatured(needs_args($))); $/.set_package($package); } diff --git a/src/Perl6/Metamodel/ClassHOW.nqp b/src/Perl6/Metamodel/ClassHOW.nqp index e9e05f01783..cdf6706209a 100644 --- a/src/Perl6/Metamodel/ClassHOW.nqp +++ b/src/Perl6/Metamodel/ClassHOW.nqp @@ -39,10 +39,11 @@ class Perl6::Metamodel::ClassHOW nqp::findmethod(NQPMu, 'BUILDALL')(nqp::create(self), |%named) } + my $anon_id := 1; method new_type(:$name, :$repr = 'P6opaque', :$ver, :$auth) { my $metaclass := self.new(); my $obj := nqp::settypehll(nqp::newtype($metaclass, $repr), 'perl6'); - $metaclass.set_name($obj, $name // ""); + $metaclass.set_name($obj, $name // ""); self.add_stash($obj); $metaclass.set_ver($obj, $ver) if $ver; $metaclass.set_auth($obj, $auth) if $auth; diff --git a/src/Perl6/Metamodel/ParametricRoleHOW.nqp b/src/Perl6/Metamodel/ParametricRoleHOW.nqp index 6f910f56897..74ee79e0cd0 100644 --- a/src/Perl6/Metamodel/ParametricRoleHOW.nqp +++ b/src/Perl6/Metamodel/ParametricRoleHOW.nqp @@ -32,10 +32,11 @@ class Perl6::Metamodel::ParametricRoleHOW nqp::findmethod(NQPMu, 'BUILDALL')(nqp::create(self), |%named) } + my $anon_id := 1; method new_type(:$name, :$ver, :$auth, :$repr, :$signatured, *%extra) { my $metarole := self.new(:signatured($signatured), :specialize_lock(NQPLock.new)); my $type := nqp::settypehll(nqp::newtype($metarole, 'Uninstantiable'), 'perl6'); - $metarole.set_name($type, $name // ""); + $metarole.set_name($type, $name // ""); $metarole.set_ver($type, $ver) if $ver; $metarole.set_auth($type, $auth) if $auth; $metarole.set_pun_repr($type, $repr) if $repr; diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index d9ab97fcfe9..d79e33dd69a 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -1234,6 +1234,7 @@ class Perl6::World is HLL::World { :short-name($module_name), :from(%opts // 'Perl6'), :auth-matcher(%opts // $true), + :api-matcher(%opts // $true), :version-matcher(%opts // $true), :source-line-number($line) ); @@ -2895,12 +2896,13 @@ class Perl6::World is HLL::World { # Creates a meta-object for a package, adds it to the root objects and # returns the created object. - method pkg_create_mo($/, $how, :$name, :$repr, :$auth, :$ver, *%extra) { + method pkg_create_mo($/, $how, :$name, :$repr, :$auth, :$api, :$ver, *%extra) { # Create the meta-object and add to root objects. my %args; if nqp::defined($name) { %args := ~$name; } if nqp::defined($repr) { %args := ~$repr; } if nqp::defined($ver) { %args := $ver; } + if nqp::defined($api) { %args := $api; } if nqp::defined($auth) { %args := $auth; } if nqp::existskey(%extra, 'base_type') { %args := %extra; diff --git a/src/core/Array.pm6 b/src/core/Array.pm6 index 72ea9c2cf70..f23b4b7edf3 100644 --- a/src/core/Array.pm6 +++ b/src/core/Array.pm6 @@ -32,6 +32,22 @@ my class Array { # declared in BOOTSTRAP nqp::push($!target, nqp::assign(nqp::p6scalarfromdesc($!descriptor), value)); } + + method append(IterationBuffer:D $buffer) { + nqp::if( + (my int $elems = nqp::elems($buffer)), + nqp::stmts( + (my int $i = -1), + nqp::while( + nqp::islt_i(($i = nqp::add_i($i,1)),$elems), + nqp::push($!target,nqp::assign( + nqp::p6scalarfromdesc($!descriptor), + nqp::atpos($buffer,$i) + )) + ) + ) + ) + } } my class ListReificationTarget { @@ -45,6 +61,10 @@ my class Array { # declared in BOOTSTRAP nqp::push($!target, nqp::decont(value)); } + + method append(IterationBuffer:D \buffer) { + nqp::splice($!target,buffer,nqp::elems($!target),0) + } } multi method clone(Array:D:) { diff --git a/src/core/CompUnit/Repository/Installation.pm6 b/src/core/CompUnit/Repository/Installation.pm6 index b04bc98bf7b..1ea3a1e65d0 100644 --- a/src/core/CompUnit/Repository/Installation.pm6 +++ b/src/core/CompUnit/Repository/Installation.pm6 @@ -179,6 +179,7 @@ sub MAIN(:$name is copy, :$auth, :$ver, *@, *%) { my %meta6 = %( name => $dist.?name, ver => $dist.?ver // $dist.?version, + api => $dist.?api, auth => $dist.?auth // $dist.?authority, provides => %sources, files => %files, @@ -439,6 +440,7 @@ sub MAIN(:$name is copy, :$auth, :$ver, *@, *%) { }) ).grep({ $_.value ~~ $spec.auth-matcher + and $_.value ~~ $spec.api-matcher and $_.value ~~ (($spec.version-matcher ~~ Bool) ?? $spec.version-matcher # fast path for matching Version.new(*) !! Version.new($spec.version-matcher)) diff --git a/src/core/Compiler.pm6 b/src/core/Compiler.pm6 index 9ece5cfb63b..a889227c153 100644 --- a/src/core/Compiler.pm6 +++ b/src/core/Compiler.pm6 @@ -3,7 +3,10 @@ class Compiler does Systemic { has Str $.release; has Str $!build-date; has Str $.codename; - BEGIN my $id = $*W.handle.Str ~ '.' ~ nqp::time_n(); + BEGIN my $id = nqp::sha1( + $*W.handle.Str + ~ nqp::atkey(nqp::getcurhllsym('$COMPILER_CONFIG'), 'source-digest') + ); submethod BUILD ( :$!name = 'rakudo', diff --git a/src/core/Distribution.pm6 b/src/core/Distribution.pm6 index a3eeadd96c9..aa052573a73 100644 --- a/src/core/Distribution.pm6 +++ b/src/core/Distribution.pm6 @@ -54,6 +54,7 @@ role Distribution { :$!name, :$.auth, :$.ver, + :$.api, :$!description, :@!depends, :%!provides, diff --git a/src/core/IO/Handle.pm6 b/src/core/IO/Handle.pm6 index 5a334783fa8..16a5415dc2a 100644 --- a/src/core/IO/Handle.pm6 +++ b/src/core/IO/Handle.pm6 @@ -81,40 +81,16 @@ my class IO::Handle { $enc = $!encoding)); $mode = nqp::if( - $mode, - nqp::if(nqp::istype($mode, Str), $mode, $mode.Str), - nqp::if( - nqp::unless(nqp::if($r, $w), $rw), # $r && $w || $rw - nqp::stmts(($create = True), 'rw'), - nqp::if( - nqp::unless(nqp::if($r, $x), $rx), - nqp::stmts(($create = $exclusive = True), 'rw'), - nqp::if( - nqp::unless(nqp::if($r, $a), $ra), - nqp::stmts(($create = $append = True), 'rw'), - nqp::if( - $r, 'ro', - nqp::if( - $w, - nqp::stmts(($create = $truncate = True), 'wo'), - nqp::if( - $x, - nqp::stmts(($create = $exclusive = True), 'wo'), - nqp::if( - $a, - nqp::stmts(($create = $append = True), 'wo'), - nqp::if( - $update, 'rw', - 'ro' - ), - ), - ), - ), - ), - ), - ), - ), - ); + $mode, nqp::if(nqp::istype($mode, Str), $mode, $mode.Str), + nqp::if($w && $r || $rw, nqp::stmts(($create = True), 'rw'), + nqp::if($x && $r || $rx, nqp::stmts(($create = $exclusive = True), 'rw'), + nqp::if($a && $r || $ra, nqp::stmts(($create = $append = True), 'rw'), + nqp::if($r, 'ro', + nqp::if($w, nqp::stmts(($create = $truncate = True), 'wo'), + nqp::if($x, nqp::stmts(($create = $exclusive = True), 'wo'), + nqp::if($a, nqp::stmts(($create = $append = True), 'wo'), + nqp::if($update, 'rw', + 'ro'))))))))); nqp::if( nqp::iseq_s($!path.Str, '-'), @@ -178,30 +154,16 @@ my class IO::Handle { { CATCH { .fail } $!PIO := nqp::open( - $!path.absolute, - nqp::concat( - nqp::if( - nqp::iseq_s($mode, 'ro'), 'r', - nqp::if( - nqp::iseq_s($mode, 'wo'), '-', - nqp::if( - nqp::iseq_s($mode, 'rw'), '+', - die("Unknown mode '$mode'") - ), - ), - ), - nqp::concat( - nqp::if($create, 'c', ''), - nqp::concat( - nqp::if($append, 'a', ''), - nqp::concat( - nqp::if($truncate, 't', ''), - nqp::if($exclusive, 'x', ''), - ), - ), - ) - ), - ); + $!path.absolute, + nqp::concat( + nqp::if(nqp::iseq_s($mode, 'ro'), 'r', + nqp::if(nqp::iseq_s($mode, 'wo'), '-', + nqp::if(nqp::iseq_s($mode, 'rw'), '+', + die "Unknown mode '$mode'"))), + nqp::concat(nqp::if($create, 'c', ''), + nqp::concat(nqp::if($append, 'a', ''), + nqp::concat(nqp::if($truncate, 't', ''), + nqp::if($exclusive, 'x', '')))))); #?if moar self!remember-to-close; #?endif diff --git a/src/core/IterationBuffer.pm6 b/src/core/IterationBuffer.pm6 index cdf5d6174f0..dcedaacc078 100644 --- a/src/core/IterationBuffer.pm6 +++ b/src/core/IterationBuffer.pm6 @@ -19,6 +19,10 @@ my class IterationBuffer { method push(Mu \value) { nqp::push(self, value) } + method append(IterationBuffer:D \buffer) { + nqp::splice(self,buffer,nqp::elems(self),0) + } + proto method AT-POS(|) {*} multi method AT-POS(IterationBuffer:D: int $pos) is raw { nqp::atpos(self, $pos) diff --git a/src/core/operators.pm6 b/src/core/operators.pm6 index ffabab2ba7f..91910ea6124 100644 --- a/src/core/operators.pm6 +++ b/src/core/operators.pm6 @@ -778,7 +778,7 @@ multi sub trait_mod:(Routine $r, Str :$looser!) { } proto sub infix: (&?, &?) {*} -multi sub infix: () { *.self } +multi sub infix: () { -> \v { v } } multi sub infix: (&f) { &f } multi sub infix: (&f, &g --> Block:D) { my \ret = &f.count > 1 diff --git a/tools/build/Makefile-JVM.in b/tools/build/Makefile-JVM.in index a6cb9698ac7..9513fc31a50 100644 --- a/tools/build/Makefile-JVM.in +++ b/tools/build/Makefile-JVM.in @@ -124,7 +124,7 @@ $(PERL6_C_JAR): src/Perl6/Compiler.nqp $(PERL6_O_JAR) $(J_NQP) --module-path=blib --target=jar --output=$(PERL6_C_JAR) --encoding=utf8 \ src/Perl6/Compiler.nqp -$(PERL6_JAR): src/main.nqp $(RUNTIME_JAR) $(PERL6_G_JAR) $(PERL6_A_JAR) $(PERL6_C_JAR) $(PERL6_P_JAR) +$(PERL6_JAR): src/main.nqp $(RUNTIME_JAR) $(PERL6_G_JAR) $(PERL6_A_JAR) $(PERL6_C_JAR) $(PERL6_P_JAR) $(J_METAMODEL_SOURCES) $(J_CORE_SOURCES) $(J_CORE_D_SOURCES) $(PERL5) tools/build/gen-version.pl $(PREFIX) $(LIBDIR) > $(J_BUILD_DIR)/main-version.nqp $(J_NQP) $(J_GEN_CAT) src/main.nqp $(J_BUILD_DIR)/main-version.nqp > $(J_BUILD_DIR)/main.nqp $(J_NQP) --module-path=blib --target=jar --javaclass=perl6 --output=$(PERL6_JAR) \ diff --git a/tools/build/Makefile-Moar.in b/tools/build/Makefile-Moar.in index 0c42c780afd..d1da46fc99b 100644 --- a/tools/build/Makefile-Moar.in +++ b/tools/build/Makefile-Moar.in @@ -145,7 +145,7 @@ $(PERL6_C_MOAR): src/Perl6/Compiler.nqp $(PERL6_O_MOAR) $(M_NQP) --module-path=blib --target=mbc --output=$(PERL6_C_MOAR) --encoding=utf8 \ src/Perl6/Compiler.nqp -$(PERL6_MOAR): src/main.nqp $(PERL6_G_MOAR) $(PERL6_A_MOAR) $(PERL6_C_MOAR) $(PERL6_P_MOAR) +$(PERL6_MOAR): src/main.nqp $(PERL6_G_MOAR) $(PERL6_A_MOAR) $(PERL6_C_MOAR) $(PERL6_P_MOAR) $(M_METAMODEL_SOURCES) $(M_CORE_SOURCES) $(M_CORE_D_SOURCES) $(PERL5) tools/build/gen-version.pl $(PREFIX) $(LIBDIR) > $(M_BUILD_DIR)/main-version.nqp $(M_NQP) $(M_GEN_CAT) src/main.nqp $(M_BUILD_DIR)/main-version.nqp > $(M_BUILD_DIR)/main.nqp $(M_NQP) --module-path=blib --target=mbc --output=$(PERL6_MOAR) \ diff --git a/tools/build/gen-version.pl b/tools/build/gen-version.pl index 1a36bb1f891..5ba091bdd33 100644 --- a/tools/build/gen-version.pl +++ b/tools/build/gen-version.pl @@ -6,6 +6,8 @@ =head1 TITLE =cut +use Digest::SHA; +use File::Find; use POSIX 'strftime'; my $prefix = shift; @@ -27,6 +29,10 @@ =head1 TITLE my $builddate = strftime('%Y-%m-%dT%H:%M:%SZ', gmtime); +my $sha = Digest::SHA->new; +find(sub { next unless /\.(nqp|pm6)\z/; $sha->addfile($_) }, "src"); +my $source_digest = $sha->hexdigest; + print <<"END_VERSION"; sub hll-config(\$config) { \$config := 'Rakudo'; @@ -37,6 +43,7 @@ =head1 TITLE \$config := '6.c'; \$config := '$prefix'; \$config := '$libdir'; + \$config := '$source_digest'; } END_VERSION