Implement Tom's ixsFromIxS

that really helps in processing indexes using list functions
and getting back to the same type of index now that KnownNat
is removed from IxS and so the type information is harder to preserve.

1 files changed, 15 insertions, 0 deletions

diff --git a/src/Data/Array/Nested/Shaped/Shape.hs b/src/Data/Array/Nested/Shaped/Shape.hs
index 0644953..0c042b7 100644
--- a/src/Data/Array/Nested/Shaped/Shape.hs
+++ b/src/Data/Array/Nested/Shaped/Shape.hs
@@ -138,6 +138,17 @@ listsFromList topsh topl = go topsh topl
                      ++ show (shsLength topsh) ++ ", list has length "
                      ++ show (length topl) ++ ")"
 
+{-# INLINEABLE listsFromListS #-}
+listsFromListS :: ListS sh (Const i0) -> [i] -> ListS sh (Const i)
+listsFromListS topl0 topl = go topl0 topl
+  where
+    go :: ListS sh (Const i0) -> [i] -> ListS sh (Const i)
+    go ZS [] = ZS
+    go (_ ::$ l0) (i : is) = Const i ::$ go l0 is
+    go _ _ = error $ "listsFromListS: Mismatched list length (the model says "
+                       ++ show (listsLength topl0) ++ ", list has length "
+                       ++ show (length topl) ++ ")"
+
 {-# INLINEABLE listsToList #-}
 listsToList :: ListS sh (Const i) -> [i]
 listsToList list = build (\(cons :: i -> is -> is) (nil :: is) ->
@@ -260,6 +271,10 @@ ixsRank (IxS l) = listsRank l
 ixsFromList :: forall sh i. ShS sh -> [i] -> IxS sh i
 ixsFromList = coerce (listsFromList @_ @i)
 
+{-# INLINEABLE ixsFromIxS #-}
+ixsFromIxS :: forall sh i0 i. IxS sh i0 -> [i] -> IxS sh i
+ixsFromIxS = coerce (listsFromListS @_ @i0 @i)
+
 {-# INLINEABLE ixsToList #-}
 ixsToList :: forall sh i. IxS sh i -> [i]
 ixsToList = coerce (listsToList @_ @i)