[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