Implement ListX as [] with strict pattern synonyms

1 files changed, 8 insertions, 17 deletions

diff --git a/src/Data/Array/Nested/Shaped/Shape.hs b/src/Data/Array/Nested/Shaped/Shape.hs
index 274f954..13596a7 100644
--- a/src/Data/Array/Nested/Shaped/Shape.hs
+++ b/src/Data/Array/Nested/Shaped/Shape.hs
@@ -26,6 +26,7 @@
 module Data.Array.Nested.Shaped.Shape where
 
 import Control.DeepSeq (NFData(..))
+import Control.Exception (assert)
 import Data.Array.Shape qualified as O
 import Data.Coerce (coerce)
 import Data.Foldable qualified as Foldable
@@ -37,6 +38,7 @@ import GHC.IsList (IsList)
 import GHC.IsList qualified as IsList
 import GHC.TypeLits
 
+import Data.Array.Nested.Mixed.ListX
 import Data.Array.Nested.Mixed.Shape
 import Data.Array.Nested.Permutation
 import Data.Array.Nested.Types
@@ -93,26 +95,15 @@ listsRank :: ListS sh i -> SNat (Rank sh)
 listsRank ZS = SNat
 listsRank (_ ::$ sh) = snatSucc (listsRank sh)
 
+{-# INLINE listsFromList #-}
 listsFromList :: ShS sh -> [i] -> ListS sh i
-listsFromList topsh topl = go topsh topl
-  where
-    go :: ShS sh' -> [i] -> ListS sh' i
-    go ZSS [] = ZS
-    go (_ :$$ sh) (i : is) = i ::$ go sh is
-    go _ _ = error $ "listsFromList: Mismatched list length (type says "
-                     ++ show (shsLength topsh) ++ ", list has length "
-                     ++ show (length topl) ++ ")"
+listsFromList sh l = assert (shsLength sh == length l)
+                     $ ListS $ IsList.fromList l
 
-{-# INLINEABLE listsFromListS #-}
+{-# INLINE listsFromListS #-}
 listsFromListS :: ListS sh i0 -> [i] -> ListS sh i
-listsFromListS topl0 topl = go topl0 topl
-  where
-    go :: ListS sh i0 -> [i] -> ListS sh i
-    go ZS [] = ZS
-    go (_ ::$ l0) (i : is) = i ::$ go l0 is
-    go _ _ = error $ "listsFromListS: Mismatched list length (the model says "
-                       ++ show (length topl0) ++ ", list has length "
-                       ++ show (length topl) ++ ")"
+listsFromListS sh l = assert (length sh == length l)
+                      $ ListS $ IsList.fromList l
 
 listsHead :: ListS (n : sh) i -> i
 listsHead (i ::$ _) = i