[Haskell-cafe] a sort of chunk
PICCA Frederic-Emmanuel
frederic-emmanuel.picca at synchrotron-soleil.fr
Mon Jan 20 10:03:16 UTC 2020
Hello victor
I decided to use your solution, since I find it more elegant than mine :))
data Chunk n a = Chunk !a !n !n
deriving instance (Show n, Show a) => Show (Chunk n a)
cweight :: Num n => Chunk n a -> n
cweight (Chunk _ l h) = h - l
csplit :: Num n => Chunk n a -> n -> (Chunk n a, Chunk n a)
csplit (Chunk a l h) n = ( (Chunk a l (l + n)), (Chunk a (l+n) h) )
chunk :: (Num n, Ord n) => n -> [Chunk n a] -> [[Chunk n a]]
chunk target = go target target
where
go _ _ [] = []
go tgt gap [x] = golast tgt gap x
go tgt gap ~(x:xs) =
let gap' = gap - cweight x
in if | gap' > 0 -> cons1 x $ go tgt gap' xs
| gap' == 0 -> [x] : go tgt tgt xs
| (x1, x2) <- csplit x gap -> [x1] : go tgt tgt (x2 : xs)
cons1 !x ~(c:cs) = (x : c) : cs
golast tgt gap x =
if | cweight x <= gap -> [x] : []
| (x1, x2) <- csplit x gap -> [x1] : golast tgt tgt x2
{-# SPECIALIZE chunk :: Int -> [Chunk Int FilePath] -> [[Chunk Int FilePath]] #-}
But when compiling I have these warning
> src/Hkl/Projects/Sixs.hs:(59,5)-(65,69): warning: [-Wincomplete-uni-patterns]
> Pattern match(es) are non-exhaustive
> In a pattern binding: Patterns not matched: []
> |
> 59 | go _ _ [] = []
> | ^^^^^^^^^^^^^^^^^^^^^^^...
I do not understand this one
> src/Hkl/Projects/Sixs.hs:67:5-35: warning: [-Wincomplete-uni-patterns]
> Pattern match(es) are non-exhaustive
> In a pattern binding: Patterns not matched: []
> |
> 67 | cons1 !x ~(c:cs) = (x : c) : cs
> | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
If this is something which can not be reach, is it possible to explain to ghc how to avoid these warning ?
cheers
Fred
More information about the Haskell-Cafe
mailing list