aboutsummaryrefslogtreecommitdiff
path: root/src/Data/Array/Nested/Mixed/Shape.hs
diff options
context:
space:
mode:
authorMikolaj Konarski <mikolaj.konarski@funktory.com>2025-12-01 18:35:58 +0100
committerMikolaj Konarski <mikolaj.konarski@funktory.com>2025-12-01 18:35:58 +0100
commit45c429917c95713b339cc4d9210a842546e72a0d (patch)
treec6f540f1478390c0874f4b566de480593db17e9b /src/Data/Array/Nested/Mixed/Shape.hs
parent9faf7fb877119bd52d664940c4326d326b3326fa (diff)
Unify fromList functions for shapes
Diffstat (limited to 'src/Data/Array/Nested/Mixed/Shape.hs')
-rw-r--r--src/Data/Array/Nested/Mixed/Shape.hs34
1 files changed, 14 insertions, 20 deletions
diff --git a/src/Data/Array/Nested/Mixed/Shape.hs b/src/Data/Array/Nested/Mixed/Shape.hs
index 4626481..066ae8e 100644
--- a/src/Data/Array/Nested/Mixed/Shape.hs
+++ b/src/Data/Array/Nested/Mixed/Shape.hs
@@ -131,14 +131,11 @@ listxShow f l = showString "[" . go "" l . showString "]"
go prefix (x ::% xs) = showString prefix . f x . go "," xs
listxFromList :: StaticShX sh -> [i] -> ListX sh (Const i)
-listxFromList topssh topl = go topssh topl
- where
- go :: StaticShX sh' -> [i] -> ListX sh' (Const i)
- go ZKX [] = ZX
- go (_ :!% sh) (i : is) = Const i ::% go sh is
- go _ _ = error $ "listxFromList: Mismatched list length (type says "
- ++ show (ssxLength topssh) ++ ", list has length "
- ++ show (length topl) ++ ")"
+listxFromList ZKX [] = ZX
+listxFromList (_ :!% sh) (i : is) = Const i ::% listxFromList sh is
+listxFromList sh l = error $ "listxFromList: Mismatched list length (type says "
+ ++ show (ssxLength sh) ++ ", list has length "
+ ++ show (length l) ++ ")"
{-# INLINEABLE listxToList #-}
listxToList :: ListX sh' (Const i) -> [i]
@@ -432,18 +429,15 @@ shxSize ZSX = 1
shxSize (n :$% sh) = fromSMayNat' n * shxSize sh
shxFromList :: StaticShX sh -> [Int] -> IShX sh
-shxFromList topssh topl = go topssh topl
- where
- go :: StaticShX sh' -> [Int] -> IShX sh'
- go ZKX [] = ZSX
- go (SKnown sn :!% sh) (i : is)
- | i == fromSNat' sn = SKnown sn :$% go sh is
- | otherwise = error $ "shxFromList: Value does not match typing (type says "
- ++ show (fromSNat' sn) ++ ", list contains " ++ show i ++ ")"
- go (SUnknown () :!% sh) (i : is) = SUnknown i :$% go sh is
- go _ _ = error $ "shxFromList: Mismatched list length (type says "
- ++ show (ssxLength topssh) ++ ", list has length "
- ++ show (length topl) ++ ")"
+shxFromList ZKX [] = ZSX
+shxFromList (SKnown sn :!% sh) (i : is)
+ | i == fromSNat' sn = SKnown sn :$% shxFromList sh is
+ | otherwise = error $ "shxFromList: Value does not match typing (type says "
+ ++ show (fromSNat' sn) ++ ", list contains " ++ show i ++ ")"
+shxFromList (SUnknown () :!% sh) (i : is) = SUnknown i :$% shxFromList sh is
+shxFromList sh l = error $ "shxFromList: Mismatched list length (type says "
+ ++ show (ssxLength sh) ++ ", list has length "
+ ++ show (length l) ++ ")"
{-# INLINEABLE shxToList #-}
shxToList :: IShX sh -> [Int]