Define {list,sh,ix}*ToList functions using 'build'

This should allow foldr/build fusion

1 files changed, 12 insertions, 6 deletions

diff --git a/src/Data/Array/Nested/Mixed/Shape.hs b/src/Data/Array/Nested/Mixed/Shape.hs
index 900d045..c999853 100644
--- a/src/Data/Array/Nested/Mixed/Shape.hs
+++ b/src/Data/Array/Nested/Mixed/Shape.hs
@@ -36,7 +36,7 @@ import Data.Functor.Product
 import Data.Kind (Constraint, Type)
 import Data.Monoid (Sum(..))
 import Data.Type.Equality
-import GHC.Exts (Int(..), Int#, quotRemInt#, withDict)
+import GHC.Exts (Int(..), Int#, quotRemInt#, withDict, build)
 import GHC.Generics (Generic)
 import GHC.IsList (IsList)
 import GHC.IsList qualified as IsList
@@ -143,9 +143,12 @@ listxFromList topssh topl = go topssh topl
                        ++ show (length topl) ++ ")"
 
 {-# INLINEABLE listxToList #-}
-listxToList :: ListX sh' (Const i) -> [i]
-listxToList ZX = []
-listxToList (Const i ::% is) = i : listxToList is
+listxToList :: ListX sh (Const i) -> [i]
+listxToList list = build (\(cons :: i -> is -> is) (nil :: is) ->
+  let go :: ListX sh (Const i) -> is
+      go ZX = nil
+      go (Const i ::% is) = i `cons` go is
+  in go list)
 
 listxHead :: ListX (mn ': sh) f -> f mn
 listxHead (i ::% _) = i
@@ -424,8 +427,11 @@ shxFromList topssh topl = go topssh topl
 
 {-# INLINEABLE shxToList #-}
 shxToList :: IShX sh -> [Int]
-shxToList ZSX = []
-shxToList (smn :$% sh) = fromSMayNat' smn : shxToList sh
+shxToList list = build (\(cons :: i -> is -> is) (nil :: is) ->
+  let go :: IShX sh -> is
+      go ZSX = nil
+      go (smn :$% sh) = fromSMayNat' smn `cons` go sh
+  in go list)
 
 shxFromSSX :: StaticShX (MapJust sh) -> ShX (MapJust sh) i
 shxFromSSX ZKX = ZSX