generalise defaults that are dimtypes or vectors

PDLPorters · Mar 23, 2023 · d8a94bd · d8a94bd
1 parent a7bdeaa
commit d8a94bd
Show file tree

Hide file tree

Showing 3 changed files with 12 additions and 12 deletions.
diff --git a/genpp.pl b/genpp.pl
@@ -9,6 +9,10 @@
 our $INT_PDLTYPE = $Config{intsize} == 4 ? 'int' :
   $Config{intsize} == 8 ? 'longlong' :
   die "Unknown intsize $Config{intsize}";
+our %REALCTYPE2PDLTYPE = (
+  int => PDL::Type->new($INT_PDLTYPE),
+  map +($_->realctype=>$_), PDL::Types::types
+);
 my $T = [qw(A B S U L F D)];
 our %type_overrides = (
   String => ['StringWrapper*', 'StringWrapper*'], # PP, C
@@ -28,13 +32,8 @@
   'vector_Mat()' => ['undef',],
   'Mat()' => ['PDL->zeroes(sbyte,0,0,0)',],
   'cv::Mat()' => ['PDL->zeroes(sbyte,0,0,0)',],
-  'Point()' => ['empty(sbyte)',],
   'Ptr<float>()' => ['empty(float)','0'],
-  'std::vector<int>()' => ['empty(long)',],
-  'std::vector<Point>()' => ['empty(indx)',],
   'Scalar::all(0)' => ['[0,0,0,0]',],
-  'Size()' => ['empty(sbyte)',],
-  'Size(8, 8)' => ['indx(8,8)',],
   'String()' => ['undef',],
   false => [0,0], # perl, C
   true => [1,1],
@@ -55,6 +54,7 @@ package PP::OpenCV;
   Vec4f=>[map ['float', "v$_", "val[$_]"], 0..3],
   Vec6f=>[map ['float', "v$_", "val[$_]"], 0..5],
 );
+my $dimtypes_re = join '|', sort keys %DIMTYPES; $dimtypes_re = qr/$dimtypes_re/;
 our %CTYPE2PDL = map +($_->realctype => $_->ppforcetype), PDL::Types::types();
 our %FLAG2KEY = ('/IO' => 'is_io', '/O' => 'is_output');
 sub new {
@@ -203,6 +203,9 @@ sub default_pl {
   if ($default_overrides{$d}) {
     $d = $default_overrides{$d}[0];
   }
+  $d =~ s/^std::vector<($dimtypes_re|int)>\(\)$/"empty($REALCTYPE2PDLTYPE{$DIMTYPES{$1} ? $DIMTYPES{$1}[0][0] : $1})"/e;
+  $d =~ s/^($dimtypes_re)\(\)$/"empty($REALCTYPE2PDLTYPE{$DIMTYPES{$1}[0][0]})"/e;
+  $d =~ s/^($dimtypes_re)(\(.*\))$/$REALCTYPE2PDLTYPE{$DIMTYPES{$1}[0][0]}.$2/e;
   $d =~ s/([A-Za-z0-9_:]+::[A-Za-z_][A-Za-z0-9_]+)/PDL::OpenCV::$1()/g;
   length $d ? "\$$self->{name} = $d if !defined \$$self->{name};" : ();
 }

diff --git a/genwrap.pl b/genwrap.pl
@@ -7,13 +7,9 @@
 use Config;
 
 require ''. catfile $Bin, 'genpp.pl';
-our (%type_overrides, %type_alias, %STAYWRAPPED, $INT_PDLTYPE);
+our (%type_overrides, %type_alias, %STAYWRAPPED, $INT_PDLTYPE, %REALCTYPE2PDLTYPE);
 my %GLOBALTYPES = do { no warnings 'once'; (%PP::OpenCV::DIMTYPES, map +($_=>[]), keys %STAYWRAPPED) };
 my @PDLTYPES_SUPPORTED = grep $_->real && $_->ppsym !~/[KPQN]/ && howbig($_) <= 8, PDL::Types::types;
-my %REALCTYPE2NUMVAL = (
-  int => PDL::Type->new($INT_PDLTYPE)->numval,
-  map +($_->realctype=>$_->numval), PDL::Types::types
-);
 my %VECTORTYPES = (%GLOBALTYPES, map +($_=>[]), qw(int float double uchar));
 my $wrap_re = qr/^(?:(?!String)[A-Z]|vector_)/;
 my %extra_cons_args = (
@@ -204,8 +200,8 @@ sub gen_wrapper {
   my $cstr = <<EOF;
 $tdecls_all{dim0} { return @{[0+@fields]}; }
 $tdecls_all{pdlt} { return @{[
-  @fields ? $REALCTYPE2NUMVAL{$fields[0][0]} // die "Unknown ctype '$fields[0][0]' for '$class'" :
-  $REALCTYPE2NUMVAL{$type_overrides{$class} ? $type_overrides{$class}[1] : $class} // '-1'
+  @fields ? eval {$REALCTYPE2PDLTYPE{$fields[0][0]}->numval} // die "Unknown ctype '$fields[0][0]' for '$class'" :
+  eval {$REALCTYPE2PDLTYPE{$type_overrides{$class} ? $type_overrides{$class}[1] : $class}->numval} // '-1'
 ]}; }
 EOF
   if ($is_vector || defined $cons_func) {

diff --git a/t/opencv_basic.t b/t/opencv_basic.t
@@ -22,6 +22,7 @@ isa_ok my $pic = imread('t/qrcode.png'), 'PDL', 'imread';
 my $pic2 = $pic->glue(1,$pic);
 is hconcat([$pic, $pic2])->dim(1), $pic->dim(1)*3, 'hconcat array-ref worked';
 is +(sumElems($data))[0]->sumover, 4560, 'sumElems';
+isa_ok +PDL::OpenCV::CLAHE->new, 'PDL::OpenCV::CLAHE', 'Size default OK';
 
 {
 my $a = pdl float, q[[1 1] [1 2] [0 3] [0 4] [1 5]];