"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "Basic/Gen/PP/Signature.pm" between
PDL-2.082.tar.gz and PDL-2.083.tar.gz

About: PDL (Perl Data Language) aims to turn perl into an efficient numerical language for scientific computing (similar to IDL and MatLab).

Signature.pm  (PDL-2.082)	:	Signature.pm  (PDL-2.083)
skipping to change at line 26		skipping to change at line 26
=head1 SYNOPSIS		=head1 SYNOPSIS
use PDL::PP::Signature;		use PDL::PP::Signature;
=cut		=cut
# Eliminate whitespace entries		# Eliminate whitespace entries
sub nospacesplit {grep /\S/, split $_[0],$_[1]}		sub nospacesplit {grep /\S/, split $_[0],$_[1]}
sub new {		sub new {
my ($type,$str,$bvalflag,$otherpars) = @_;		my ($type,$pars,$bvalflag,$otherpars) = @_;
$bvalflag ||= 0;		$bvalflag ||= 0;
my $this = bless {}, $type;		my $this = bless {}, $type;
my @objects = map PDL::PP::PdlParObj->new($_,$bvalflag, $this), nospacesplit ' ;',$str;		my @objects = map PDL::PP::PdlParObj->new($_,$bvalflag, $this), nospacesplit ' ;',$pars;
$this->{Names} = [ map $_->name, @objects ];		$this->{Names} = [ map $_->name, @objects ];
$this->{Objects} = { map +($_->name => $_), @objects };		$this->{Objects} = { map +($_->name => $_), @objects };
my @objects_sorted = ((grep !$_->{FlagW}, @objects), (grep $_->{FlagW}, @objec ts));		my @objects_sorted = ((grep !$_->{FlagW}, @objects), (grep $_->{FlagW}, @objec ts));
$objects_sorted[$_]{Number} = $_ for 0..$#objects_sorted;		$objects_sorted[$_]{Number} = $_ for 0..$#objects_sorted;
$this->{NamesSorted} = [ map $_->name, @objects_sorted ];		$this->{NamesSorted} = [ map $_->name, @objects_sorted ];
$this->{DimsObj} = my $dimsobj = PDL::PP::PdlDimsObj->new;		$this->{DimsObj} = my $dimsobj = PDL::PP::PdlDimsObj->new;
$_->add_inds($dimsobj) for @objects;		$_->add_inds($dimsobj) for @objects;
my (%ind2use, %ind2obj);		my (%ind2use, %ind2obj);
for my $o (@objects) {		for my $o (@objects) {
for my $io (@{$o->{IndObjs}}) {		for my $io (@{$o->{IndObjs}}) {
skipping to change at line 62		skipping to change at line 62
}		}
sub _otherPars_nft {		sub _otherPars_nft {
my ($sig,$otherpars) = @_;		my ($sig,$otherpars) = @_;
my $dimobjs = $sig && $sig->dims_obj;		my $dimobjs = $sig && $sig->dims_obj;
my (@names,%types,$type,$any_out,%allflags);		my (@names,%types,$type,$any_out,%allflags);
for (nospacesplit(';',$otherpars)) {		for (nospacesplit(';',$otherpars)) {
my (%flags);		my (%flags);
if (s/^\s*$PDL::PP::PdlParObj::sqbr_re\s*//) {		if (s/^\s*$PDL::PP::PdlParObj::sqbr_re\s*//) {
%flags = my %lflags = map +($_=>1), split /\s*,\s*/, my $opts = $1;		%flags = my %lflags = map +($_=>1), split /\s*,\s*/, my $opts = $1;
my $this_out = delete $lflags{o};		confess "Can't have both [io] and [o]" if $lflags{o} && $lflags{io};
die "Invalid options '$opts' in '$_'" if keys %lflags;		my $this_out = delete($lflags{o}) || delete($lflags{io});
		confess "Invalid options '$opts' in '$_'" if keys %lflags;
$any_out ||= $this_out;		$any_out ||= $this_out;
}		}
if (/^\s*([^=]+?)\s*=>\s*(\S+)\s*$/) {		if (/^\s*([^=]+?)\s*=>\s*(\S+)\s*$/) {
# support 'int ndim => n;' syntax		# support 'int ndim => n;' syntax
my ($ctype,$dim) = ($1,$2);		my ($ctype,$dim) = ($1,$2);
print "OtherPars: setting dim '$dim' from '$ctype'\n" if $::PP_VERBOS E;		print "OtherPars: setting dim '$dim' from '$ctype'\n" if $::PP_VERBOS E;
$type = PDL::PP::CType->new($ctype);		$type = PDL::PP::CType->new($ctype);
($sig->{Ind2Obj}{$dim} ||= $dimobjs->get_indobj_make($dim))->set_from ($type);		($sig->{Ind2Obj}{$dim} ||= $dimobjs->get_indobj_make($dim))->set_from ($type);
} else {		} else {
$type = PDL::PP::CType->new($_);		$type = PDL::PP::CType->new($_);
}		}
my $name = $type->protoname;		my $name = $type->protoname;
croak "Invalid OtherPars name: $name"		confess "Invalid OtherPars name: $name"
if $PDL::PP::PdlParObj::INVALID_PAR{$name};		if $PDL::PP::PdlParObj::INVALID_PAR{$name};
push @names,$name;		push @names,$name;
$types{$name} = $type;		$types{$name} = $type;
$types{"${name}_count"} = PDL::PP::CType->new("PDL_Indx ${name}_count") i f $type->is_array;		$types{"${name}_count"} = PDL::PP::CType->new("PDL_Indx ${name}_count") i f $type->is_array;
$allflags{$name} = \%flags;		$allflags{$name} = \%flags;
}		}
(\@names,\%types,$any_out,\%allflags);		(\@names,\%types,$any_out,\%allflags);
}		}
=head1 AUTHOR		=head1 AUTHOR
skipping to change at line 122		skipping to change at line 123
sub dims_obj { $_[0]->{DimsObj} }		sub dims_obj { $_[0]->{DimsObj} }
sub dims_count { scalar keys %{$_[0]{DimsObj}} }		sub dims_count { scalar keys %{$_[0]{DimsObj}} }
sub dims_values { values %{$_[0]{DimsObj}} }		sub dims_values { values %{$_[0]{DimsObj}} }
sub ind_used { $_[0]{Ind2Use}{$_[1]} }		sub ind_used { $_[0]{Ind2Use}{$_[1]} }
sub ind_obj { $_[0]{Ind2Obj}{$_[1]} }		sub ind_obj { $_[0]{Ind2Obj}{$_[1]} }
sub ind_names_sorted { @{$_[0]{IndNamesSorted}} }		sub ind_names_sorted { @{$_[0]{IndNamesSorted}} }
sub ind_index { $_[0]{Ind2Index}{$_[1]} }		sub ind_index { $_[0]{Ind2Index}{$_[1]} }
sub othernames {		sub othernames {
my ($self, $omit_count, $except) = @_;		my ($self, $omit_count, $with_xs, $except) = @_;
$except ||= {};		$except ||= {};
return $self->{OtherNames} if $omit_count && !keys %$except;		return $self->{OtherNames} if $omit_count && $omit_count > 0 && !keys %$except
		&& $with_xs;
		return [] if $omit_count && $omit_count < 0;
my $objs = $self->otherobjs;		my $objs = $self->otherobjs;
my @raw_names = grep !$except->{$_}, @{$self->{OtherNames}};		my @raw_names = grep !$except->{$_}, @{$self->{OtherNames}};
@raw_names = map $objs->{$_}->is_array ? ($_, "${_}_count") : $_, @raw_names i f !$omit_count;		@raw_names = map $objs->{$_}->is_array ? ($_, "${_}_count") : $_, @raw_names i f !$omit_count;
		@raw_names = grep !$objs->{$_}{WasDollar}, @raw_names if !$with_xs;
\@raw_names;		\@raw_names;
}		}
sub otherobjs { $_[0]{OtherObjs} }		sub otherobjs { $_[0]{OtherObjs} }
sub other_any_out { $_[0]{OtherAnyOut} }		sub other_any_out { $_[0]{OtherAnyOut} }
sub other_is_out { $_[0]{OtherFlags}{$_[1]} && $_[0]{OtherFlags}{$_[1]}{o} }		sub other_is_flag {
		my $flag = $_[2];
		my $has_count = (my $without_count = $_[1]) =~ s/_count$//;
		return $_[0]{OtherFlags}{$_[1]} && $_[0]{OtherFlags}{$_[1]}{$flag} if !$has_co
		unt;
		$_[0]{OtherFlags}{$without_count} && $_[0]{OtherFlags}{$without_count}{$flag};
		}
		sub other_is_output { &other_is_out || &other_is_io }
		sub other_is_out { $_[0]->other_is_flag($_[1], 'o') }
sub other_out { grep $_[0]->other_is_out($_), @{$_[0]{OtherNames}} }		sub other_out { grep $_[0]->other_is_out($_), @{$_[0]{OtherNames}} }
		sub other_is_io { $_[0]->other_is_flag($_[1], 'io') }
		sub other_io { grep $_[0]->other_is_io($_), @{$_[0]{OtherNames}} }
sub allnames { [		sub allnames { my ($self, $omit_count, $with_xs, $except) = @_; [
(grep +(!$_[2] || !$_[2]{$_}) && !$_[0]{Objects}{$_}{FlagTemp}, @{$_[0]{Names}		($omit_count && $omit_count < 0) ? (grep $self->{Objects}{$_}{FlagCreateAlways
}),		}, @{$self->{Names}}) :
@{$_[0]->othernames(@_[1,2])},		(grep +(!$except || !$except->{$_}) && !$self->{Objects}{$_}{FlagTemp}, @{$sel
		f->{Names}}),
		@{$self->othernames(@_[1..3])},
] }		] }
sub allobjs {		sub allobjs {
my $pdltype = PDL::PP::CType->new("pdl *__foo__");		my $pdltype = PDL::PP::CType->new("pdl *__foo__");
+{ ( map +($_,$pdltype), @{$_[0]{Names}} ), %{$_[0]->otherobjs} };		+{ ( map +($_,$pdltype), @{$_[0]{Names}} ), %{$_[0]->otherobjs} };
}		}
sub alldecls {		sub alldecls {
my ($self, $omit_count, $indirect, $except) = @_;		my ($self, $omit_count, $indirect, $with_xs, $except) = @_;
my $objs = $self->allobjs;		my $objs = $self->allobjs;
my @names = @{$self->allnames($omit_count, $except)};		my @names = @{$self->allnames($omit_count, $with_xs, $except)};
$indirect = $indirect ? { map +($_=>$self->other_is_out($_)), @names } : {};		$indirect = $indirect ? { map +($_=>$self->other_is_output($_)), @names } : {}
		;
map $objs->{$_}->get_decl($_, {VarArrays2Ptrs=>1,AddIndirect=>$indirect->{$_}} ), @names;		map $objs->{$_}->get_decl($_, {VarArrays2Ptrs=>1,AddIndirect=>$indirect->{$_}} ), @names;
}		}
sub getcomp {		sub getcomp {
my ($self) = @_;		my ($self) = @_;
my $objs = $self->otherobjs;		my $objs = $self->otherobjs;
my @names = @{$self->othernames(0)};		my @names = @{$self->othernames(0)};
my $indirect = { map +($_=>$self->other_is_out($_)), @names };		my $indirect = { map +($_=>$self->other_is_output($_)), @names };
join '', map "$_;", grep $_, map $objs->{$_}->get_decl($_, {VarArrays2Ptrs=>1,		join "\n", map " $_;", grep $_, map $objs->{$_}->get_decl($_, {VarArrays2Ptrs
AddIndirect=>$indirect->{$_}}), @names;		=>1,AddIndirect=>$indirect->{$_}}), @names;
}		}
sub getfree {		sub getfree {
my ($self,$symbol) = @_;		my ($self,$symbol) = @_;
my $objs = $self->otherobjs;		my $objs = $self->otherobjs;
join '', map $objs->{$_}->get_free("\$$symbol($_)",		join '', map $objs->{$_}->get_free("\$$symbol($_)",
{ VarArrays2Ptrs => 1 }), @{$self->othernames(0)};		{ VarArrays2Ptrs => 1 }), @{$self->othernames(0)};
}		}
sub getcopy {		sub getcopy {
my ($self, $to_pat) = @_;		my ($self, $to_pat) = @_;
my $objs = $self->otherobjs;		my $objs = $self->otherobjs;
PDL::PP::pp_line_numbers(__LINE__,		PDL::PP::indent(2, join '', map $objs->{$_}->get_copy($_,sprintf $to_pat,$_)."
join '', map $objs->{$_}->get_copy($_,sprintf $to_pat,$_), @{$self->othernam		\n", @{$self->othernames(0)});
es(0)}
);
}		}
sub realdims {		sub realdims {
my $this = shift;		my $this = shift;
[ map scalar @{$this->{Objects}{$_}{RawInds}}, @{$this->{Names}} ];		[ map scalar @{$this->{Objects}{$_}{RawInds}}, @{$this->{Names}} ];
}		}
sub creating {		sub creating {
my $this = shift;		my $this = shift;
croak "you must perform a checkdims before calling creating"		confess "you must perform a checkdims before calling creating"
unless defined $this->{Create};		unless defined $this->{Create};
return $this->{Create};		return $this->{Create};
}		}
sub checkdims {		sub checkdims {
my $this = shift;		my $this = shift;
# we have to recreate to keep defaults currently		# we have to recreate to keep defaults currently
$this->{Dims} = PDL::PP::PdlDimsObj->new;		$this->{Dims} = PDL::PP::PdlDimsObj->new;
$this->{Objects}{$_}->add_inds($this->{Dims}) for @{$this->{Names}};		$this->{Objects}{$_}->add_inds($this->{Dims}) for @{$this->{Names}};
my $n = @{$this->{Names}};		my $n = @{$this->{Names}};
croak "not enough pdls to match signature" unless $#_ >= $n-1;		confess "not enough pdls to match signature" unless $#_ >= $n-1;
my @pdls = @_[0..$n-1];		my @pdls = @_[0..$n-1];
if ($PDL::debug) { print "args: ".		if ($PDL::debug) { print "args: ".
join(' ,',map { "[".join(',',$_->dims)."]," } @pdls)		join(' ,',map { "[".join(',',$_->dims)."]," } @pdls)
. "\n"}		. "\n"}
my $i = 0;		my $i = 0;
my @creating = map $this->{Objects}{$_}->perldimcheck($pdls[$i++]),		my @creating = map $this->{Objects}{$_}->perldimcheck($pdls[$i++]),
@{$this->{Names}};		@{$this->{Names}};
$i = 0;		$i = 0;
for (@{$this->{Names}}) {		for (@{$this->{Names}}) {
push @creating, $this->{Objects}{$_}->getcreatedims		push @creating, $this->{Objects}{$_}->getcreatedims
End of changes. 16 change blocks.
24 lines changed or deleted		39 lines changed or added

---