ghc bug?

ghc bug?

-- put these two files in a directory and the compile with
-- ghc -fforce-recomp -O2 -prof -fprof-auto-calls Woo.hs

-- Vectorize.hs

{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE TypeOperators #-}

module Vectorize
       ( GVectorize(..)
       ) where

import GHC.Generics
import Data.Vector ( Vector )
import qualified Data.Vector as V

gvlength :: GVectorize f => f a -> Int
gvlength = V.length . gvectorize . (gempty `asFunctorOf`)
  where
    asFunctorOf :: f a -> f b -> f a
    asFunctorOf x _ = x

class GVectorize f where
  gdevectorize :: Vector a -> f a
  gvectorize :: f a -> Vector a
  gempty :: f ()

instance (GVectorize f, GVectorize g) => GVectorize (f :*: g) where
  gdevectorize v0s
    | V.length v0s < n0 =
      error $ show n0
    | otherwise = f0 :*: f1
    where
      f0 = gdevectorize v0
      f1 = gdevectorize v1

      n0 = gvlength f0

      (v0,v1) = V.splitAt n0 v0s

  gvectorize (f :*: g) = gvectorize f V.++ gvectorize g
  gempty = gempty :*: gempty

instance GVectorize f => GVectorize (M1 i c f) where
  gdevectorize = M1 . gdevectorize
  gvectorize = gvectorize . unM1
  gempty = undefined -- M1 gempty

instance GVectorize Par1 where
  gdevectorize _ = undefined
  gvectorize = V.singleton . unPar1
  gempty = undefined -- Par1 ()


--------------------------------------------------------------------------------------------
-- Woo.hs

{-# OPTIONS_GHC -Wall #-}
{-# Language DeriveGeneric #-}

module Woo
       ( Woo(..)
       , devectorize
       ) where

import GHC.Generics
import Data.Vector ( Vector )

import Vectorize ( GVectorize(..) )

data Woo a =
  MkWoo { x00 :: a
        , x01 :: a
        , x02 :: a
        , x03 :: a
        , x04 :: a
        , x05 :: a
        , x06 :: a
        , x07 :: a
        , x08 :: a
        , x09 :: a
        , x10 :: a
        , x11 :: a
        , x12 :: a
        , x13 :: a
        , x14 :: a
        , x15 :: a
        , x16 :: a
        , x17 :: a
        , x18 :: a
        , x19 :: a
        , x20 :: a
        , x21 :: a
        } deriving (Generic1)

devectorize :: Vector a -> Woo a
devectorize = to1 . gdevectorize