È possibile rendere GHC ottimizzare (deforest) funzioni generiche come i catamorfismi?

Question

mi piace molto l'idea di lavorare con catamorphisms/anamorphisms in modo generico, ma mi sembra che ha un notevole svantaggio delle prestazioni:

supponiamo di voler lavorare con una struttura ad albero in modo categorico - per descrivere differente piegatura usando un generico 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 

Ora possiamo scrivere funzioni quali:

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

Sfortunatamente, questo approccio ha uno svantaggio significativo: Dur Durante il calcolo, le nuove istanze di TreeT Int vengono create ad ogni livello in fmap per essere immediatamente consumate da g. Rispetto alla definizione classica

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

nostro depth1 sarà sempre più lento facendo uno sforzo eccessivo del GC. Una soluzione sarebbe quella di utilizzare hylomorphisms e combinare insieme la creazione e la piegatura degli alberi. Ma spesso non vogliamo farlo, potremmo voler creare un albero in un posto e poi passare da qualche altra parte per essere piegato in seguito. Oppure, per essere cartelle diverse volte con diversi catamorfismi.

C'è un modo per ottimizzare GHC depth1? Qualcosa come l'inline catam g e poi fusing/deforestingg . fmap ... all'interno?

Answer 1

Credo di aver trovato una risposta. Mi sono ricordato di aver letto Why does GHC make fix so confounding? e questo mi ha suggerito una soluzione.

Il problema con la precedente definizione di catam è che è ricorsiva e quindi qualsiasi tentativo di INLINE viene ignorato. Compilare la versione originale con -ddump-simpl -ddump-to-file e la lettura della 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 } 

è chiaramente peggiore (creazione costruttore/eliminazione in catam_$scatam, più chiamate di funzione) rispetto al

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 } 

Ma se definiamo catam come

quindi non è più ricorsivo, solo u all'interno è. In questo modo GHC inlines catam nella definizione di depth1 e si fonde con fmapdepth1 s' g - proprio quello che ci vuole:

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 } 

che ora è lo stesso che la discarica di depth2.