Skip to content

Commit

Permalink
Add option 'NoExport' to pp_def
Browse files Browse the repository at this point in the history
  • Loading branch information
@jo-37
jo-37 committed Feb 18, 2025
1 parent bda65d4 commit bb6c311
Show file tree
Hide file tree
Showing 3 changed files with 46 additions and 14 deletions.
21 changes: 16 additions & 5 deletions lib/PDL/Ops.pd
View file
Original file line number Diff line number Diff line change
Expand Up @@ -128,6 +128,7 @@ EOF
}

my $bitwise = delete $extra{Bitwise};
my $export = delete $extra{Export};
pp_def($name,
Pars => 'a(); b(); [o]c();',
OtherPars => 'int $swap',
Expand All @@ -136,6 +137,7 @@ EOF
NoBadifNaN => 1,
Inplace => [ 'a' ],
Overload => [$op, $mutator, $bitwise],
NoExport => !$export,
Code => pp_line_numbers(__LINE__, <<EOF),
PDL_IF_BAD(char anybad = 0;,)
broadcastloop %{
Expand Down Expand Up @@ -184,6 +186,8 @@ ENDCODE
$codestr = '$c() = ($GENERIC(c))'.$func.'($a(),$b());';
}
delete $extra{unsigned}; #remove the key so it doesn't get added in pp_def.
my $export = delete $extra{Export};
my $noinfix = delete $extra{NoInfix};

pp_def($name,
HandleBad => 1,
Expand All @@ -192,7 +196,8 @@ ENDCODE
OtherPars => 'int $swap',
OtherParsDefaults => { swap => 0 },
Inplace => [ 'a' ],
Overload => [$funcov, $mutator],
Overload => [$funcov, $mutator, undef, $noinfix],
NoExport => !$export,
Code => pp_line_numbers(__LINE__, <<EOF),
PDL_IF_BAD(char anybad = 0;,)
broadcastloop %{
Expand Down Expand Up @@ -232,6 +237,7 @@ sub ufunc {
(map 'types('.$_->ppsym.') %{$b() = c'.$func.$_->floatsuffix.'($a());%}', @Ctypes),
;
}
my $export = delete $extra{Export};
# do not have to worry about propagation of the badflag when
# inplace since only input ndarray is a, hence its badflag
# won't change
Expand All @@ -242,6 +248,7 @@ sub ufunc {
NoBadifNaN => 1,
Inplace => 1,
!$overload ? () : (Overload => $funcov),
NoExport => !$export,
Code => pp_line_numbers(__LINE__, <<EOF),
PDL_IF_BAD(if ( \$ISBAD(a()) ) \$SETBAD(b()); else {,)
$codestr
Expand Down Expand Up @@ -309,7 +316,7 @@ ufunc('bitnot','~',1,'unary bitwise negation',GenericTypes => $T);

# some standard binary functions
bifunc('power',['pow','op**'],1,'raise ndarray C<$a> to the power C<$b>',GenericTypes => [@$C, @$F]);
bifunc('atan2','atan2',0,'elementwise C<atan2> of two ndarrays',GenericTypes => $F);
bifunc('atan2','atan2',0,'elementwise C<atan2> of two ndarrays',GenericTypes => $F, NoInfix => 1);
bifunc('modulo',['MOD','op%'],1,'elementwise C<modulo> operation',unsigned=>1);
bifunc('spaceship',['SPACE','op<=>'],0,'elementwise "<=>" operation');

Expand Down Expand Up @@ -340,6 +347,7 @@ pp_def ( '_rabs',
HandleBad => 1,
NoBadifNaN => 1,
Inplace => 1,
NoExport => 1,
Code => pp_line_numbers(__LINE__-1, qq{
PDL_IF_BAD(if ( \$ISBAD(a()) ) \$SETBAD(b()); else,)
$rabs_code
Expand All @@ -348,13 +356,14 @@ PDL_IF_BAD(if ( \$ISBAD(a()) ) \$SETBAD(b()); else,)
PMFunc=>'',
);

pp_export_nothing();
# the following pp_def'ed functions will be exported

# make log10() work on scalars (returning scalars)
# as well as ndarrays
ufunc('log10','log10',0,'the base 10 logarithm', GenericTypes => $A,
Exception => '$a() <= 0',
NoTgmath => 1, # glibc for at least GCC 8.3.0 won't tgmath log10 though 7.1.0 did
Export => 1,
PMCode => <<'EOF',
sub PDL::log10 {
my ($x, $y) = @_;
Expand Down Expand Up @@ -390,12 +399,14 @@ PDL_IF_BAD(if (anybad) $PDLSTATESETBAD(b);,)
sub cfunc {
my ($name, $func, $make_real, $force_complex, $doc, $backcode, %extra) = @_;
my $codestr = pp_line_numbers(__LINE__-1,"\$b() = $func(\$complexv());");
my $export = delete $extra{Export};
pp_def($name,
GenericTypes=>$C,
Pars => ($force_complex ? '!real ' : '').'complexv(); '.($make_real ? 'real' : '').' [o]b()',
HandleBad => 1,
NoBadifNaN => 1,
(($make_real || $force_complex) ? () : (Inplace => 1)),
NoExport => !$export,
Code => pp_line_numbers(__LINE__-1, qq{
PDL_IF_BAD(if ( \$ISBAD(complexv()) ) \$SETBAD(b()); else,)
$codestr
Expand All @@ -414,8 +425,8 @@ PDL_IF_BAD(if ( \$ISBAD(complexv()) ) \$SETBAD(b()); else,)
);
}

cfunc('carg', 'carg', 1, 1, 'Returns the polar angle of a complex number.', undef);
cfunc('conj', 'conj', 0, 0, 'complex conjugate.', undef);
cfunc('carg', 'carg', 1, 1, 'Returns the polar angle of a complex number.', undef, Export => 1);
cfunc('conj', 'conj', 0, 0, 'complex conjugate.', undef, Export => 1);

pp_def('czip',
Pars => '!complex r(); !complex i(); complex [o]c()',
Expand Down
23 changes: 14 additions & 9 deletions lib/PDL/PP.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -864,7 +864,7 @@ sub pp_def {
}
PDL::PP->printxs($obj{NewXSCode});
pp_add_boot($obj{BootSetNewXS}) if $obj{BootSetNewXS};
PDL::PP->pp_add_exported($name);
PDL::PP->pp_add_exported($name) unless $obj{NoExport};
PDL::PP::_pp_addpm_nolineno("\n".$obj{PdlDoc}."\n") if $obj{PdlDoc};
PDL::PP::_pp_addpm_nolineno($obj{PMCode}) if defined $obj{PMCode};
PDL::PP::_pp_addpm_nolineno($obj{PMFunc}."\n") if defined $obj{PMFunc};
Expand Down Expand Up @@ -1390,10 +1390,10 @@ $PDL::PP::deftbl =
}),
PDL::PP::Rule::Returns::EmptyString->new("InplaceCode", []),
PDL::PP::Rule->new("InplaceDocValues",
[qw(Name SignatureObj InplaceNormalised)],
[qw(Name SignatureObj InplaceNormalised Overload NoExport?)],
'doc describing usage inplace',
sub {
my ($name, $sig, $inplace) = @_;
my ($name, $sig, $inplace, $ovl, $noexport) = @_;
my @args = @{ $sig->args_callorder };
my %inplace_involved = map +($_=>1), my ($in, $out) = @$inplace;
my $meth_call = $args[0] eq $in;
Expand All @@ -1403,7 +1403,9 @@ $PDL::PP::deftbl =
!@args ? '' : "(@{[join ',', map qq{\$$_}, @args]})"
).";", []
];
push @vals, [ "$name(\$$in->inplace".(
my $op = defined($ovl) ? ref($ovl) ? $ovl->[0] : $ovl : '';
my $prefix = $noexport && $op ne $name ? "$::PDLOBJ\::" : "";
push @vals, [ "$prefix$name(\$$in->inplace".(
!@args ? '' : ",@{[join ',', map qq{\$$_}, @args]}"
).");", []];
$vals[0][1] = ["can be used inplace"];
Expand All @@ -1418,7 +1420,7 @@ $PDL::PP::deftbl =
my ($name, $sig, $ovl, $inplace) = @_;
confess "$name Overload given false value" if !$ovl;
$ovl = [$ovl] if !ref $ovl;
my ($op, $mutator, $bitwise) = @$ovl;
my ($op, $mutator, $bitwise, $noinfix) = @$ovl;
confess "$name Overload trying to define mutator but no inplace"
if $mutator && !$inplace;
my $one_arg = $sig->names_in == 1;
Expand Down Expand Up @@ -1463,7 +1465,8 @@ EOF
confess "$name error in Overload doc: !=1 output (@outs)" if @outs != 1;
my @ins = $sig->names_in;
my @vals = ["\$$outs[0] = ".(
!$one_arg ? "\$$ins[0] $op \$$ins[1]" :
!$one_arg ?
$noinfix ? "$op \$$ins[0], \$$ins[1]" : "\$$ins[0] $op \$$ins[1]" :
$op.($op =~ /[^a-z]/ ? '' : ' ')."\$$ins[0]"
).";",
["overloads the Perl '$op' operator"]
Expand All @@ -1475,12 +1478,12 @@ EOF

PDL::PP::Rule->new([qw(UsageDoc ParamDoc)],
[qw(Name Doc? SignatureObj OtherParsDefaults? ArgOrder?
OverloadDocValues InplaceDocValues ParamDesc? Lvalue?
OverloadDocValues InplaceDocValues ParamDesc? Lvalue? Overload NoExport?
)],
'generate "usage" section of doc',
sub {
my ($name, $doc, $sig, $otherdefaults, $argorder,
$overloadvals, $inplacevals, $paramdesc, $lvalue,
$overloadvals, $inplacevals, $paramdesc, $lvalue, $ovl, $noexport,
) = @_;
$otherdefaults ||= {};
$paramdesc ||= {};
Expand Down Expand Up @@ -1523,10 +1526,12 @@ EOF
push @argsets, [\@args, [], ['all arguments given']];
}
my @invocs = @$overloadvals;
my $op = defined($ovl) ? ref($ovl) ? $ovl->[0] : $ovl : '';
my $prefix = $noexport && $op ne $name ? "$::PDLOBJ\::" : "";
push @invocs, map [(!@{$_->[1]} ? '' :
@{$_->[1]} == 1 ? "\$$_->[1][0] = " :
"(".join(", ", map "\$$_", @{$_->[1]}).") = "
)."$name(".join(", ", map "\$$_", @{$_->[0]}).");",
)."$prefix$name(".join(", ", map "\$$_", @{$_->[0]}).");",
[@{$_->[2]}]], @argsets;
$argsets[0][2] = ['method call'];
$argsets[$_][2] = [] for 1..$#argsets; # they get the idea
Expand Down
16 changes: 16 additions & 0 deletions lib/PDL/PP.pod
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1872,6 +1872,22 @@ Implements overloading of Perl operators. Documented automatically.
Added in PDL 2.099. Will overload in the current C<pp_bless> package,
which defaults to C<PDL>.

=head3 NoExport

=over 4

=item NoExport => 1

=back

A function that is defined by C<pp_def> will be automatically added
to the module's export list.

By specifying a C<true> value for C<NoExport> this behaviour can be
suppressed.

Added in PDL 2.xxx.

=head3 ParamDesc

# in Primitive.pd
Expand Down

0 comments on commit bb6c311

Please sign in to comment.