Kann GHC generische Funktionen wie Katamorphismen optimieren (entforsten)?

Question

Ich mag die Idee wirklich mit catamorphisms/anamorphisms in allgemeiner Weise zu arbeiten, aber es scheint mir, es eine bedeutende Leistung Nachteil hat:

Angenommen, wir wollen mit einer Baumstruktur in dem kategorischen Weg zur Arbeit - zu beschreiben, unterschiedliche Faltung unter Verwendung eines generischen 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 

Jetzt können wir Funktionen schreiben wie:

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

Leider hat dieser Ansatz einen wesentlichen Nachteil: Dur Bei der Berechnung werden neue Instanzen von TreeT Int auf jeder Ebene in erstellt, nur um sofort von g verbraucht zu werden. Im Vergleich zur klassischen Definition

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

unsere depth1 wird immer langsamer machen unnötige Belastung für den GC. Eine Lösung wäre, hylomorphisms zu verwenden und Erstellungs- und Faltbäume zusammen zu kombinieren. Aber oft wollen wir das nicht, wir möchten vielleicht, dass ein Baum an einer Stelle erstellt wird und dann an einer anderen Stelle weitergegeben wird, um später gefaltet zu werden. Oder mehrere Ordner mit verschiedenen Katamorphismen zu haben.

Gibt es eine Möglichkeit, GHC zu optimieren depth1? Etwas wie Inlining catam g und dann fusing/deforestingg . fmap ... innen?

Answer 1

Ich glaube, ich habe eine Antwort gefunden. Ich erinnerte mich an das Lesen Why does GHC make fix so confounding? und das schlug mir eine Lösung vor.

Das Problem mit der früheren Definition von catam ist, dass es rekursiv ist, und so jeder Versuch, INLINE es wird ignoriert. Übersetzen der Originalversion mit -ddump-simpl -ddump-to-file und Lesen der 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 } 

deutlich schlechter (Konstruktor Schöpfung/Beseitigung in catam_$scatam, mehr Funktionsaufrufe) im Vergleich zu

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 } 

Aber wenn wir definieren catam als

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

dann ist es nicht mehr rekursiv, nur u innen ist. Auf diese Weise GHC inlines catam in der Definition von depth1 und Sicherungen fmap mit depth1 ‚s g - genau das, was wir wollen:

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 } 

, die jetzt nur noch das gleiche wie das Abwerfen des depth2 ist.