From e16d411c491964d619b98a8fb20423e9d064e189 Mon Sep 17 00:00:00 2001 From: Ed J Date: Sun, 24 Nov 2024 21:18:20 +0000 Subject: [PATCH] replace PDL::Lvalue pure-Perl entries with ":lvalue" decoration --- Basic/lib/PDL/Core.pm | 16 ++++++---------- Basic/lib/PDL/Dbg.pm | 4 +--- Basic/lib/PDL/Lvalue.pm | 9 ++++----- Basic/lib/PDL/Primitive.pd | 2 +- Basic/lib/PDL/Slices.pd | 14 +++++++------- 5 files changed, 19 insertions(+), 26 deletions(-) diff --git a/Basic/lib/PDL/Core.pm b/Basic/lib/PDL/Core.pm index 8434ced5f..76be549cf 100644 --- a/Basic/lib/PDL/Core.pm +++ b/Basic/lib/PDL/Core.pm @@ -1601,7 +1601,7 @@ positive indices. =cut -sub PDL::dummy($$;$) { +sub PDL::dummy($$;$) :lvalue { my ($pdl,$dim,$size) = @_; barf("Missing position argument to dummy()") unless defined $dim; # required argument $dim = $pdl->getndims+1+$dim if $dim < 0; @@ -1737,7 +1737,7 @@ Data flows back and forth as usual with slicing routines. =cut -sub PDL::clump { +sub PDL::clump :lvalue { goto &PDL::_clump_int if @_ < 3; my ($this,@dims) = @_; my $ndims = $this->getndims; @@ -1898,10 +1898,6 @@ Explicit broadcasting over specified dims using broadcast id 1. $xx = $x->broadcast1(3,1) -=for example - - Wibble - Convenience function interfacing to L. @@ -2469,7 +2465,7 @@ and/or changed to "slice_if_pdl" for PDL 3.0. =cut -sub PDL::nslice_if_pdl { +sub PDL::nslice_if_pdl :lvalue { my ($pdl) = shift; my ($orig_args) = pop; @@ -2482,7 +2478,7 @@ sub PDL::nslice_if_pdl { } unshift @_, $pdl; - goto &PDL::slice; + PDL::slice(@_); # not goto &... because 5.14 breaks if :lvalue } # Convert everything to PDL if not blessed @@ -2982,7 +2978,7 @@ then the connection is first severed. =cut *reshape = \&PDL::reshape; -sub PDL::reshape { +sub PDL::reshape :lvalue { my $pdl = topdl($_[0]); if (@_ == 2 && $_[1] == -1) { # a slicing reshape that drops 1-dims return $pdl->slice( map $_==1 ? [0,0,0] : [], $pdl->dims); @@ -3042,7 +3038,7 @@ Falls through if argument already == 1D. =cut *flat = \&PDL::flat; -sub PDL::flat { # fall through if < 2D +sub PDL::flat :lvalue { # fall through if < 2D return my $dummy = $_[0]->getndims != 1 ? $_[0]->clump(-1) : $_[0]; } diff --git a/Basic/lib/PDL/Dbg.pm b/Basic/lib/PDL/Dbg.pm index d48df3f15..aba06d194 100644 --- a/Basic/lib/PDL/Dbg.pm +++ b/Basic/lib/PDL/Dbg.pm @@ -97,7 +97,7 @@ For historical reasons C is an alias for C. =cut -sub px { +sub px :lvalue { my $arg = shift; my $str=""; @@ -145,8 +145,6 @@ Alias for C =cut -# make vars an alias -# I hope this works with inheritance *vars = \&px; 1; # return success diff --git a/Basic/lib/PDL/Lvalue.pm b/Basic/lib/PDL/Lvalue.pm index 89bb8bcac..9a9a759c9 100644 --- a/Basic/lib/PDL/Lvalue.pm +++ b/Basic/lib/PDL/Lvalue.pm @@ -32,12 +32,11 @@ use warnings; # list of functions that can be used as lvalue subs # extend as necessary -my @funcs = qw/ clump diagonal dice dice_axis dummy flat - index index2d indexND mv +my @funcs = qw/ + index index2d mv broadcast unbroadcast - nslice_if_pdl px - range rangeb reorder reshape sever slice - where whereND xchg /; + rangeb sever + xchg /; my $prots = join "\n", map {"use attributes 'PDL', \\&PDL::$_, 'lvalue';"} @funcs; diff --git a/Basic/lib/PDL/Primitive.pd b/Basic/lib/PDL/Primitive.pd index 112733aff..5081dc932 100644 --- a/Basic/lib/PDL/Primitive.pd +++ b/Basic/lib/PDL/Primitive.pd @@ -3677,7 +3677,7 @@ broadcast over a smaller mask, for example. =cut -sub PDL::where { +sub PDL::where :lvalue { barf "Usage: where( \$pdl1, ..., \$pdlN, \$mask )\n" if @_ == 1; my $mask = pop->flat->which; @_ == 1 ? $_[0]->flat->index($mask) : map $_->flat->index($mask), @_; diff --git a/Basic/lib/PDL/Slices.pd b/Basic/lib/PDL/Slices.pd index db82b89a4..23bf342af 100644 --- a/Basic/lib/PDL/Slices.pd +++ b/Basic/lib/PDL/Slices.pd @@ -268,14 +268,14 @@ PDL, suitable for feeding to this. =cut -sub PDL::indexND { +sub PDL::indexND :lvalue { my($source,$index, $boundary) = @_; return PDL::range($source,$index,undef,$boundary); } *PDL::indexNDb = \&PDL::indexND; -sub PDL::range { +sub PDL::range :lvalue { my($source,$ind,$sz,$bound) = @_; # Convert to indx type up front (also handled in rangeb if necessary) my $index = (ref $ind && UNIVERSAL::isa($ind,'PDL') && $ind->type eq 'indx') ? $ind : indx($ind); @@ -1545,7 +1545,7 @@ result PDL will change the parent. =cut -sub PDL::reorder { +sub PDL::reorder :lvalue { my ($pdl,@newDimOrder) = @_; my $arrayMax = $#newDimOrder; @@ -2036,7 +2036,7 @@ slice will change the parent (use the C<.=> operator). =cut -sub PDL::dice { +sub PDL::dice :lvalue { my $self = shift; my @dim_indexes = @_; # array of dimension indexes @@ -2112,7 +2112,7 @@ slice will change the parent. =cut -sub PDL::dice_axis { +sub PDL::dice_axis :lvalue { my($self,$axis,$idx) = @_; my $ix = PDL->topdl($idx); barf("dice_axis: index must be <=1D") if $ix->getndims > 1; @@ -2287,7 +2287,7 @@ direct slicing even though the syntax is convenient. $x->slice([-2,1]); EOD-slice PMCode => pp_line_numbers(__LINE__, <<'EOD-slice'), -sub PDL::slice { +sub PDL::slice :lvalue { my ($source, @others) = @_; for my $i(0..$#others) { my $idx = $others[$i]; @@ -2502,7 +2502,7 @@ END $SETDIMS(); '), PMCode =>pp_line_numbers(__LINE__, <<'EOD'), -sub PDL::diagonal { shift->_diagonal_int(my $o=PDL->null, \@_); $o } +sub PDL::diagonal :lvalue { shift->_diagonal_int(my $o=PDL->null, \@_); $o } EOD Doc => <<'EOD', =for ref