Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
get reductions thunking for left/list assoc
  • Loading branch information
@TimToady
TimToady committed Dec 8, 2015
1 parent 96bc434 commit c27a00c
Show file tree
Hide file tree
Showing 5 changed files with 50 additions and 30 deletions.
22 changes: 19 additions & 3 deletions src/Perl6/Actions.nqp
View file
Expand Up @@ -6144,11 +6144,12 @@ Compilation unit '$file' contained the following violations:

sub thunkity_thunk($/,$thunky,$past,@clause) {
my int $i := 0;
my int $e := +@clause;
my int $e := nqp::elems(@clause);
my int $te := nqp::chars($thunky);
my $type := nqp::substr($thunky,0,1);
while $i < $e {
my $ast := @clause[$i].ast;
my $ast := @clause[$i];
$ast := $ast.ast if nqp::can($ast,'ast'); # reduce already passes ast...

if $type eq 'T' || $type eq 'X' || $type eq 'B' {
my $argast := $ast;
Expand Down Expand Up @@ -6434,15 +6435,30 @@ Compilation unit '$file' contained the following violations:
:scope<lexical>);
my $metaop := baseop_reduce($base<OPER><O>);
my $metapast := QAST::Op.new( :op<call>, :name($metaop), $basepast);
my $t := $basepast.ann('thunky') || $base<OPER><O><thunky>;
if $<triangle> {
$metapast.push($*W.add_constant('Int', 'int', 1));
}
my $args := $<args>.ast;
# one-arg rule?
if +$args.list == 1 && !$args[0].flat && !$args[0].named {
make QAST::Op.new(:node($/), :op<call>, $metapast, $args[0]);
}
else {
$args.name('&infix:<,>');
if $t {
# note("$metaop $t bingo\n" ~ $args.dump);
if $metaop eq '&METAOP_REDUCE_LEFT' || $metaop eq '&METAOP_REDUCE_LIST' {
$args := thunkity_thunk($/,$t,QAST::Op.new( :op('call'), :name('&infix:<,>')),$args.list);
}
else {
$*W.throw($/, 'X::Comp::NYI',
feature => "Thunky reduction on funky associativity");
}
# note("$metaop $t new\n" ~ $args.dump);
}
else {
$args.name('&infix:<,>');
}
make QAST::Op.new(:node($/), :op<call>, $metapast, $args);
}
}
Expand Down
9 changes: 5 additions & 4 deletions src/Perl6/Grammar.nqp
View file
Expand Up @@ -3656,7 +3656,8 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
Perl6::Grammar.O(':prec<n=>, :assoc<non>, :dba<structural infix>, :diffy<1>', '%structural');
Perl6::Grammar.O(':prec<m=>, :assoc<left>, :dba<chaining>, :iffy<1>, :diffy<1> :pasttype<chain>', '%chaining');
Perl6::Grammar.O(':prec<l=>, :assoc<left>, :dba<tight and>, :thunky<.t>', '%tight_and');
Perl6::Grammar.O(':prec<k=>, :assoc<list>, :dba<tight or> :thunky<.t>', '%tight_or');
Perl6::Grammar.O(':prec<k=>, :assoc<list>, :dba<tight or>, :thunky<.t>', '%tight_or');
Perl6::Grammar.O(':prec<k=>, :assoc<list>, :dba<tight or>', '%tight_or_minmax');
Perl6::Grammar.O(':prec<j=>, :assoc<right>, :dba<conditional>, :fiddly<1>, :thunky<.tt>', '%conditional');
Perl6::Grammar.O(':prec<j=>, :assoc<right>, :dba<conditional>, :fiddly<1>, :thunky<tt>', '%conditional_ff');
Perl6::Grammar.O(':prec<i=>, :assoc<right>, :dba<item assignment>', '%item_assignment');
Expand Down Expand Up @@ -4144,10 +4145,10 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
token infix:sym<&&> { <sym> <O('%tight_and, :iffy<1>, :pasttype<if>')> }

token infix:sym<||> { <sym> <O('%tight_or, :iffy<1>, :assoc<left>, :pasttype<unless>')> }
token infix:sym<^^> { <sym> <O('%tight_or, :iffy<1>, :pasttype<xor>')> }
token infix:sym<^^> { <sym> <O('%tight_or, :iffy<1>, :pasttype<xor>, :thunky<..x>')> }
token infix:sym<//> { <sym> <O('%tight_or, :assoc<left>, :pasttype<defor>')> }
token infix:sym<min> { <sym> >> <O('%tight_or')> }
token infix:sym<max> { <sym> >> <O('%tight_or')> }
token infix:sym<min> { <sym> >> <O('%tight_or_minmax')> }
token infix:sym<max> { <sym> >> <O('%tight_or_minmax')> }

token infix:sym<?? !!> {
:my $*GOAL := '!!';
Expand Down
11 changes: 6 additions & 5 deletions src/core/Bool.pm
View file
Expand Up @@ -96,22 +96,23 @@ multi sub infix:<?^>(Mu \a, Mu \b) { nqp::p6bool(nqp::ifnull(nqp::xor(a.B
# we define them here for use as arguments to functions.
proto sub infix:<&&>(|) { * }
multi sub infix:<&&>(Mu $x = Bool::True) { $x }
multi sub infix:<&&>(Mu \a, &b) { a && b }
multi sub infix:<&&>(Mu \a, &b) { a && b() }
multi sub infix:<&&>(Mu \a, Mu \b) { a && b }

proto sub infix:<||>(|) { * }
multi sub infix:<||>(Mu $x = Bool::False) { $x }
multi sub infix:<||>(Mu \a, &b) { a || b }
multi sub infix:<||>(Mu \a, &b) { a || b() }
multi sub infix:<||>(Mu \a, Mu \b) { a || b }

proto sub infix:<^^>(|) { * }
multi sub infix:<^^>(Mu $x = Bool::False) { $x }
multi sub infix:<^^>(Mu \a, Mu &b) { a ^^ b }
multi sub infix:<^^>(Mu \a, Mu &b) { a ^^ b() }
multi sub infix:<^^>(Mu \a, Mu \b) { a ^^ b }
multi sub infix:<^^>(+@a) {
my $a = shift @a;
my Mu $a = shift @a;
while @a {
my $b := shift @a;
my Mu $b := shift @a;
$b := $b() if $b ~~ Callable;
next unless $b;
return Nil if $a;
$a := $b;
Expand Down
30 changes: 15 additions & 15 deletions src/core/operators.pm
View file
Expand Up @@ -586,36 +586,36 @@ sub REQUIRE_IMPORT($package-name, *@syms) {
}
$package
}
sub infix:<andthen>(**@a) {
return Bool::True unless @a;
my Mu $current := @a.shift;
for @a {
sub infix:<andthen>(+a) {
my $ai := a.iterator;
my Mu $current := $ai.pull-one;
return Bool::True if $current =:= IterationEnd;
until ($_ := $ai.pull-one) =:= IterationEnd {
return Empty unless $current.defined;
# Have to check Callable till we get tailthunky lists
$current := $_ ~~ Callable
?? (.count ?? $_($current) !! $_())
!! $_;
}
$current;
}
sub infix:<notandthen>(**@a) {
return Bool::True unless @a;
my Mu $current := @a.shift;
for @a {
sub infix:<notandthen>(+a) {
my $ai := a.iterator;
my Mu $current := $ai.pull-one;
return Bool::True if $current =:= IterationEnd;
until ($_ := $ai.pull-one) =:= IterationEnd {
return Empty if $current.defined;
# Have to check Callable till we get tailthunky lists
$current := $_ ~~ Callable
?? (.count ?? $_($current) !! $_())
!! $_;
}
$current;
}
sub infix:<orelse>(**@a) {
return Nil unless @a;
my Mu $current := @a.shift;
for @a {
sub infix:<orelse>(+a) {
my $ai := a.iterator;
my Mu $current := $ai.pull-one;
return Nil if $current =:= IterationEnd;
until ($_ := $ai.pull-one) =:= IterationEnd {
return $current if $current.defined;
# Have to check Callable till we get tailthunky lists
$current := $_ ~~ Callable
?? (.count ?? $_($current) !! $_())
!! $_;
Expand Down
8 changes: 5 additions & 3 deletions src/core/precedence.pm
View file
Expand Up @@ -18,6 +18,8 @@ BEGIN {
my Mu $chaining := nqp::hash('prec', 'm=', 'assoc', 'chain', 'iffy', 1, 'pasttype', 'chain');
my Mu $tight_and := nqp::hash('prec', 'l=', 'assoc', 'list', 'thunky', '.t');
my Mu $tight_or := nqp::hash('prec', 'k=', 'assoc', 'list', 'thunky', '.t');
my Mu $tight_or_xor := nqp::hash('prec', 'k=', 'assoc', 'list', 'thunky', '..x');
my Mu $tight_or_minmax := nqp::hash('prec', 'k=', 'assoc', 'list');
my Mu $conditional := nqp::hash('prec', 'j=', 'assoc', 'right', 'iffy', 1, 'thunky', '.tt');
my Mu $item_assignment := nqp::hash('prec', 'i=', 'assoc', 'right');
my Mu $loose_unary := nqp::hash('prec', 'h=');
Expand Down Expand Up @@ -166,10 +168,10 @@ BEGIN {
trait_mod:<is>(&infix:<&&>, :prec($tight_and));

trait_mod:<is>(&infix:<||>, :prec($tight_or));
trait_mod:<is>(&infix:<^^>, :prec($tight_or));
trait_mod:<is>(&infix:<^^>, :prec($tight_or_xor));
trait_mod:<is>(&infix:<//>, :prec($tight_or));
trait_mod:<is>(&infix:<min>, :prec($tight_or));
trait_mod:<is>(&infix:<max>, :prec($tight_or));
trait_mod:<is>(&infix:<min>, :prec($tight_or_minmax));
trait_mod:<is>(&infix:<max>, :prec($tight_or_minmax));

#trait_mod:<is>(&infix:<ff>, :prec($conditional_ff));
#trait_mod:<is>(&infix:<fff>, :prec($conditional_ff));
Expand Down

0 comments on commit c27a00c

Please sign in to comment.