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

This should allow foldr/build fusion

3 files changed, 29 insertions, 14 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
diff --git a/src/Data/Array/Nested/Ranked/Shape.hs b/src/Data/Array/Nested/Ranked/Shape.hs
index 2fea8c4..6d61bd5 100644
--- a/src/Data/Array/Nested/Ranked/Shape.hs
+++ b/src/Data/Array/Nested/Ranked/Shape.hs
@@ -36,7 +36,7 @@ import Data.Foldable qualified as Foldable
 import Data.Kind (Type)
 import Data.Proxy
 import Data.Type.Equality
-import GHC.Exts (Int(..), Int#, quotRemInt#)
+import GHC.Exts (Int(..), Int#, quotRemInt#, build)
 import GHC.Generics (Generic)
 import GHC.IsList (IsList)
 import GHC.IsList qualified as IsList
@@ -141,8 +141,11 @@ listrFromList topsn topl = go topsn topl
 
 {-# INLINEABLE listrToList #-}
 listrToList :: ListR n i -> [i]
-listrToList ZR = []
-listrToList (i ::: is) = i : listrToList is
+listrToList list = build (\(cons :: i -> is -> is) (nil :: is) ->
+  let go :: ListR n i -> is
+      go ZR = nil
+      go (i ::: is) = i `cons` go is
+  in go list)
 
 listrHead :: ListR (n + 1) i -> i
 listrHead (i ::: _) = i
diff --git a/src/Data/Array/Nested/Shaped/Shape.hs b/src/Data/Array/Nested/Shaped/Shape.hs
index 378f622..35c9d7a 100644
--- a/src/Data/Array/Nested/Shaped/Shape.hs
+++ b/src/Data/Array/Nested/Shaped/Shape.hs
@@ -38,7 +38,7 @@ import Data.Kind (Constraint, Type)
 import Data.Monoid (Sum(..))
 import Data.Proxy
 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
@@ -140,8 +140,11 @@ listsFromList topsh topl = go topsh topl
 
 {-# INLINEABLE listsToList #-}
 listsToList :: ListS sh (Const i) -> [i]
-listsToList ZS = []
-listsToList (Const i ::$ is) = i : listsToList is
+listsToList list = build (\(cons :: i -> is -> is) (nil :: is) ->
+  let go :: ListS sh (Const i) -> is
+      go ZS = nil
+      go (Const i ::$ is) = i `cons` go is
+  in go list)
 
 listsHead :: ListS (n : sh) f -> f n
 listsHead (i ::$ _) = i
@@ -372,8 +375,11 @@ shsFromList topsh topl = go topsh topl
 
 {-# INLINEABLE shsToList #-}
 shsToList :: ShS sh -> [Int]
-shsToList ZSS = []
-shsToList (sn :$$ sh) = fromSNat' sn : shsToList sh
+shsToList topsh = build (\(cons :: Int -> is -> is) (nil :: is) ->
+  let go :: ShS sh -> is
+      go ZSS = nil
+      go (sn :$$ sh) = fromSNat' sn `cons` go sh
+  in go topsh)
 
 shsHead :: ShS (n : sh) -> SNat n
 shsHead (ShS list) = listsHead list