Skip to content
Browse files

Merge branch 'nom' into froggs_mergemulti

  • Loading branch information...
2 parents ad93780 + 8edd740 commit e08b3113a5ce6a9b969ba22439f1fcd92df97210 @jnthn jnthn committed
View
1 docs/ChangeLog
@@ -3,6 +3,7 @@ New in 2013.01
+ first mentioning a variable from outer scope and then redeclaring it
in the same scope (my $a; { $a; my $a }) is now an error.
+ the long-deprecated "SAFE" setting has been removed
++ 'require' now works with indirect module names
New in 2012.12
+ ~/.perl6/lib is gone from the default include path
View
21 docs/running.pod
@@ -42,6 +42,27 @@ where
post = an intermediate format representing the parrot opcode syntax tree
pir = the parrot intermediate representation
+=head1 List of env vars used in Rakudo
+
+=over
+
+=item C<RAKUDOLIB>, C<PERL6LIB> (src/core/terms.pm)
+
+Appends a delimited list of paths to C<@INC>. C<RAKUDOLIB> is evaluated first.
+
+=item C<RAKUDO_MODULE_DEBUG> (src/Perl6/ModuleLoader.pm)
+
+If set to a non-false value, causes the module loader to print debugging information to standard
+error.
+
+=item C<RAKUDO_ERROR_COLOR> (src/core/Exception.pm)
+
+Controls whether to emit ANSI codes for error highlighting. Defaults to true if unset, except on
+Win32.
+
+=back
+
+
=head1 PARROT OPTIONS
To specify options to the underlying parrot VM, you must explicitly run
View
16 src/Perl6/Actions.pm
@@ -59,14 +59,9 @@ class Perl6::Actions is HLL::Actions does STDActions {
QAST::Op.new(:op<isconcrete>,
QAST::Var.new(:$name, :scope<local>),
),
- QAST::Op.new(:op<if>,
- QAST::Op.new(:op<can>,
- QAST::Var.new(:$name, :scope<local>),
- QAST::SVal.new(:value('sink')),
- ),
- QAST::Op.new(:op<defined>,
- QAST::Var.new(:$name, :scope<local>),
- )
+ QAST::Op.new(:op<can>,
+ QAST::Var.new(:$name, :scope<local>),
+ QAST::SVal.new(:value('sink')),
)
),
QAST::Op.new(:op<callmethod>, :name<sink>,
@@ -86,6 +81,7 @@ class Perl6::Actions is HLL::Actions does STDActions {
'if', 1,
'unless', 1,
'handle', 1,
+ 'p6type', 1,
);
sub autosink($past) {
nqp::istype($past, QAST::Op) && %sinkable{$past.op} && !$past<nosink>
@@ -960,7 +956,7 @@ class Perl6::Actions is HLL::Actions does STDActions {
method statement_control:sym<require>($/) {
my $past := QAST::Stmts.new(:node($/));
my $name_past := $<module_name>
- ?? QAST::SVal.new(:value($<module_name><longname><name>.Str))
+ ?? $*W.disect_longname($<module_name><longname>).name_past()
!! $<EXPR>[0].ast;
$past.push(QAST::Op.new(
@@ -5322,7 +5318,7 @@ class Perl6::Actions is HLL::Actions does STDActions {
%*HANDLERS{$type} := QAST::Stmts.new(
:node($/),
QAST::VM.new( :pirop('perl6_invoke_catchhandler__vPP'), $handler, $ex),
- QAST::Var.new( :scope('lexical'), :name('$!') )
+ QAST::Var.new( :scope('lexical'), :name('Nil') )
);
}
View
13 src/Perl6/Grammar.pm
@@ -3119,8 +3119,15 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
token infix:sym<.> { <sym> <[\]\)\},:\s\$"']> <.obs('. to concatenate strings', '~')> }
token infix:sym<&> { <sym> <O('%junctive_and')> }
+ token infix:sym<(&)> { <!before <sym> <infixish> > <sym> <O('%junctive_and')> }
+ token infix:sym<(.)> { <!before <sym> <infixish> > <sym> <O('%junctive_and')> }
+
token infix:sym<|> { <sym> <O('%junctive_or')> }
token infix:sym<^> { <sym> <O('%junctive_or')> }
+ token infix:sym<(|)> { <!before <sym> <infixish> > <sym> <O('%junctive_or')> }
+ token infix:sym<(^)> { <!before <sym> <infixish> > <sym> <O('%junctive_or')> }
+ token infix:sym<(+)> { <!before <sym> <infixish> > <sym> <O('%junctive_or')> }
+ token infix:sym<(-)> { <!before <sym> <infixish> > <sym> <O('%junctive_or')> }
token prefix:sym<let> { <sym> \s+ <!before '=>'> <O('%named_unary')> { $*W.give_cur_block_let($/) } }
token prefix:sym<temp> { <sym> \s+ <!before '=>'> <O('%named_unary')> { $*W.give_cur_block_temp($/) } }
@@ -3222,12 +3229,6 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
token infix:sym<Z> { <!before <sym> <infixish> > <sym> <O('%list_infix')> }
token infix:sym<X> { <!before <sym> <infixish> > <sym> <O('%list_infix')> }
- token infix:sym<(|)> { <!before <sym> <infixish> > <sym> <O('%list_infix')> }
- token infix:sym<(&)> { <!before <sym> <infixish> > <sym> <O('%list_infix')> }
- token infix:sym<(-)> { <!before <sym> <infixish> > <sym> <O('%list_infix')> }
- token infix:sym<(^)> { <!before <sym> <infixish> > <sym> <O('%list_infix')> }
- token infix:sym<(.)> { <!before <sym> <infixish> > <sym> <O('%list_infix')> }
- token infix:sym<(+)> { <!before <sym> <infixish> > <sym> <O('%list_infix')> }
token infix:sym<...> { <sym> <O('%list_infix')> }
token infix:sym<...^> { <sym> <O('%list_infix')> }
View
4 src/Perl6/Metamodel/BUILDPLAN.pm
@@ -9,7 +9,9 @@ role Perl6::Metamodel::BUILDPLAN {
# nested array is an "op" representing the task to perform:
# 0 code = call specified BUILD method
# 1 class name attr_name = try to find initialization value
- # 2 class attr_name code = call default value closure if needed
+ # 2 class name attr_name = try to find initialization value, or set nqp::list()
+ # 3 class name attr_name = try to find initialization value, or set nqp::hash()
+ # 4 class attr_name code = call default value closure if needed
method create_BUILDPLAN($obj) {
# First, we'll create the build plan for just this class.
my @plan;
View
14 src/Perl6/Metamodel/ClassHOW.pm
@@ -21,6 +21,7 @@ class Perl6::Metamodel::ClassHOW
{
has @!roles;
has @!role_typecheck_list;
+ has @!concretizations;
has @!fallbacks;
has $!composed;
@@ -87,7 +88,9 @@ class Perl6::Metamodel::ClassHOW
my $r := @roles_to_compose.pop();
@!roles[+@!roles] := $r;
@!role_typecheck_list[+@!role_typecheck_list] := $r;
- @ins_roles.push($r.HOW.specialize($r, $obj))
+ my $ins := $r.HOW.specialize($r, $obj);
+ @ins_roles.push($ins);
+ nqp::push(@!concretizations, [$r, $ins]);
}
self.compute_mro($obj); # to the best of our knowledge, because the role applier wants it.
RoleToClassApplier.apply($obj, @ins_roles);
@@ -185,6 +188,15 @@ class Perl6::Metamodel::ClassHOW
@!role_typecheck_list
}
+ method concretization($obj, $ptype) {
+ for @!concretizations {
+ if pir::perl6_decontainerize__PP($_[0]) =:= pir::perl6_decontainerize__PP($ptype) {
+ return $_[1];
+ }
+ }
+ nqp::die("No concretization found for " ~ $ptype.HOW.name($ptype));
+ }
+
method is_composed($obj) {
$!composed
}
View
13 src/Perl6/Metamodel/MROBasedMethodDispatch.pm
@@ -18,6 +18,19 @@ role Perl6::Metamodel::MROBasedMethodDispatch {
nqp::null();
}
+ method find_method_qualified($obj, $qtype, $name) {
+ if $qtype.HOW.archetypes.parametric && nqp::can(self, 'concretization') {
+ # Resolve it via the concrete form of this parametric.
+ my $conc := self.concretization($obj, $qtype);
+ $conc.HOW.method_table($conc){$name}
+ }
+ else {
+ # Non-parametric, so just locate it from the already concrete
+ # type (or fallback to this if no .concretization on ourself).
+ nqp::findmethod($qtype, $name)
+ }
+ }
+
method publish_method_cache($obj) {
# Walk MRO and add methods to cache, unless another method
# lower in the class hierarchy "shadowed" it.
View
5 src/Perl6/Ops.pm
@@ -11,13 +11,8 @@ $ops.add_hll_pirop_mapping('perl6', 'p6list', 'perl6_list_from_rpa', 'PPPP', :in
$ops.add_hll_pirop_mapping('perl6', 'p6listitems', 'perl6_listitems', 'PP', :inlinable(1));
$ops.add_hll_pirop_mapping('perl6', 'p6decont', 'perl6_decontainerize', 'PP', :inlinable(1));
$ops.add_hll_pirop_mapping('perl6', 'p6recont_ro', 'perl6_recontainerize_to_ro', 'PP', :inlinable(1));
-$ops.add_hll_pirop_mapping('perl6', 'attrinited', 'repr_is_attr_initialized', 'IPPs', :inlinable(1));
$ops.add_hll_pirop_mapping('perl6', 'callerid', 'perl6_callerid', 'I');
$ops.add_hll_pirop_mapping('perl6', 'ishash', 'perl6_is_hash', 'IP', :inlinable(1));
-$ops.add_hll_pirop_mapping('perl6', 'lcm_i', 'lcm', 'Iii', :inlinable(1));
-$ops.add_hll_pirop_mapping('perl6', 'gcd_i', 'gcd', 'Iii', :inlinable(1));
-$ops.add_hll_pirop_mapping('perl6', 'sqrt_n', 'sqrt', 'NN', :inlinable(1));
-$ops.add_hll_pirop_mapping('perl6', 'create', 'repr_instance_of', 'PP', :inlinable(1));
$ops.add_hll_pirop_mapping('perl6', 'p6store', 'perl6_container_store', '0PP', :inlinable(1));
$ops.add_hll_pirop_mapping('perl6', 'p6type', 'perl6ize_type', 'PP', :inlinable(1));
$ops.add_hll_pirop_mapping('perl6', 'p6takedisp', 'perl6_take_dispatcher', 'v');
View
25 src/Perl6/World.pm
@@ -1611,6 +1611,31 @@ class Perl6::World is HLL::World {
nqp::join('::', @parts)
~ ($with_adverbs ?? nqp::join('', @!colonpairs) !! '');
}
+
+ # returns a QAST tree that represents the name
+ # currently needed for 'require ::($modulename) <importlist>'
+ # ignore adverbs for now
+ method name_past() {
+ if self.contains_indirect_lookup() {
+ if @!components == 1 {
+ return @!components[0];
+ }
+ else {
+ my $past := QAST::Op.new(:op<call>, :name('&infix:<,>'));
+ for @!components {
+ $past.push: $_ ~~ QAST::Node ?? $_ !! QAST::SVal.new(:value($_));
+ }
+ return QAST::Op.new(:op<callmethod>, :name<join>,
+ $past,
+ QAST::SVal.new(:value<::>)
+ );
+ }
+ }
+ else {
+ my $value := nqp::join('::', @!components);
+ QAST::SVal.new(:$value);
+ }
+ }
# Gets the individual components, which may be PAST nodes for
# unknown pieces.
View
2 src/core/Failure.pm
@@ -35,7 +35,7 @@ my class Failure {
$!exception.throw;
}
);
- method sink() { $!exception.throw }
+ method sink() { $!exception.throw unless $!handled }
# class Any has a fallback method, so we need to redefine it here
method postcircumfix:<{ }>(|c) { $!exception.throw }
View
17 src/core/IO/Socket.pm
@@ -25,12 +25,17 @@ my role IO::Socket {
method read(IO::Socket:D: Cool $bufsize as Int) {
fail('Socket not available') unless $!PIO;
- my $buf := nqp::create(Buf);
- my Mu $parrot_buf := pir::new__PS('ByteBuffer');
- pir::set__vPS($parrot_buf, $!PIO.read(nqp::unbox_i($bufsize)));
- nqp::bindattr_s($buf, Buf, '$!buffer',
- $parrot_buf.get_string('binary'));
- $buf;
+ my $res = Buf.new;
+ my $buf;
+ repeat {
+ $buf := nqp::create(Buf);
+ my Mu $parrot_buf := pir::new__PS('ByteBuffer');
+ pir::set__vPS($parrot_buf, $!PIO.read(nqp::unbox_i($bufsize - $res.elems)));
+ nqp::bindattr_s($buf, Buf, '$!buffer',
+ $parrot_buf.get_string('binary'));
+ $res = $res ~ $buf;
+ } while $res.elems < $bufsize && $buf.elems;
+ $res;
}
method poll(Int $bitmask, $seconds) {
View
6 src/core/List.pm
@@ -234,14 +234,14 @@ my class List does Positional {
my $o = $offset;
my $s = $size;
my $elems = self.elems;
- $offset += $elems if ($offset < 0);
+ $o = $o($elems) if nqp::istype($o, Callable);
X::OutOfRange.new(
what => 'offset argument to List.splice',
got => $offset,
- range => (-self.elems..^self.elems),
+ range => (0..^self.elems),
).fail if $o < 0;
$s //= self.elems - ($o min $elems);
- $s = self.elems + $s - $o if ($s < 0);
+ $s = $s(self.elems - $o) if nqp::istype($s, Callable);
X::OutOfRange.new(
what => 'size argument to List.splice',
got => $size,
View
60 src/core/Mu.pm
@@ -75,12 +75,13 @@ my class Mu {
my int $i = 0;
while nqp::islt_i($i, $count) {
my $task := nqp::atpos($build_plan, $i);
+ my int $code = nqp::atpos_i($task, 0);
$i = nqp::add_i($i, 1);
- if nqp::iseq_i(nqp::atpos_i($task, 0), 0) {
+ if nqp::iseq_i($code, 0) {
# Custom BUILD call.
nqp::atpos($task, 1)(self, |%attrinit);
}
- elsif nqp::iseq_i(nqp::atpos_i($task, 0), 1) {
+ elsif nqp::iseq_i($code, 1) {
# See if we have a value to initialize this attr
# with.
my $key_name := nqp::p6box_s(nqp::atpos_s($task, 2));
@@ -92,7 +93,29 @@ my class Mu {
nqp::atpos($task, 3)) = nqp::p6decont(%attrinit{$key_name});
}
}
- elsif nqp::iseq_i(nqp::atpos_i($task, 0), 4) {
+ elsif nqp::iseq_i($code, 2) {
+ my $key_name := nqp::p6box_s(nqp::atpos_s($task, 2));
+ if %attrinit.exists($key_name) {
+ nqp::getattr(self, nqp::atpos($task, 1),
+ nqp::atpos_s($task, 3)) = nqp::p6decont(%attrinit{$key_name});
+ }
+ else {
+ nqp::bindattr(self, nqp::atpos($task, 1),
+ nqp::atpos_s($task, 3), nqp::list())
+ }
+ }
+ elsif nqp::iseq_i($code, 3) {
+ my $key_name := nqp::p6box_s(nqp::atpos_s($task, 2));
+ if %attrinit.exists($key_name) {
+ nqp::getattr(self, nqp::atpos($task, 1),
+ nqp::atpos_s($task, 3)) = nqp::p6decont(%attrinit{$key_name});
+ }
+ else {
+ nqp::bindattr(self, nqp::atpos($task, 1),
+ nqp::atpos_s($task, 3), nqp::hash())
+ }
+ }
+ elsif nqp::iseq_i($code, 4) {
unless nqp::attrinited(self, nqp::atpos($task, 1), nqp::atpos_s($task, 2)) {
my $attr := nqp::getattr(self, nqp::atpos($task, 1), nqp::atpos_s($task, 2));
$attr = nqp::atpos($task, 3)(self, $attr);
@@ -112,12 +135,13 @@ my class Mu {
my int $i = 0;
while nqp::islt_i($i, $count) {
my $task := nqp::atpos($build_plan, $i);
+ my int $code = nqp::atpos_i($task, 0);
$i = nqp::add_i($i, 1);
- if nqp::iseq_i(nqp::atpos_i($task, 0), 0) {
+ if nqp::iseq_i($code, 0) {
# Custom BUILD call.
nqp::atpos($task, 1)(self, |%attrinit);
}
- elsif nqp::iseq_i(nqp::atpos_i($task, 0), 1) {
+ elsif nqp::iseq_i($code, 1) {
# See if we have a value to initialize this attr
# with.
my $key_name := nqp::p6box_s(nqp::atpos_s($task, 2));
@@ -126,7 +150,29 @@ my class Mu {
nqp::atpos_s($task, 3)) = nqp::p6decont(%attrinit{$key_name});
}
}
- elsif nqp::iseq_i(nqp::atpos_i($task, 0), 4) {
+ elsif nqp::iseq_i($code, 2) {
+ my $key_name := nqp::p6box_s(nqp::atpos_s($task, 2));
+ if %attrinit.exists($key_name) {
+ nqp::getattr(self, nqp::atpos($task, 1),
+ nqp::atpos_s($task, 3)) = nqp::p6decont(%attrinit{$key_name});
+ }
+ else {
+ nqp::bindattr(self, nqp::atpos($task, 1),
+ nqp::atpos_s($task, 3), nqp::list())
+ }
+ }
+ elsif nqp::iseq_i($code, 3) {
+ my $key_name := nqp::p6box_s(nqp::atpos_s($task, 2));
+ if %attrinit.exists($key_name) {
+ nqp::getattr(self, nqp::atpos($task, 1),
+ nqp::atpos_s($task, 3)) = nqp::p6decont(%attrinit{$key_name});
+ }
+ else {
+ nqp::bindattr(self, nqp::atpos($task, 1),
+ nqp::atpos_s($task, 3), nqp::hash())
+ }
+ }
+ elsif nqp::iseq_i($code, 4) {
unless nqp::attrinited(self, nqp::atpos($task, 1), nqp::atpos_s($task, 2)) {
my $attr := nqp::getattr(self, nqp::atpos($task, 1), nqp::atpos_s($task, 2));
$attr = nqp::atpos($task, 3)(self, $attr);
@@ -269,7 +315,7 @@ my class Mu {
).throw;
}
- nqp::findmethod($type, $name)(SELF, |c)
+ self.HOW.find_method_qualified(self, $type, $name)(SELF, |c)
}
method dispatch:<!>(Mu \SELF: $name, Mu $type, |c) is rw is hidden_from_backtrace {
View
8 src/core/operators.pm
@@ -79,8 +79,8 @@ multi infix:<but>(Mu:U \obj, @roles) {
obj.HOW.mixin(obj, |@roles)
}
-sub SEQUENCE($left, $right, :$exclude_end) {
- my @right := $right.flat;
+sub SEQUENCE($left, Mu $right, :$exclude_end) {
+ my @right := nqp::istype($right, Junction) ?? [$right] !! $right.flat;
my $endpoint = @right.shift;
my $infinite = $endpoint ~~ Whatever || $endpoint === $Inf;
$endpoint = Bool::False if $infinite;
@@ -178,10 +178,10 @@ sub WHAT(\x) {
}
proto sub infix:<...>(|) { * }
-multi sub infix:<...>($a, $b) { SEQUENCE($a, $b) }
+multi sub infix:<...>($a, Mu $b) { SEQUENCE($a, $b) }
proto sub infix:<...^>(|) { * }
-multi sub infix:<...^>($a, $b) { SEQUENCE($a, $b, :exclude_end(1)) }
+multi sub infix:<...^>($a, Mu $b) { SEQUENCE($a, $b, :exclude_end(1)) }
sub undefine(Mu \x) {
my $undefined;
View
2 tools/build/NQP_REVISION
@@ -1 +1 @@
-2012.12-9-gb2e3f27
+2012.12-22-gd5c0011

0 comments on commit e08b311

Please sign in to comment.
Something went wrong with that request. Please try again.