(->) 的 Profunctor 实例定义 dimap 和 lmap/rmap 有什么原因吗？

Question

在source code on Hackage我读到这个：

instance Profunctor (->) where
  dimap ab cd bc = cd . bc . ab
  {-# INLINE dimap #-}
  lmap = flip (.)
  {-# INLINE lmap #-}
  rmap = (.)
  {-# INLINE rmap #-}

但是Profunctor 的dimap/lmap/rmap 的默认实现需要一个只定义lmap 和rmap，或者dimap；没有必要定义所有这些。

是否有理由将它们全部定义？

Answer 1

作为@FyodorSoikin cmets，其意图可能是lmap 和rmap 手动编码定义比基于dimap 的默认定义更有效。

但是，使用下面的测试程序，我尝试使用 dimap/rmap/lmap、dimap 和 dimap 和仅使用核心的所有三个定义实例对于测试函数l、r 和b，在使用-O2 编译时在所有三种情况下都完全相同：

b = \ x -> case x of { I# x1 -> I# (+# 15# (*# 6# x1)) }
r = \ x -> case x of { I# x1 -> I# (+# 15# (*# 3# x1)) }
l = \ x -> case x of { I# x1 -> I# (+# (*# x1 2#) 5#) }

虽然对于更复杂的示例，编译器可能无法优化 lmap f = dimap f id 和 rmap = dimap id 的默认定义，但我觉得这极不可能，因此手工编码的 lmap 和 rmap 不没什么区别。

我认为原因在于，即使是像 Edward Kmett 这样非常熟练的 Haskell 程序员，仍然低估了编译器并对其代码进行了不必要的手动优化。

更新：@4castle 在评论中询问如果没有优化会发生什么。警告说“因为它改进了-O0 代码”并没有让我觉得任何东西的合理论据，我看了一下。

在未优化的代码中，显式的rmap 定义通过避免与id 的额外组合来产生更好的Core：

-- explicit `rmap`
r = . (let { ds = I# 3# } in \ ds1 -> * $fNumInt ds1 ds)
      (let { ds = I# 5# } in \ ds1 -> + $fNumInt ds1 ds)

-- default `rmap`
r = . (let { ds = I# 3# } in \ ds1 -> * $fNumInt ds1 ds)
  (. (let { ds = I# 5# } in \ ds1 -> + $fNumInt ds1 ds) id)

而明确的lmap 定义最终生成的核心大致相同，或者可能更糟。

-- explicit `lmap`
$clmap = \ @ a @ b1 @ c -> flip .
l = $clmap
      (let { ds = I# 2# } in \ ds1 -> * $fNumInt ds1 ds)
      (let { ds = I# 5# } in \ ds1 -> + $fNumInt ds1 ds)

-- default `lmap`
l = . id
      (. (let { ds = I# 5# } in \ ds1 -> + $fNumInt ds1 ds)
         (let { ds = I# 2# } in \ ds1 -> * $fNumInt ds1 ds))

由于上述定义，显式dimap 优于默认值，因为有额外的flip。

-- explicit `dimap`
b = . (let { ds = I# 3# } in \ ds1 -> * $fNumInt ds1 ds)
      (. (let { ds = I# 5# } in \ ds1 -> + $fNumInt ds1 ds)
         (let { ds = I# 2# } in \ ds1 -> * $fNumInt ds1 ds))

-- default `dimap`
$clmap = \ @ a @ b1 @ c -> flip .
b = . ($clmap (let { ds = I# 2# } in \ ds1 -> * $fNumInt ds1 ds))
      (. (let { ds = I# 3# } in \ ds1 -> * $fNumInt ds1 ds))
      (let { ds = I# 5# } in \ ds1 -> + $fNumInt ds1 ds)

在另一条评论中，@oisdk 骂我测试不切实际。我要指出，内联递归的失败在这里并不是真正的问题，因为dimap、lmap 或rmap 都不是递归的。特别是，简单地以递归方式“使用”其中之一，例如 foo = foldr rmap id 不会干扰内联或优化，并且为 foo 生成的代码与显式和默认 rmap 相同。

此外，将 l/r 定义中的类/实例拆分为单独的模块对我的测试程序没有任何影响，也不会将其拆分为三个模块，即类、实例和 l /r，因此跨模块边界内联似乎不是一个大问题。

对于非专业化的多态用法，我猜它会归结为生成的Profunctor (->) 字典。我看到以下内容似乎表明具有默认lmap 和rmap 的显式dimap 产生比替代方案更好的代码。问题似乎是 flip (.) 在这里没有得到适当的优化，所以明确的 lmap 定义适得其反。

-- explicit `dimap`, `rmap`, and `lmap`
$fProfunctor->
  = C:Profunctor $fProfunctor->_$cdimap $fProfunctor->_$clmap .
$fProfunctor->_$cdimap
  = \ @ a @ b @ c @ d ab cd bc x -> cd (bc (ab x))
$fProfunctor->_$clmap = \ @ a @ b @ c x y -> . y x

-- explicit `lmap`, `rmap`, default `dimap`
$fProfunctor->
  = C:Profunctor $fProfunctor->_$cdimap $fProfunctor->_$clmap .
$fProfunctor->_$cdimap
  = \ @ a @ b @ c @ d eta eta1 x eta2 -> eta1 (x (eta eta2))
$fProfunctor->_$clmap = \ @ a @ b @ c x y -> . y x

-- explicit `dimap`, default `lmap`, `rmap`
$fProfunctor->
  = C:Profunctor
      $fProfunctor->_$cdimap $fProfunctor->_$clmap $fProfunctor->1
$fProfunctor->_$cdimap
  = \ @ a @ b @ c @ d ab cd bc x -> cd (bc (ab x))
$fProfunctor->_$clmap = \ @ a @ b @ c eta bc x -> bc (eta x)
$fProfunctor->1 = \ @ b @ c @ a cd bc x -> cd (bc x)

如果有人举个例子，这些显式定义生成更好的-O2 代码，那将是一个很好的替代答案。

这是我的测试程序。我用ghc -O2 Profunctor.hs -fforce-recomp -ddump-simpl -dsuppress-all -dsuppress-uniques编译。

module Profunctor where

class Profunctor p where
  dimap :: (a -> b) -> (c -> d) -> p b c -> p a d
  dimap f g = lmap f . rmap g
  {-# INLINE dimap #-}

  lmap :: (a -> b) -> p b c -> p a c
  lmap f = dimap f id
  {-# INLINE lmap #-}

  rmap :: (b -> c) -> p a b -> p a c
  rmap = dimap id
  {-# INLINE rmap #-}

instance Profunctor (->) where
  -- same core if dimap is commented out or if lmap/rmap are commented out
  dimap ab cd bc = cd . bc . ab
  lmap = flip (.)
  rmap = (.)

l :: Int -> Int
l = lmap (*2) (+5)

r :: Int -> Int
r = rmap (*3) (+5)

b :: Int -> Int
b = dimap (*2) (*3) (+5)