generate_core_flags also set-only

PDLPorters · Jan 20, 2024 · 25ab8e2 · 25ab8e2
1 parent cae0d81
commit 25ab8e2
Show file tree

Hide file tree

Showing 2 changed files with 15 additions and 25 deletions.
diff --git a/Basic/Core/Core.xs b/Basic/Core/Core.xs
@@ -78,13 +78,6 @@ trans_children(self)
 
 INCLUDE_COMMAND: $^X -e "require q{./Dev.pm}; PDL::Core::Dev::generate_core_flags()"
 
-void
-set_inplace(self,val)
-  pdl *self;
-  int val;
-  CODE:
-    setflag(self->state,PDL_INPLACE,val);
-
 IV
 address(self)
   pdl *self;
@@ -661,16 +654,6 @@ upd_data(self, keep_datasv=0)
 	}
 	PDLDEBUG_f(printf("upd_data end: "); pdl_dump(self));
 
-void
-set_dataflow_f(self,value)
-	pdl *self;
-	int value;
-	CODE:
-	if(value)
-		self->state |= PDL_DATAFLOW_F;
-	else
-		self->state &= ~PDL_DATAFLOW_F;
-
 int
 badflag(x,newval=0)
     pdl *x

diff --git a/Basic/Core/Dev.pm b/Basic/Core/Dev.pm
@@ -482,9 +482,11 @@ prints on C<STDOUT> XS text with core flags, for F<Core.xs>.
 
 my %flags = (
     hdrcpy => { set => 1 },
+    set_dataflow_f => { FLAG => "DATAFLOW_F", noret => 1 },
     fflows => { FLAG => "DATAFLOW_F" },
     bflows => { FLAG => "DATAFLOW_B" },
     is_inplace => { FLAG => "INPLACE", postset => 1 },
+    set_inplace => { FLAG => "INPLACE", noret => 1 },
     donttouch => { FLAG => "DONTTOUCHDATA" },
     allocated => { },
     vaffine => { FLAG => "OPT_VAFFTRANSOK" },
@@ -499,19 +501,24 @@ sub generate_core_flags {
     # to ndarray's state
     foreach my $name ( sort keys %flags ) {
         my $flag = "PDL_" . ($flags{$name}{FLAG} || uc($name));
-        my $with_mode = $flags{$name}{set} || $flags{$name}{postset};
-        printf <<'EOF', $name, $with_mode ? (",mode=0", "\n        int mode") : ('', '');
-int
+        my $ref = $flags{$name};
+        my $with_mode = grep $ref->{$_}, qw(set postset noret);
+        my $mode_dflt = (grep $ref->{$_}, qw(set postset)) ? "=0" : "";
+        my @mode = $with_mode ? (",mode$mode_dflt", "\n        int mode") : ('', '');
+        printf <<'EOF', $ref->{noret} ? 'void' : 'int', $name, @mode;
+%s
 %s(x%s)
         pdl *x%s
         CODE:
 EOF
-        my $set = "        if (items>1) setflag(x->state,$flag,mode);\n";
+        my $cond = $ref->{noret} ? "" : "if (items>1) ";
+        my $set = "        ${cond}setflag(x->state,$flag,mode);\n";
         my $ret = "        RETVAL = ((x->state & $flag) > 0);\n";
-        print $set if $flags{$name}{set};
-        print $ret;
-        print $set if $flags{$name}{postset};
-        print "        OUTPUT:\n        RETVAL\n\n";
+        print $set if $ref->{set} || $ref->{noret};
+        print $ret if !$ref->{noret};
+        print $set if $ref->{postset};
+        print "        OUTPUT:\n        RETVAL\n" if !$ref->{noret};
+        print "\n";
     } # foreach: keys %flags
 }