Add option 'NoExport' to pp_def

jo-37 · jo-37 · commit bb6c31116545 · 2025-02-18T14:37:48.000+01:00
diff --git a/lib/PDL/Ops.pd b/lib/PDL/Ops.pd
@@ -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',
@@ -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 %{
@@ -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,
@@ -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 %{
@@ -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
@@ -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
@@ -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');
 
@@ -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
@@ -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) = @_;
@@ -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
@@ -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()',
diff --git a/lib/PDL/PP.pm b/lib/PDL/PP.pm
@@ -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};
@@ -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;
@@ -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"];
@@ -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;
@@ -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"]
@@ -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 ||= {};
@@ -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
diff --git a/lib/PDL/PP.pod b/lib/PDL/PP.pod
@@ -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
