[GHC] #14248: GHC misses optimization opportunity

18 Sep 2017

      #14248: GHC misses optimization opportunity
-------------------------------------+-------------------------------------
           Reporter:  vagarenko      |             Owner:  (none)
               Type:  bug            |            Status:  new
           Priority:  normal         |         Milestone:
          Component:  Compiler       |           Version:  8.2.1
           Keywords:                 |  Operating System:  Unknown/Multiple
       Architecture:                 |   Type of failure:  None/Unknown
  Unknown/Multiple                   |
          Test Case:                 |        Blocked By:
           Blocking:                 |   Related Tickets:
Differential Rev(s):                 |         Wiki Page:
-------------------------------------+-------------------------------------
 Consider this code:

 {{{#!hs
 {-# 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:
 {{{#!hs
 -- 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:

 {{{#!hs
 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.

-- 
Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/14248
GHC http://www.haskell.org/ghc/
The Glasgow Haskell Compiler