Opened 2 years ago

Closed 2 years ago

#14248 closed bug (invalid)

GHC misses optimization opportunity

Reported by: vagarenko Owned by:
Priority: normal Milestone:
Component: Compiler Version: 8.2.1
Keywords: Cc:
Operating System: Unknown/Multiple Architecture: Unknown/Multiple
Type of failure: None/Unknown Test Case:
Blocked By: Blocking:
Related Tickets: Differential Rev(s):
Wiki Page:

Description

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.

Change History (3)

comment:1 Changed 2 years ago by simonpj

Alas, your proposed optimsation changes the semantics of the function. As it stands, it's not strict in eta, but after your transformation it has become strict.

If you make it strict yourself, I think it'll probably optimise right. This seems to do ths trick

unzipVec ps =
    let (es1, es2) = unzip @n ps
        !a1 = fromList es1
        !a2 = fromList es2
    in (a1, a2)

gives

unzipVecSpecialized
  = \ (eta_B1 :: [(Float, Float)]) ->
      case eta_B1 of {
        [] -> case lvl20_r2SX of wild1_00 { };
        : x_a14H xs_a14I ->
          case x_a14H of { (a_a14J, b_a14K) ->
          case xs_a14I of {
            [] -> case lvl20_r2SX of wild3_00 { };
            : x1_X18m xs1_X18o ->
              case x1_X18m of { (a1_X18u, b1_X18w) ->
              case a_a14J of { GHC.Types.F# dt1_a15E ->
              case a1_X18u of { GHC.Types.F# dt3_a15F ->
              case b_a14K of { GHC.Types.F# dt5_X17Q ->
              case b1_X18w of { GHC.Types.F# dt7_X17W ->
              ((Unzip.Vector2f dt1_a15E dt3_a15F)
               `cast` (Sym (Unzip.D:R:Vector2Float0[0])
                       :: (Unzip.R:Vector2Float :: *) ~R# (Vector 2 Float :: *)),
               (Unzip.Vector2f dt5_X17Q dt7_X17W)
               `cast` (Sym (Unzip.D:R:Vector2Float0[0])
                       :: (Unzip.R:Vector2Float :: *) ~R# (Vector 2 Float :: *)))
              }
              }
              }
              }
              }
          }
          }
      }

Does that make sense?

comment:2 in reply to:  1 Changed 2 years ago by vagarenko

Replying to simonpj:

Thank you! This works perfectly.

comment:3 Changed 2 years ago by vagarenko

Resolution: invalid
Status: newclosed
Note: See TracTickets for help on using tickets.