Czy możliwe jest optymalizowanie (deforest) ogólnych funkcji GHC, takich jak katamorfizmy?

Question

bardzo podoba mi się pomysł pracy z catamorphisms/anamorphisms w sposób ogólny, ale wydaje mi się ona istotna wada wydajność:

Załóżmy, że chcemy pracować ze strukturą drzewa w kategoryczny sposób - do opisania inna składane za pomocą rodzajowy catamorphism function:

newtype Fix f = Fix { unfix :: f (Fix f) } 

data TreeT r = Leaf | Tree r r 
instance Functor TreeT where 
    fmap f Leaf   = Leaf 
    fmap f (Tree l r) = Tree (f l) (f r) 

type Tree = Fix TreeT 

catam :: (Functor f) => (f a -> a) -> (Fix f -> a) 
catam f = f . fmap (catam f) . unfix 

teraz możemy napisać funkcje, takie jak:

depth1 :: Tree -> Int 
depth1 = catam g 
    where 
    g Leaf  = 0 
    g (Tree l r) = max l r 

Niestety, takie podejście ma znaczącą wadę: Dur Podczas obliczeń nowe instancje TreeT Int są tworzone na każdym poziomie w fmap, aby natychmiast zostać zużyte przez g. W porównaniu do klasycznej definicji

depth2 :: Tree -> Int 
depth2 (Fix Leaf) = 0 
depth2 (Fix (Tree l r)) = max (depth1 l) (depth1 r) 

naszych depth1 zawsze będzie mniejsza co niepotrzebne obciążenie GC. Jednym z rozwiązań byłoby użycie hylomorphisms i połączenie ze sobą tworzenia i składania drzew. Ale często nie chcemy tego robić, możemy chcieć stworzyć drzewo w jednym miejscu, a następnie przekazać je gdzie indziej, aby później je złożyć. Lub, aby być folderem kilka razy z różnymi katamorfizmami.

Czy istnieje sposób na optymalizację GHC depth1? Coś w stylu wstawiania catam g, a następnie g . fmap ... w środku?

Answer 1

Wierzę, że znalazłem odpowiedź. Przypomniałem sobie lekturę Why does GHC make fix so confounding? i to zasugerowało mi rozwiązanie.

Problem z poprzednią definicją catam polega na tym, że jest rekursywna, a więc każda próba przesłania INLINE jest ignorowana. Kompilacja oryginalną wersję z -ddump-simpl -ddump-to-file i czytanie core:

Main.depth1 = Main.catam_$scatam @ GHC.Types.Int Main.depth3 

Main.depth3 = 
    \ (ds_dyI :: Main.TreeT GHC.Types.Int) -> 
    case ds_dyI of _ { 
     Main.Leaf -> Main.depth4; 
     Main.Tree l_aah r_aai -> GHC.Classes.$fOrdInt_$cmax l_aah r_aai 
    } 

Main.depth4 = GHC.Types.I# 0 

Rec { 
Main.catam_$scatam = 
    \ (@ a_ajB) 
    (eta_B1 :: Main.TreeT a_ajB -> a_ajB) 
    (eta1_X2 :: Main.Fix Main.TreeT) -> 
    eta_B1 
     (case eta1_X2 
      `cast` (Main.NTCo:Fix <Main.TreeT> 
        :: Main.Fix Main.TreeT ~# Main.TreeT (Main.Fix Main.TreeT)) 
     of _ { 
     Main.Leaf -> Main.Leaf @ a_ajB; 
     Main.Tree l_aan r_aao -> 
      Main.Tree 
      @ a_ajB 
      (Main.catam_$scatam @ a_ajB eta_B1 l_aan) 
      (Main.catam_$scatam @ a_ajB eta_B1 r_aao) 
     }) 
end Rec } 

jest wyraźnie gorszy (tworzenie konstruktor/eliminacja catam_$scatam, bardziej wywołania funkcji) w porównaniu do

Main.depth2 = 
    \ (w_s1Rz :: Main.Tree) -> 
    case Main.$wdepth2 w_s1Rz of ww_s1RC { __DEFAULT -> 
    GHC.Types.I# ww_s1RC 
    } 

Rec { 
Main.$wdepth2 [Occ=LoopBreaker] :: Main.Tree -> GHC.Prim.Int# 
[GblId, Arity=1, Caf=NoCafRefs, Str=DmdType S] 
Main.$wdepth2 = 
    \ (w_s1Rz :: Main.Tree) -> 
    case w_s1Rz 
     `cast` (Main.NTCo:Fix <Main.TreeT> 
       :: Main.Fix Main.TreeT ~# Main.TreeT (Main.Fix Main.TreeT)) 
    of _ { 
     Main.Leaf -> 0; 
     Main.Tree l_aaj r_aak -> 
     case Main.$wdepth2 l_aaj of ww_s1RC { __DEFAULT -> 
     case Main.$wdepth2 r_aak of ww1_X1Sh { __DEFAULT -> 
     case GHC.Prim.<=# ww_s1RC ww1_X1Sh of _ { 
      GHC.Types.False -> ww_s1RC; 
      GHC.Types.True -> ww1_X1Sh 
     } 
     } 
     } 
    } 
end Rec } 

Ale jeśli definiujemy catam jak

{-# INLINE catam #-} 
catam :: (Functor f) => (f a -> a) -> (Fix f -> a) 
catam f = let u = f . fmap u . unfix 
      in u 

to już nie jest rekurencyjny, tylko u w środku. W ten sposób GHC inlines catam w definicji depth1 i bezpieczniki fmap z depth1 „s g - tylko to, co chcemy:

Main.depth1 = 
    \ (w_s1RJ :: Main.Tree) -> 
    case Main.$wdepth1 w_s1RJ of ww_s1RM { __DEFAULT -> 
    GHC.Types.I# ww_s1RM 
    } 

Rec { 
Main.$wdepth1 [Occ=LoopBreaker] :: Main.Tree -> GHC.Prim.Int# 
[GblId, Arity=1, Caf=NoCafRefs, Str=DmdType S] 
Main.$wdepth1 = 
    \ (w_s1RJ :: Main.Tree) -> 
    case w_s1RJ 
     `cast` (Main.NTCo:Fix <Main.TreeT> 
       :: Main.Fix Main.TreeT ~# Main.TreeT (Main.Fix Main.TreeT)) 
    of _ { 
     Main.Leaf -> 0; 
     Main.Tree l_aar r_aas -> 
     case Main.$wdepth1 l_aar of ww_s1RM { __DEFAULT -> 
     case Main.$wdepth1 r_aas of ww1_X1So { __DEFAULT -> 
     case GHC.Prim.<=# ww_s1RM ww1_X1So of _ { 
      GHC.Types.False -> ww_s1RM; 
      GHC.Types.True -> ww1_X1So 
     } 
     } 
     } 
    } 
end Rec } 

który jest teraz tak samo jak wyrzucenia depth2.