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

This should allow foldr/build fusion

1 files changed, 11 insertions, 5 deletions

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