Подтвердить что ты не робот

Есть ли способ встроить рекурсивную функцию?

Это продолжение моего предыдущего вопроса, на котором я спросил, почему потоковое слияние не пинги в определенной программе. Оказывается, проблема заключалась в том, что некоторые функции не были встроены, а флаг INLINE улучшил производительность примерно на 17x (что демонстрирует важность встраивания!).

Теперь обратите внимание, что в исходном вопросе я жестко запрограммировал 64 вызовы incAll сразу. Теперь предположим, что вместо этого я создаю функцию nTimes, которая вызывает функцию повторно:

module Main where

import qualified Data.Vector.Unboxed as V

{-# INLINE incAll #-}
incAll :: V.Vector Int -> V.Vector Int
incAll = V.map (+ 1)

{-# INLINE nTimes #-}
nTimes :: Int -> (a -> a) -> a -> a
nTimes 0 f x = x
nTimes n f x = f (nTimes (n-1) f x)

main :: IO ()
main = do
  let size = 100000000 :: Int
  let array = V.replicate size 0 :: V.Vector Int
  print $ V.sum (nTimes 64 incAll array)

В этом случае просто добавление INLINE pragma to nTimes не поможет, потому что AFAIK GHC не выполняет встроенные рекурсивные функции. Есть ли какой-либо трюк, чтобы заставить GHC расширять nTimes во время компиляции и, таким образом, восстановить ожидаемую производительность?

4b9b3361

Ответ 1

Нет, но вы можете использовать лучшие функции. Я не говорю о V.map (+64), что сделает вещи намного быстрее, но о nTimes. У нас есть три кандидата, которые уже делают то, что nTimes делает:

{-# INLINE nTimesFoldr #-}
nTimesFoldr :: Int -> (a -> a) -> a -> a    
nTimesFoldr n f x = foldr (.) id (replicate n f) $ x

{-# INLINE nTimesIterate #-}
nTimesIterate :: Int -> (a -> a) -> a -> a    
nTimesIterate n f x = iterate f x !! n

{-# INLINE nTimesTail #-}
nTimesTail :: Int -> (a -> a) -> a -> a    
nTimesTail n f = go n
  where
    {-# INLINE go #-}
    go n x | n <= 0 = x
    go n x          = go (n - 1) (f x)

Все версии занимают около 8 секунд, по сравнению с 40 секундами ваших версий. Кстати, версия Joachim также занимает 8 секунд. Обратите внимание, что версия iterate занимает больше памяти в моей системе. Хотя для GHC существует плагин unroll, он не обновлялся за последние пять лет (он использует пользовательские ANNotations).

Нет разворота вообще?

Однако, прежде чем мы отчаиваемся, насколько GHC действительно пытается внедрить все? Используйте nTimesTail и nTimes 1:

module Main where
import qualified Data.Vector.Unboxed as V

{-# INLINE incAll #-}
incAll :: V.Vector Int -> V.Vector Int
incAll = V.map (+ 1)

{-# INLINE nTimes #-}
nTimes :: Int -> (a -> a) -> a -> a    
nTimes n f = go n
  where
    {-# INLINE go #-}
    go n x | n <= 0 = x
    go n x          = go (n - 1) (f x)

main :: IO ()
main = do
  let size = 100000000 :: Int
  let array = V.replicate size 0 :: V.Vector Int
  print $ V.sum (nTimes 1 incAll array)
$ stack ghc --package vector -- -O2 -ddump-simpl -dsuppress-all SO.hs
main2 =
  case (runSTRep main3) `cast` ...
  of _ { Vector ww1_s9vw ww2_s9vx ww3_s9vy ->
  case $wgo 1 ww1_s9vw ww2_s9vx ww3_s9vy
  of _ { (# ww5_s9w3, ww6_s9w4, ww7_s9w5 #) ->

Мы можем остановиться прямо здесь. $wgo - это go, определенный выше. Даже с 1 GHC не разворачивает цикл. Это возмущает, так как 1 является константой.

Шаблоны для спасения

Но, увы, это не все напрасно. Если программисты на С++ могут делать следующее для констант времени компиляции, значит, правильно?

template <int N>
struct Call{
    template <class F, class T>
    static T call(F f, T && t){
        return f(Call<N-1>::call(f,std::forward<T>(t)));
    }
};
template <>
struct Call<0>{
    template <class F, class T>
    static T call(F f, T && t){
        return t;
    }  
};

И, конечно, мы можем с TemplateHaskell *:

-- Times.sh
{-# LANGUAGE TemplateHaskell #-}
module Times where

import Control.Monad (when)
import Language.Haskell.TH

nTimesTH :: Int -> Q Exp
nTimesTH n = do
  f <- newName "f"
  x <- newName "x"

  when (n <= 0) (reportWarning "nTimesTH: argument non-positive")

  let go k | k <= 0 = VarE x
      go k          = AppE (VarE f) (go (k - 1))
  return $ LamE [VarP f,VarP x] (go n)

Что делает nTimesTH? Он создает новую функцию, в которой первое имя f будет применено ко второму имени x в общей сложности n раз. n теперь должна быть константой времени компиляции, которая нам подходит, поскольку цикл-разворот возможен только с константами времени компиляции:

$(nTimesTH 0) = \f x -> x
$(nTimesTH 1) = \f x -> f x
$(nTimesTH 2) = \f x -> f (f x)
$(nTimesTH 3) = \f x -> f (f (f x))
...

Это работает? И быстро? Как быстро по сравнению с nTimes? Попробуем другой main для этого:

-- SO.hs
{-# LANGUAGE TemplateHaskell #-}
module Main where
import Times
import qualified Data.Vector.Unboxed as V

{-# INLINE incAll #-}
incAll :: V.Vector Int -> V.Vector Int
incAll = V.map (+ 1)

{-# INLINE nTimes #-}
nTimes :: Int -> (a -> a) -> a -> a    
nTimes n f = go n
  where
    {-# INLINE go #-}
    go n x | n <= 0 = x
    go n x          = go (n - 1) (f x)

main :: IO ()
main = do
  let size = 100000000 :: Int
  let array = V.replicate size 0 :: V.Vector Int
  let vTH   = V.sum ($(nTimesTH 64) incAll array)
  let vNorm = V.sum (nTimes 64 incAll array)
  print $ vTH == vNorm
stack ghc --package vector -- -O2 SO.hs && SO.exe +RTS -t
True
<<ghc: 52000056768 bytes, 66 GCs, 400034700/800026736 avg/max bytes residency (2 samples), 1527M in use, 0.000 INIT (0.000 elapsed), 8.875 MUT (9.119 elapsed), 0.000 GC (0.094 elapsed) :ghc>>

Он дает правильный результат. Как быстро? Позвольте снова использовать еще один main:

main :: IO ()
main = do
  let size = 100000000 :: Int
  let array = V.replicate size 0 :: V.Vector Int
  print $ V.sum ($(nTimesTH 64) incAll array)
     800,048,112 bytes allocated in the heap                                         
           4,352 bytes copied during GC                                              
          42,664 bytes maximum residency (1 sample(s))                               
          18,776 bytes maximum slop                                                  
             764 MB total memory in use (0 MB lost due to fragmentation)             

                                     Tot time (elapsed)  Avg pause  Max pause        
  Gen  0         1 colls,     0 par    0.000s   0.000s     0.0000s    0.0000s        
  Gen  1         1 colls,     0 par    0.000s   0.049s     0.0488s    0.0488s        

  INIT    time    0.000s  (  0.000s elapsed)                                         
  MUT     time    0.172s  (  0.221s elapsed)                                         
  GC      time    0.000s  (  0.049s elapsed)                                         
  EXIT    time    0.000s  (  0.049s elapsed)                                         
  Total   time    0.188s  (  0.319s elapsed)                                         

  %GC     time       0.0%  (15.3% elapsed)                                           

  Alloc rate    4,654,825,378 bytes per MUT second                                   

  Productivity 100.0% of total user, 58.7% of total elapsed        

Хорошо, сравните это с 8s. Поэтому для TL; DR: если у вас есть константы времени компиляции и вы хотите создать и/или изменить свой код на основе этих констант, рассмотрите шаблон Haskell.

* Обратите внимание, что это мой первый код шаблона Haskell, который я когда-либо писал. Используйте с осторожностью. Не используйте слишком большой n, иначе у вас может быть испорченная функция.

Ответ 2

Существует немного известный трюк, о котором Андрес сказал мне раньше, где вы действительно можете получить GHC для встроенных рекурсивных функций с помощью классов типов.

Идея состоит в том, что вместо того, чтобы писать функцию, обычно, когда вы выполняете структурную рекурсию по значению. Вы определяете свою функцию с помощью классов типов и выполняете структурную рекурсию на аргументе типа. В этом примере натуральные числа на уровне типа.

GHC будет счастливо встроить каждый рекурсивный вызов и создать эффективный код, поскольку каждый рекурсивный вызов имеет другой тип.

Я не сравнивал это или не смотрел на ядро, но заметно быстрее.

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Main where

import qualified Data.Vector.Unboxed as V

data Proxy a = Proxy

{-# INLINE incAll #-}
incAll :: V.Vector Int -> V.Vector Int
incAll = V.map (+ 1)

oldNTimes :: Int -> (a -> a) -> a -> a
oldNTimes 0 f x = x
oldNTimes n f x = f (oldNTimes (n-1) f x)

-- New definition

data N = Z | S N

class Unroll (n :: N) where
    nTimes :: Proxy n -> (a -> a) -> a -> a

instance Unroll Z where
    nTimes _ f x = x

instance Unroll n => Unroll (S n) where
    nTimes p f x =
        let Proxy :: Proxy (S n) = p
        in f (nTimes (Proxy :: Proxy n) f x)

main :: IO ()
main = do
  let size = 100000000 :: Int
  let array = V.replicate size 0 :: V.Vector Int
  print $ V.sum (nTimes (Proxy :: Proxy (S (S (S (S (S (S (S (S (S (S (S Z)))))))))))) incAll array)
  print $ V.sum (oldNTimes 11 incAll array)

Ответ 3

Нет.

Вы можете написать

{-# INLINE nTimes #-}
nTimes :: Int -> (a -> a) -> a -> a
nTimes n f x = go n
  where go 0 = x
        go n = f (go (n-1))

и GHC будет встроен nTimes и, вероятно, специализирует рекурсивный go для ваших конкретных аргументов incAll и array, но он не будет разворачивать цикл.