"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "Basic/Gen/PP/PdlParObj.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).

PdlParObj.pm  (PDL-2.082)	:	PdlParObj.pm  (PDL-2.083)
skipping to change at line 23		skipping to change at line 23
my $complex_regex = join '|', qw(real complex);		my $complex_regex = join '|', qw(real complex);
our $sqbr_re = qr/\[([^]]*)\]/x;		our $sqbr_re = qr/\[([^]]*)\]/x;
our $pars_re = qr/^		our $pars_re = qr/^
\s*(?:($complex_regex|$typeregex)\b([+]*)|)\s* # $1,2: first option then plus		\s*(?:($complex_regex|$typeregex)\b([+]*)|)\s* # $1,2: first option then plus
(?:$sqbr_re)?\s* # $3: The initial [option] part		(?:$sqbr_re)?\s* # $3: The initial [option] part
(\w+) # $4: The name		(\w+) # $4: The name
\(([^)]*)\) # $5: The indices		\(([^)]*)\) # $5: The indices
/x;		/x;
my %flag2info = (		my %flag2info = (
io => [[qw(FlagW)]],		io => [[qw(FlagW)]],
nc => [[qw(FlagNCreat)]],
o => [[qw(FlagOut FlagCreat FlagW)]],		o => [[qw(FlagOut FlagCreat FlagW)]],
oca => [[qw(FlagOut FlagCreat FlagW FlagCreateAlways)]],		oca => [[qw(FlagOut FlagCreat FlagW FlagCreateAlways)]],
t => [[qw(FlagTemp FlagCreat FlagW)]],		t => [[qw(FlagTemp FlagCreat FlagW)]],
phys => [[qw(FlagPhys)]],		phys => [[qw(FlagPhys)]],
real => [[qw(FlagReal)]],		real => [[qw(FlagTypeOverride FlagReal)]],
complex => [[qw(FlagComplex)]],		complex => [[qw(FlagTypeOverride FlagComplex)]],
(map +($_->ppforcetype => [[qw(FlagTyped)], 'Type']), types),		(map +($_->ppforcetype => [[qw(FlagTypeOverride FlagTyped)], 'Type']), types),
);		);
my %flag2c = qw(		my %flag2c = qw(
FlagReal PDL_PARAM_ISREAL		FlagReal PDL_PARAM_ISREAL
FlagComplex PDL_PARAM_ISCOMPLEX		FlagComplex PDL_PARAM_ISCOMPLEX
FlagTyped PDL_PARAM_ISTYPED		FlagTyped PDL_PARAM_ISTYPED
FlagTplus PDL_PARAM_ISTPLUS		FlagTplus PDL_PARAM_ISTPLUS
FlagCreat PDL_PARAM_ISCREAT		FlagCreat PDL_PARAM_ISCREAT
FlagCreateAlways PDL_PARAM_ISCREATEALWAYS		FlagCreateAlways PDL_PARAM_ISCREATEALWAYS
FlagOut PDL_PARAM_ISOUT		FlagOut PDL_PARAM_ISOUT
FlagTemp PDL_PARAM_ISTEMP		FlagTemp PDL_PARAM_ISTEMP
skipping to change at line 71		skipping to change at line 70
for(@{$this->{Flags}}) {		for(@{$this->{Flags}}) {
confess("Invalid flag $_ given for $string\n")		confess("Invalid flag $_ given for $string\n")
unless my ($set, $store) = @{ $flag2info{$_} || [] };		unless my ($set, $store) = @{ $flag2info{$_} || [] };
$this->{$store} = $_ if $store;		$this->{$store} = $_ if $store;
$this->{$_} = 1 for @$set;		$this->{$_} = 1 for @$set;
}		}
if ($this->{FlagTyped} && $opt_plus) {		if ($this->{FlagTyped} && $opt_plus) {
$this->{FlagTplus} = 1;		$this->{FlagTplus} = 1;
}		}
$this->{Type} &&= PDL::Type->new($this->{Type});		$this->{Type} &&= PDL::Type->new($this->{Type});
if($this->{FlagNCreat}) {
delete $this->{FlagCreat};
delete $this->{FlagCreateAlways};
}
$this->{RawInds} = [map{		$this->{RawInds} = [map{
s/\s//g; # Remove spaces		s/\s//g; # Remove spaces
$_;		$_;
} split ',', $inds];		} split ',', $inds];
return $this;		return $this;
}		}
sub cflags {		sub cflags {
my ($this) = @_;		my ($this) = @_;
map $flag2c{$_}, grep $this->{$_}, sort keys %flag2c;		map $flag2c{$_}, grep $this->{$_}, sort keys %flag2c;
skipping to change at line 169		skipping to change at line 164
}		}
sub get_incname {		sub get_incname {
my($this,$ind,$for_local) = @_;		my($this,$ind,$for_local) = @_;
return "inc_sizes[PDL_INC_ID(__privtrans->vtable,$this->{Number},$ind)]" if !$for_local;		return "inc_sizes[PDL_INC_ID(__privtrans->vtable,$this->{Number},$ind)]" if !$for_local;
"__inc_$this->{Name}_".$this->get_substname($ind);		"__inc_$this->{Name}_".$this->get_substname($ind);
}		}
sub get_incregisters {		sub get_incregisters {
my($this) = @_;		my($this) = @_;
if(scalar(@{$this->{IndObjs}}) == 0) {return "";}		return '' if scalar(@{$this->{IndObjs}}) == 0;
(join '',map {		join '', map {
my $x = $_;		my $x = $_;
my ($name, $for_local) = map $this->get_incname($x, $_), 0, 1;		my ($name, $for_local) = map $this->get_incname($x, $_), 0, 1;
"register PDL_Indx $for_local = __privtrans->$name; (void)$for_lo		"register PDL_Indx $for_local = __privtrans->$name; (void)$for_lo
cal;\n";		cal;";
} (0..$#{$this->{IndObjs}}) )		} 0..$#{$this->{IndObjs}};
}		}
# Print an access part.		# Print an access part.
sub do_access {		sub do_access {
my($this,$inds,$context) = @_;		my($this,$inds,$context) = @_;
my $pdl = $this->{Name};		my $pdl = $this->{Name};
# Parse substitutions into hash		# Parse substitutions into hash
my %subst = map		my %subst = map
{/^\s*(\w+)\s*=>\s*(\S*)\s*$/ or confess "Invalid subst $_ in ($inds) (n o spaces in => value)\n"; ($1,$2)}		{/^\s*(\w+)\s*=>\s*(\S*)\s*$/ or confess "Invalid subst $_ in ($inds) (n o spaces in => value)\n"; ($1,$2)}
PDL::PP::Rule::Substitute::split_cpp($inds);		PDL::PP::Rule::Substitute::split_cpp($inds);
skipping to change at line 199		skipping to change at line 194
# If not all substitutions made, the user probably made a spelling		# If not all substitutions made, the user probably made a spelling
# error. Barf.		# error. Barf.
if(scalar(keys %subst) != 0) {		if(scalar(keys %subst) != 0) {
confess("Substitutions left: ".(join ',',sort keys %subst)."\n");		confess("Substitutions left: ".(join ',',sort keys %subst)."\n");
}		}
$text;		$text;
}		}
sub do_pdlaccess {		sub do_pdlaccess {
my($this) = @_;		my($this) = @_;
PDL::PP::pp_line_numbers(__LINE__-1, '$PRIV(pdls)['.$this->{Number}.']');		'$PRIV(pdls)['.$this->{Number}.']';
}		}
sub do_pointeraccess {		sub do_pointeraccess {
my($this) = @_;		my($this) = @_;
return $this->{Name}."_datap";		return $this->{Name}."_datap";
}		}
sub do_physpointeraccess {		sub do_physpointeraccess {
my($this) = @_;		my($this) = @_;
return $this->{Name}."_physdatap";		return $this->{Name}."_physdatap";
skipping to change at line 221		skipping to change at line 216
sub do_indterm { my($this,$pdl,$ind,$subst,$context) = @_;		sub do_indterm { my($this,$pdl,$ind,$subst,$context) = @_;
my $substname = $this->get_substname($ind);		my $substname = $this->get_substname($ind);
# See if substitutions		# See if substitutions
my $index = delete($subst->{$substname}) //		my $index = delete($subst->{$substname}) //
# No => get the one from the nearest context.		# No => get the one from the nearest context.
(grep $_ eq $substname, map $_->[1], reverse @$context)[0];		(grep $_ eq $substname, map $_->[1], reverse @$context)[0];
confess "Access Index not found: $pdl, $ind, @{[$this->{IndObjs}[$ind]->name]}		confess "Access Index not found: $pdl, $ind, @{[$this->{IndObjs}[$ind]->name]}
On stack:".(join ' ',map {"($_->[0],$_->[1])"} @$context)."\n"		On stack:".(join ' ',map {"($_->[0],$_->[1])"} @$context)."\n"
if !defined $index;		if !defined $index;
return "(".($this->get_incname($ind,1))."*".		return "(".($this->get_incname($ind,1))."*($index))";
"PP_INDTERM(".$this->{IndObjs}[$ind]->get_size().", $index))";
}		}
sub get_xsdatapdecl {		sub get_xsdatapdecl {
my($this,$ctype,$nulldatacheck) = @_;		my($this,$ctype,$nulldatacheck) = @_;
my $pdl = $this->get_nname;		my $pdl = $this->get_nname;
my $flag = $this->get_nnflag;		my $flag = $this->get_nnflag;
my $name = $this->{Name};		my $name = $this->{Name};
my $macro = "PDL_DECLARE_PARAMETER".($this->{BadFlag} ? "_BADVAL" : "");		my $macro = "PDL_DECLARE_PARAMETER".($this->{BadFlag} ? "_BADVAL" : "");
"$macro($ctype, $flag, $name, $pdl, $nulldatacheck)";		"$macro($ctype, $flag, $name, $pdl, $nulldatacheck)";
}		}
End of changes. 7 change blocks.
16 lines changed or deleted		10 lines changed or added

---