"Fossies" - the Fresh Open Source Software Archive  

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

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

[ To the main PDL source changes report ]

Signature.pm  (PDL-2.080):Signature.pm  (PDL-2.081)
skipping to change at line 50 skipping to change at line 50
push @{$ind2use{$io->name}}, $o; push @{$ind2use{$io->name}}, $o;
$ind2obj{$io->name} = $io; $ind2obj{$io->name} = $io;
} }
} }
$this->{Ind2Use} = \%ind2use; $this->{Ind2Use} = \%ind2use;
$this->{Ind2Obj} = \%ind2obj; $this->{Ind2Obj} = \%ind2obj;
$this->{IndNamesSorted} = [ sort keys %ind2use ]; $this->{IndNamesSorted} = [ sort keys %ind2use ];
my $i=0; my %ind2index = map +($_=>$i++), @{$this->{IndNamesSorted}}; my $i=0; my %ind2index = map +($_=>$i++), @{$this->{IndNamesSorted}};
$this->{Ind2Index} = \%ind2index; $this->{Ind2Index} = \%ind2index;
$ind2obj{$_}->set_index($ind2index{$_}) for sort keys %ind2index; $ind2obj{$_}->set_index($ind2index{$_}) for sort keys %ind2index;
@$this{qw(OtherNames OtherObjs)} = $this->_otherPars_nft($otherpars||''); @$this{qw(OtherNames OtherObjs OtherAnyOut OtherFlags)} = $this->_otherPars_nf t($otherpars||'');
$this; $this;
} }
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); my (@names,%types,$type,$any_out,%allflags);
# support 'int ndim => n;' syntax
for (nospacesplit(';',$otherpars)) { for (nospacesplit(';',$otherpars)) {
if (/^\s*([^=]+)\s*=>\s*(\S+)\s*$/) { my (%flags);
if (s/^\s*$PDL::PP::PdlParObj::sqbr_re\s*//) {
%flags = my %lflags = map +($_=>1), split /\s*,\s*/, my $opts = $1;
my $this_out = delete $lflags{o};
die "Invalid options '$opts' in '$_'" if keys %lflags;
$any_out ||= $this_out;
}
if (/^\s*([^=]+?)\s*=>\s*(\S+)\s*$/) {
# support 'int ndim => n;' syntax
my ($ctype,$dim) = ($1,$2); my ($ctype,$dim) = ($1,$2);
$ctype =~ s/\s+$//; # get rid of trailing ws
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);
croak "can't set unknown dimension '$dim' from '$otherpars'" croak "can't set unknown dimension '$dim' from '$otherpars'"
unless defined($dimobjs->{$dim}); unless defined($dimobjs->{$dim});
$type = PDL::PP::CType->new($ctype);
$dimobjs->{$dim}->set_from($type); $dimobjs->{$dim}->set_from($type);
} elsif(/^\s*\(\s*void\s*\)/) {
# suppressing unused param warning - skip
next;
} 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" croak "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;
$allflags{$name} = \%flags;
} }
return (\@names,\%types); (\@names,\%types,$any_out,\%allflags);
} }
*with = \&new;
=head1 AUTHOR =head1 AUTHOR
Copyright (C) Tuomas J. Lukka 1997 (lukka@husc.harvard.edu) and by Christian Copyright (C) Tuomas J. Lukka 1997 (lukka@husc.harvard.edu) and by Christian
Soeller (c.soeller@auckland.ac.nz). Soeller (c.soeller@auckland.ac.nz).
All rights reserved. There is no warranty. You are allowed All rights reserved. There is no warranty. You are allowed
to redistribute this software / documentation under certain to redistribute this software / documentation under certain
conditions. For details, see the file COPYING in the PDL conditions. For details, see the file COPYING in the PDL
distribution. If this file is separated from the PDL distribution, distribution. If this file is separated from the PDL distribution,
the copyright notice should be included in the file. the copyright notice should be included in the file.
skipping to change at line 121 skipping to change at line 124
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, $for_xs) = @_; my ($self, $omit_count, $except) = @_;
return $self->{OtherNames} if $for_xs; $except ||= {};
my $objs = $self->otherobjs($for_xs); return $self->{OtherNames} if $omit_count && !keys %$except;
my @raw_names = @{$self->{OtherNames}}; my $objs = $self->otherobjs;
[ map $objs->{$_}->is_array ? ($_, "${_}_count") : $_, @raw_names ]; my @raw_names = grep !$except->{$_}, @{$self->{OtherNames}};
} @raw_names = map $objs->{$_}->is_array ? ($_, "${_}_count") : $_, @raw_names i
sub otherobjs { f !$omit_count;
my ($self, $for_xs) = @_; \@raw_names;
return $self->{OtherObjs} if $for_xs; }
my $objs = $self->{OtherObjs}; sub otherobjs { $_[0]{OtherObjs} }
my @raw_names = @{$self->{OtherNames}}; sub other_any_out { $_[0]{OtherAnyOut} }
+{ map $objs->{$_}->is_array sub other_is_out { $_[0]{OtherFlags}{$_[1]} && $_[0]{OtherFlags}{$_[1]}{o} }
? ($_=>$objs->{$_}, "${_}_count"=>PDL::PP::CType->new("PDL_Indx ${_}_count sub other_out { grep $_[0]->other_is_out($_), @{$_[0]{OtherNames}} }
"))
: ($_=>$objs->{$_}), sub allnames { [
@raw_names }; (grep +(!$_[2] || !$_[2]{$_}) && !$_[0]{Objects}{$_}{FlagTemp}, @{$_[0]{Names}
} }),
@{$_[0]->othernames(@_[1,2])},
sub allnames { [(grep !$_[0]{Objects}{$_}{FlagTemp}, @{$_[0]{Names}}), @{$_[0]-> ] }
othernames($_[1])}] }
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($_[1])} }; +{ ( map +($_,$pdltype), @{$_[0]{Names}} ), %{$_[0]->otherobjs} };
} }
sub alldecls { sub alldecls {
my ($self, $long, $for_xs) = @_; my ($self, $omit_count, $indirect, $except) = @_;
return @{$self->allnames($for_xs)} if !$long; my $objs = $self->allobjs;
my $objs = $self->allobjs($for_xs); my @names = @{$self->allnames($omit_count, $except)};
map $objs->{$_}->get_decl($_, {VarArrays2Ptrs=>1}), @{$self->allnames($for_xs) $indirect = $indirect ? { map +($_=>$self->other_is_out($_)), @names } : {};
}; map $objs->{$_}->get_decl($_, {VarArrays2Ptrs=>1,AddIndirect=>$indirect->{$_}}
), @names;
} }
sub getcomp { sub getcomp {
my ($self) = @_; my ($self) = @_;
my $objs = $self->otherobjs(0); my $objs = $self->otherobjs;
join '', map "$_;", grep $_, map $objs->{$_}->get_decl($_, {VarArrays2Ptrs=>1} my @names = @{$self->othernames(0)};
), @{$self->othernames(0)}; my $indirect = { map +($_=>$self->other_is_out($_)), @names };
join '', map "$_;", grep $_, map $objs->{$_}->get_decl($_, {VarArrays2Ptrs=>1,
AddIndirect=>$indirect->{$_}}), @names;
} }
sub getfree { sub getfree {
my ($self,$symbol) = @_; my ($self,$symbol) = @_;
my $objs = $self->otherobjs(0); 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) = @_; my ($self, $to_pat) = @_;
my $objs = $self->otherobjs(0); my $objs = $self->otherobjs;
PDL::PP::pp_line_numbers(__LINE__, PDL::PP::pp_line_numbers(__LINE__,
join '', map $objs->{$_}->get_copy($_,"\$COMP($_)"), @{$self->othernames(0)} join '', map $objs->{$_}->get_copy($_,sprintf $to_pat,$_), @{$self->othernam 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;
 End of changes. 17 change blocks. 
45 lines changed or deleted 51 lines changed or added
To the Perl Modules section of the PDL source changes report or the top of this page
Mainly generated by pkgdiff using rfcdiff
Home  |  About  |  Features  |  All  |  Newest  |  Dox  |  Diffs  |  RSS Feeds  |  Screenshots  |  Comments  |  Imprint  |  Privacy  |  HTTP(S)