GHC misses optimization opportunity

Consider this code:

{-# LANGUAGE TypeFamilies            #-}
{-# LANGUAGE MultiParamTypeClasses   #-}
{-# LANGUAGE TypeOperators           #-}
{-# LANGUAGE FlexibleInstances       #-}
{-# LANGUAGE FlexibleContexts        #-}
{-# LANGUAGE ScopedTypeVariables     #-}
{-# LANGUAGE UndecidableInstances    #-}
{-# LANGUAGE TypeApplications        #-}
{-# LANGUAGE TypeInType              #-}
{-# LANGUAGE AllowAmbiguousTypes     #-}

module Unzip where

import Prelude hiding (unzip)
import GHC.TypeLits
import Data.Kind

-- | Data family of unboxed vectors.
class IsVector (n :: Nat) e where
    data Vector n e :: Type

    fromList :: [e] -> Vector n e

-- | Unrolled unzip. Type param @n@ is the length of the input list.
class Unzip (n :: Nat) where
    unzip :: [(a, b)] -> ([a], [b])

instance {-# OVERLAPPING #-} Unzip 0 where
    unzip _ = ([], [])
    {-# INLINE unzip #-}

instance {-# OVERLAPPABLE #-} (Unzip (n - 1)) => Unzip n where
    unzip []       = error "Not enough elements."
    unzip (x : xs) = (\(a, b) (as, bs) -> (a : as, b : bs)) x (unzip @(n - 1) xs)
    {-# INLINE unzip #-} 

-- | Make pair of vectors from list of pairs of vector's elements.
unzipVec :: forall (n :: Nat) e. (IsVector n e, Unzip n) => [(e, e)] -> (Vector n e, Vector n e)
unzipVec ps =
    let (es1, es2) = unzip @n ps
    in (fromList es1, fromList es2)
{-# INLINE unzipVec #-} 

--------------------------------
instance IsVector 2 Float where
    data Vector 2 Float = Vector2f {-# UNPACK #-} !Float {-# UNPACK #-} !Float

    fromList [a, b] = Vector2f a b
    fromList []     = error "Not enough elements."

unzipVecSpecialized :: [(Float, Float)] -> (Vector 2 Float, Vector 2 Float)
unzipVecSpecialized = unzipVec

GHC-8.2.1 generates the following Core for unzipVecSpecialized function:

-- RHS size: {terms: 84, types: 113, coercions: 4, joins: 0/1}
unzipVecSpecialized
  :: [(Float, Float)] -> (Vector 2 Float, Vector 2 Float)
unzipVecSpecialized
  = \ (eta :: [(Float, Float)]) ->
      let {
        ds :: ([Float], [Float])
        ds
          = case eta of {
              [] -> lvl20;
              : x xs ->
                case x of { (a, b) ->
                case xs of {
                  [] -> lvl20;
                  : x1 xs1 ->
                    case x1 of { (a1, b1) ->
                    (: @ Float a (: @ Float a1 ([] @ Float)),
                     : @ Float b (: @ Float b1 ([] @ Float)))
                    }
                }
                }
            } } in
      (case ds of { (es1, es2) ->
       case es1 of {
         [] -> $fIsVector2Float1;
         : a ds1 ->
           case ds1 of {
             [] -> $fIsVector2Float1;
             : b ds2 ->
               case ds2 of {
                 [] ->
                   case a of { F# dt1 ->
                   case b of { F# dt3 -> (Vector2f dt1 dt3) `cast` <Co:2> }
                   };
                 : ipv ipv1 -> $fIsVector2Float1
               }
           }
       }
       },
       case ds of { (es1, es2) ->
       case es2 of {
         [] -> $fIsVector2Float1;
         : a ds1 ->
           case ds1 of {
             [] -> $fIsVector2Float1;
             : b ds2 ->
               case ds2 of {
                 [] ->
                   case a of { F# dt1 ->
                   case b of { F# dt3 -> (Vector2f dt1 dt3) `cast` <Co:2> }
                   };
                 : ipv ipv1 -> $fIsVector2Float1
               }
           }
       }
       })

Notice how it constructs tuple of lists ds :: ([Float], [Float]) and then deconstructs it twice. I would expect the compiler to get rid of intermediate tuple and lists, so the Core would look like this:

unzipVecSpecialized
  :: [(Float, Float)] -> (Vector 2 Float, Vector 2 Float)
unzipVecSpecialized
  = \ (eta :: [(Float, Float)]) ->
    case eta of {
        [] -> lvl20;
        : x xs ->
            case x of { (a, b) ->
            case xs of {
                [] -> lvl20;
                : x1 xs1 ->
                    case x1 of { (a1, b1) ->
                        (case a of { F# dt1 ->
                         case a1 of { F# dt2 -> (Vector2f dt1 dt2) }},
                         case b of { F# dt3 ->
                         case b1 of { F# dt4 -> (Vector2f dt3 dt4) }}
                        )
                    }
            }
            } 
    }

I've tried putting different phase control options on the INLINE pragmas to no success.

Trac metadata

Trac field	Value
Version	8.2.1
Type	Bug
TypeOfFailure	OtherFailure
Priority	normal
Resolution	Unresolved
Component	Compiler
Test case
Differential revisions
BlockedBy
Related
Blocking
CC
Operating system
Architecture