From 7bea3f5b18f4fe8b371ffaeb8671c37b97119731 Mon Sep 17 00:00:00 2001
From: Ed J <mohawk2@users.noreply.github.com>
Date: Fri, 13 Sep 2024 20:24:25 +0100
Subject: [PATCH] make C version of dog for ~5% speedup - #421

---
 Basic/Core/Core.pm  | 10 ----------
 Basic/Core/Core.xs  | 27 +++++++++++++++++++++++++++
 Basic/Core/pdlapi.c |  1 +
 3 files changed, 28 insertions(+), 10 deletions(-)

diff --git a/Basic/Core/Core.pm b/Basic/Core/Core.pm
index 39ee82aa1..d8e748589 100644
--- a/Basic/Core/Core.pm
+++ b/Basic/Core/Core.pm
@@ -3642,16 +3642,6 @@ The output ndarrays are set bad if the original ndarray has its bad flag set.
 
 =cut
 
-sub PDL::dog {
-  my $opt = ref($_[-1]) eq 'HASH' ? pop @_ : {};
-  my $p = shift;
-  barf "Usage: \$pdl->dog([\\%opt])" if @_;
-  barf "dog: must have at least one dim" if !$p->ndims;
-  my $s = ":,"x($p->getndims-1);
-  my @res = map $p->slice($s."(".$_.")"), 0..$p->dim(-1)-1;
-  $$opt{Break} ? map $_->copy, @res : @res
-}
-
 ###################### Misc internal routines ####################
 
 # N-D array stringifier
diff --git a/Basic/Core/Core.xs b/Basic/Core/Core.xs
index 82b7cb7c5..bb9cefce3 100644
--- a/Basic/Core/Core.xs
+++ b/Basic/Core/Core.xs
@@ -1269,6 +1269,33 @@ CODE:
 OUTPUT:
   RETVAL
 
+void
+dog(x, opt=sv_2mortal(newRV_noinc((SV *)newHV())))
+  pdl *x
+  SV *opt
+PPCODE:
+  HV *opt_hv = NULL;
+  if (!(SvROK(opt) && SvTYPE(opt_hv = (HV*)SvRV(opt)) == SVt_PVHV))
+    barf("Usage: $pdl->dog([\\%%opt])");
+  pdl_barf_if_error(pdl_make_physdims(x));
+  if (x->ndims <= 0) barf("dog: must have at least one dim");
+  SV **svp = hv_fetchs(opt_hv, "Break", 0);
+  char dobreak = (svp && *svp && SvOK(*svp));
+  PDL_Indx *thesedims = x->dims, *theseincs = PDL_REPRINCS(x), ndimsm1 = x->ndims-1;
+  PDL_Indx i, howmany = x->dims[ndimsm1], thisoffs = 0, topinc = x->dimincs[ndimsm1];
+  EXTEND(SP, howmany);
+  for (i = 0; i < howmany; i++, thisoffs += topinc) {
+    pdl *childpdl = pdl_pdlnew();
+    if (!childpdl) pdl_pdl_barf("Error making null pdl");
+    pdl_barf_if_error(pdl_affine_new(x,childpdl,thisoffs,
+      thesedims,ndimsm1,theseincs,ndimsm1));
+    SV *childsv = sv_newmortal();
+    pdl_SetSV_PDL(childsv, childpdl); /* do before sever so .sv true */
+    if (dobreak) pdl_barf_if_error(pdl_sever(childpdl));
+    PUSHs(childsv);
+  }
+  XSRETURN(howmany);
+
 void
 broadcastover_n(code, pdl1, ...)
     SV *code;
diff --git a/Basic/Core/pdlapi.c b/Basic/Core/pdlapi.c
index 6ecc4802a..27a8aa77b 100644
--- a/Basic/Core/pdlapi.c
+++ b/Basic/Core/pdlapi.c
@@ -964,6 +964,7 @@ pdl_error pdl_set_datatype(pdl *a, int datatype)
     return PDL_err;
 }
 
+/* do SetSV_PDL first, else .sv will be false and destroytransform will destroy src */
 pdl_error pdl_sever(pdl *src)
 {
     pdl_error PDL_err = {0, NULL, 0};