Make ShR a newtype over ShX

2 files changed, 21 insertions, 23 deletions

diff --git a/test/Gen.hs b/test/Gen.hs
index 952e8db..789a59c 100644
--- a/test/Gen.hs
+++ b/test/Gen.hs
@@ -11,7 +11,6 @@
 module Gen where
 
 import Data.ByteString qualified as BS
-import Data.Foldable (toList)
 import Data.Type.Equality
 import Data.Type.Ord
 import Data.Vector.Storable qualified as VS
@@ -46,7 +45,7 @@ genLowBiased (lo, hi) = do
   return (lo + x * x * x * (hi - lo))
 
 shuffleShR :: IShR n -> Gen (IShR n)
-shuffleShR = \sh -> go (length sh) (toList sh) sh
+shuffleShR = \sh -> go (shrLength sh) (shrToList sh) sh
   where
     go :: Int -> [Int] -> IShR n -> Gen (IShR n)
     go _    _   ZSR = return ZSR
@@ -78,7 +77,7 @@ genShRwithTarget targetMax sn = do
         dims <- genDims m (if dim == 0 then 0 else tgt `div` dim)
         return (dim :$: dims)
   dims <- genDims sn targetSize
-  let maxdim = maximum dims
+  let maxdim = maximum $ shrToList dims
       cap = binarySearch (`div` 2) 1 maxdim (\cap' -> shrSize (min cap' <$> dims) <= targetSize)
   shuffleShR (min cap <$> dims)
 
diff --git a/test/Tests/C.hs b/test/Tests/C.hs
index 0656107..8703957 100644
--- a/test/Tests/C.hs
+++ b/test/Tests/C.hs
@@ -15,7 +15,6 @@ module Tests.C where
 
 import Control.Monad
 import Data.Array.RankedS qualified as OR
-import Data.Foldable (toList)
 import Data.Functor.Const
 import Data.Type.Equality
 import Foreign
@@ -50,10 +49,10 @@ prop_sum_nonempty = property $ genRank $ \outrank@(SNat @n) -> do
   -- Test nonempty _results_. The first dimension of the input is allowed to be 0, because then OR.rerank doesn't fail yet.
   let inrank = SNat @(n + 1)
   sh <- forAll $ genShR inrank
-  -- traceM ("sh: " ++ show sh ++ " -> " ++ show (product sh))
-  guard (all (> 0) (shrTail sh))  -- only constrain the tail
-  arr <- forAllT $ OR.fromVector @Double @(n + 1) (toList sh) <$>
-           genStorables (Range.singleton (product sh))
+  -- traceM ("sh: " ++ show sh ++ " -> " ++ show (shrSize sh))
+  guard (all (> 0) (shrToList $ shrTail sh))  -- only constrain the tail
+  arr <- forAllT $ OR.fromVector @Double @(n + 1) (shrToList sh) <$>
+           genStorables (Range.singleton (shrSize sh))
                         (\w -> fromIntegral w / fromIntegral (maxBound :: Word64))
   let rarr = rfromOrthotope inrank arr
   almostEq fineTol (rtoOrthotope (rsumOuter1Prim rarr)) (orSumOuter1 outrank arr)
@@ -68,9 +67,9 @@ prop_sum_empty = property $ genRank $ \outrankm1@(SNat @nm1) -> do
     sht <- shuffleShR (0 :$: shtt)  -- n
     n <- Gen.int (Range.linear 0 20)
     return (n :$: sht)  -- n + 1
-  guard (0 `elem` shrTail sh)
-  -- traceM ("sh: " ++ show sh ++ " -> " ++ show (product sh))
-  let arr = OR.fromList @(n + 1) @Double (toList sh) []
+  guard (0 `elem` (shrToList $ shrTail sh))
+  -- traceM ("sh: " ++ show sh ++ " -> " ++ show (shrSize sh))
+  let arr = OR.fromList @(n + 1) @Double (shrToList sh) []
   let rarr = rfromOrthotope inrank arr
   OR.toList (rtoOrthotope (rsumOuter1Prim rarr)) === []
 
@@ -78,10 +77,10 @@ prop_sum_lasteq1 :: Property
 prop_sum_lasteq1 = property $ genRank $ \outrank@(SNat @n) -> do
   let inrank = SNat @(n + 1)
   outsh <- forAll $ genShR outrank
-  guard (all (> 0) outsh)
+  guard (all (> 0) $ shrToList outsh)
   let insh = shrAppend outsh (1 :$: ZSR)
-  arr <- forAllT $ OR.fromVector @Double @(n + 1) (toList insh) <$>
-           genStorables (Range.singleton (product insh))
+  arr <- forAllT $ OR.fromVector @Double @(n + 1) (shrToList insh) <$>
+           genStorables (Range.singleton (shrSize insh))
                         (\w -> fromIntegral w / fromIntegral (maxBound :: Word64))
   let rarr = rfromOrthotope inrank arr
   almostEq fineTol (rtoOrthotope (rsumOuter1Prim rarr)) (orSumOuter1 outrank arr)
@@ -99,12 +98,12 @@ prop_sum_replicated doTranspose = property $
       label (LabelName ("rankdiff " ++ show (fromSNat' inrank2 - fromSNat' inrank1)))
       label (LabelName ("size sh1 10^" ++ show (floor (logBase 10 (fromIntegral (shrSize sh1) :: Double)) :: Int)))
       label (LabelName ("size sh3 10^" ++ show (floor (logBase 10 (fromIntegral (shrSize sh3) :: Double)) :: Int)))
-    guard (all (> 0) sh3)
+    guard (all (> 0) $ shrToList sh3)
     arr <- forAllT $
-      OR.stretch (toList sh3)
-      . OR.reshape (toList sh2)
-      . OR.fromVector @Double @m (toList sh1) <$>
-               genStorables (Range.singleton (product sh1))
+      OR.stretch (shrToList sh3)
+      . OR.reshape (shrToList sh2)
+      . OR.fromVector @Double @m (shrToList sh1) <$>
+               genStorables (Range.singleton (shrSize sh1))
                             (\w -> fromIntegral w / fromIntegral (maxBound :: Word64))
     arrTrans <-
       if doTranspose then do perm <- forAll $ genPermR (fromSNat' inrank2)
@@ -121,9 +120,9 @@ prop_negate_with :: forall f b. Show b
 prop_negate_with genRank' genB preproc = property $
   genRank' $ \extra rank@(SNat @n) -> do
     sh <- forAll $ genShR rank
-    guard (all (> 0) sh)
-    arr <- forAllT $ OR.fromVector @Double @n (toList sh) <$>
-             genStorables (Range.singleton (product sh))
+    guard (all (> 0) $ shrToList sh)
+    arr <- forAllT $ OR.fromVector @Double @n (shrToList sh) <$>
+             genStorables (Range.singleton (shrSize sh))
                           (\w -> fromIntegral w / fromIntegral (maxBound :: Word64))
     bval <- forAll $ genB extra sh
     let arr' = preproc extra bval arr
@@ -156,7 +155,7 @@ tests = testGroup "C"
         (\_ sh -> do let genPair n = do lo <- Gen.integral (Range.constant 0 (n-1))
                                         len <- Gen.integral (Range.constant 0 (n-lo-1))
                                         return (lo, len)
-                     pairs <- mapM genPair (toList sh)
+                     pairs <- mapM genPair (shrToList sh)
                      return pairs)
         (\_ -> OR.slice)
     ]