X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FSub-Nary.git;a=blobdiff_plain;f=lib%2FSub%2FNary.pm;h=611f780d617ad220649149b56ab64094db53cb59;hp=21f53b0be6480a9b9e308d6677a783b533f13afa;hb=fd35681c6f0a1e84d407dbe4fcc7a3c25e4d8851;hpb=93afac3588786704db6d9549d3bf469ba1b5598d diff --git a/lib/Sub/Nary.pm b/lib/Sub/Nary.pm index 21f53b0..611f780 100644 --- a/lib/Sub/Nary.pm +++ b/lib/Sub/Nary.pm @@ -488,10 +488,17 @@ sub pp_leaveloop { } $op = $op->sibling; - my $r = (name($op->first) eq 'and') ? ($self->inspect($op->first->first->sibling))[0] - : ($self->inspect($op))[0]; + my $r; + if (name($op->first) eq 'and') { + ($r, my $l) = ($self->inspect($op->first->first))[0]; + return $r, $l if $r and zero $l; + $r = ($self->inspect($op->first->first->sibling))[0]; + } else { + $r = ($self->inspect($op))[0]; + } + my $c = 1 - count $r; - diag "& leaveloop" if $DEBUG; + diag "& leaveloop $c" if $DEBUG; return $r, $c ? { 0 => $c } : undef; } @@ -522,7 +529,7 @@ sub pp_flip { } my $c = 1 - count $r; - return $r, ($l && $c) ? { 'list' => $c } : undef + return $r, $c ? { 'list' => $c } : undef } sub pp_grepwhile { @@ -534,19 +541,18 @@ sub pp_grepwhile { my ($r2, $l2) = $self->inspect($op->sibling); return $r2, $l2 if $r2 and zero $l2; - diag Dumper [ $r2, $l2 ] if $DEBUG; - my $c = count $l2; # First one to happen + my $c2 = count $l2; # First one to happen my ($r1, $l1) = $self->inspect($op); - diag Dumper [ $r1, $l1 ] if $DEBUG; - return (add $r2, scale $c, $r1), undef if $r1 and zero $l1 and not zero $l2; - return { 'list' => 1 }, undef if list $l2; + return (add $r2, scale $c2, $r1), undef if $r1 and zero $l1 and not zero $l2; + diag Dumper [ [ $r1, $l1 ], [ $r2, $l2 ] ] if $DEBUG; + my $c1 = count $l1; $l2 = { $l2 => 1 } unless ref $l2; - my $r = add $r2, scale $c, - normalize - add map { power $r1, $_, $l2->{$_} } keys %$l2; - $c = 1 - count $r; + my $r = add $r2, + scale $c2, + add map { scale $l2->{$_}, cumulate $r1, $_, $c1 } keys %$l2; + my $c = 1 - count $r; return $r, $c ? { ((zero $l2) ? 0 : 'list') => $c } : undef; } @@ -559,17 +565,18 @@ sub pp_mapwhile { my ($r2, $l2) = $self->inspect($op->sibling); return $r2, $l2 if $r2 and zero $l2; - my $c = count $l2; # First one to happen + my $c2 = count $l2; # First one to happen my ($r1, $l1) = $self->inspect($op); - return (add $r2, scale $c, $r1), undef if $r1 and zero $l1 and not zero $l2; + return (add $r2, scale $c2, $r1), undef if $r1 and zero $l1 and not zero $l2; diag Dumper [ [ $r1, $l1 ], [ $r2, $l2 ] ] if $DEBUG; + my $c1 = count $l1; $l2 = { $l2 => 1 } unless ref $l2; - my $r = add $r2, scale $c, - normalize - add map { power $r1, $_, $l2->{$_} } keys %$l2; - $c = 1 - count $r; + my $r = add $r2, + scale $c2, + add map { scale $l2->{$_}, cumulate $r1, $_, $c1 } keys %$l2; + my $c = 1 - count $r; my $l = scale $c, normalize add map { power $l1, $_, $l2->{$_} } keys %$l2; return $r, $l; }