给定一个简单的数据处理DSL的深度嵌入[1]:

{-# LANGUAGE GADTs, StandaloneDeriving #-}

import Data.List
import Text.Show.Functions

data Dist e where

    Concat :: [Dist [a]] -> Dist [a]

    -- We use ConcatMap as a primitive because it can express e.g.
    -- both map and filter.
    ConcatMap :: (a -> [b]) -> Dist [a] -> Dist [b]

    -- Expensive to traverse input (think distributed file).
    Input :: Dist [a]

    Let :: Name -> Dist e -> Dist e -> Dist e

    -- We're not dealing with name collisions here for simplicity.
    Var :: Name -> Dist e

deriving instance Show (Dist e)

type Name = String

我们可以像这样实现熟悉的生产者-消费者融合
-- ---------------------------------------------------------------------
-- Producer-consumer fusion

-- Fuses adjacent ConcatMaps.
fuseProducerConsumer :: Dist e -> Dist e
fuseProducerConsumer = go
  where
    go :: Dist e -> Dist e
    go (ConcatMap f (ConcatMap g e)) = ConcatMap (concatMap f . g) (go e)
    go e = e

一个显示其工作原理的小例子:
-- Should be able to fuse this to a single ConcatMap.
producerConsumerFusable :: Dist [Int]
producerConsumerFusable = ConcatMap (singleton . (+ 1))
                          (ConcatMap (singleton . (* 2)) Input)

singleton :: a -> [a]
singleton = (: [])

-- Expected result after optimization.
expectedProducerConsumerResult =
    ConcatMap (concatMap (singleton . (+ 1)) . (singleton . (* 2))) Input

还有另一种鲜为人知的[2]融合类型,称为同级融合,它消除了同一输入的多次遍历。这个想法是取代类似的东西
(map f xs, map g xs)


let ys = map (\ x -> (f x, g x)) xs
in (map fst ys, map snd ys)

如果遍历ys比遍历xs便宜得多(例如,如果xs是网络上的文件),或者我们可以使用生产者-消费者融合稍后将取消标记与其他遍历融合在一起,这是一个胜利。

使用上面的标准AST可以轻松实现生产者-消费者融合,但是我看不到如何使用这种表示形式实现同级融合。
-- ---------------------------------------------------------------------
-- Sibling fusion

-- Fuses ConcatMaps that consumer the same input.
fuseSibling :: Dist e -> Dist e
fuseSibling = id  -- ???

我们想要发生的一个例子:
-- The use of Concat below is not important, we just need some Dist e
-- that contains an opportunity for sibling fusion.
siblingFusable :: Dist [Int]
siblingFusable = Let "xs" Input $  -- shares one input
                 Concat [ConcatMap (singleton . (+ 1)) (Var "xs"),
                         ConcatMap (singleton . (* 2)) (Var "xs")]

-- Expected result after optimization.
expectedSiblingResult =
    Let "xs" Input $
    (Let "ys" (ConcatMap
              (mapTwo (singleton . (+ 1)) (singleton . (* 2)))
              (Var "xs"))  -- only one traversal of "xs" and thus Input
     (Concat [ConcatMap lefts  (Var "ys"),
              ConcatMap rights (Var "ys")]))

-- Some helper functions:
lefts :: Either a b -> [a]
lefts (Left x) = [x]
lefts _        = []

rights :: Either a b -> [b]
rights (Right x) = [x]
rights _         = []

mapTwo :: (a -> [b]) -> (a -> [c]) -> a -> [Either b c]
mapTwo f g x = map Left (f x) ++ map Right (g x)

问题在于,尽管我们可以通过在ConcatMap ... (ConcatMap ... ...)上进行模式匹配来轻松发现消费者与生产者的融合机会,但单个输入的两个消费者却带来同级融合机会,而在AST中,它们不一定彼此“接近”同样的方式。

如果我们可以沿相反的方向遍历AST,即从Input开始,则很容易发现一个输入的并行使用方。但鉴于每个操作仅引用其输入,而不引用其输出,因此我看不到如何执行此操作。

问题:是否可以使用此AST表示形式来实现同级融合,或者是否存在其他允许我们实现同级融合的(例如基于图形或基于连续的形式)表示?最好在仍使用GADT进行类型安全的同时。
  • 此DSL与FlumeJava DSL类似,用于分布式计算:http://pages.cs.wisc.edu/~akella/CS838/F12/838-CloudPapers/FlumeJava.pdf
  • 可能不太为人所知,因为这显然不是单流程程序的胜利,在该流程中,额外的簿记可能超过避免回溯输入的代价。但是,如果输入的是驻留在网络上的1TB文件,那将是一个很大的胜利。
  • 最佳答案

    我创造了一个怪物,现在我将在世界上释放它。这是您在Idris中进行转换的一个实现。

    我首先在Haskell中开始研究这个问题,问题在于我们实质上是在寻找一种为每个变量收集一组函数f1 :: a -> b1, f2 :: a -> b2, ...的方法。为此,在Haskell中提出一个很好的表示非常棘手,因为一方面,我们想将b1, b2, ...类型隐藏在一个存在的事物后面,但是另一方面,当我们看到ConcatMap时,我们需要构造一个函数来提取正确的从[Either b1 (Either b2 (...))]坐标中选择正确的类型。

    因此,首先,通过使用范围内的变量对Dist进行索引,并对变量的出现使用De Bruijn索引,确保我们的变量引用具有良好的作用域和类型:

    %default total
    
    Ctx : Type
    Ctx = List Type
    
    data VarPtr : Ctx -> Type -> Type where
      here : VarPtr (a :: ctx) a
      there : VarPtr ctx b -> VarPtr (a :: ctx) b
    
    data Dist : Ctx -> Type -> Type where
      Input : Dist ctx a
      Concat2 : Dist ctx a -> Dist ctx a -> Dist ctx a
      ConcatMap : (a -> List b) -> Dist ctx a -> Dist ctx b
      Let : Dist ctx a -> Dist (a :: ctx) b -> Dist ctx b
      Var : VarPtr ctx a -> Dist ctx a
    

    可以看出,我对Dist做了两个简化:
  • 无论如何,一切总是像列表一样的东西,例如ConcatMap的类型是Dist ctx a -> Dist ctx b而不是Dist ctx (List a) -> Dist ctx (List b)。仅使用原始问题中提供的组合器,无论如何,只能构建列表的Dist值。这使实现更简单(换句话说,在进行此更改之前,我遇到了各种不必要的复杂情况)。
  • Concat2是二进制而不是n-ary。将下面的fuseHoriz更改为 super n级连接是读者的一项练习。

  • 让我们首先实现垂直融合,只是弄湿我们的脚:
    fuseVert : Dist ctx a -> Dist ctx a
    fuseVert Input = Input
    fuseVert (Concat2 xs ys) = Concat2 (fuseVert xs) (fuseVert ys)
    fuseVert (ConcatMap f d) = case fuseVert d of
        ConcatMap g d' => ConcatMap (concatMap f . g) d'
        d' => ConcatMap f d'
    fuseVert (Let d0 d) = Let (fuseVert d0) (fuseVert d)
    fuseVert (Var k) = Var k
    

    到现在为止还挺好:
    namespace Examples
      f : Int -> List Int
      f = return . (+1)
    
      g : Int -> List Int
      g = return . (* 2)
    
      ex1 : Dist [] Int
      ex1 = ConcatMap f $ ConcatMap g $ Input
    
      ex1' : Dist [] Int
      ex1' = ConcatMap (concatMap f . g) $ Input
    
      prf : fuseVert ex1 = ex1'
      prf = Refl
    

    现在是有趣的部分。我们需要良好地表示“来自同一域的功能集合”,以及一种指向该集合中特定功能(具有特定共域)的方法。我们将从ConcatMap f (Var v)键入的v调用中收集这些函数;然后将 call 本身替换为一个孔,当我们完成所有收集后,该孔将被填充。

    当我们遇到Concat2 d1 d2时,我们需要合并从两侧收集的函数,然后减弱d1d2中的漏洞以覆盖此扩展集合。
    由于这个原因,我使用二叉树而不是平面列表:因此,弱化很容易实现。

    因为我正在重用here / there术语,所以它进入了自己的 namespace :
    namespace Funs
      data Funs : Type -> Type where
        None : Funs a
        Leaf : (a -> List b) -> Funs a
        Branch : Funs a -> Funs a -> Funs a
    
      instance Semigroup (Funs a) where
        (<+>) = Branch
    
      data FunPtr : Funs a -> Type -> Type where
        here : FunPtr (Leaf {b} _) b
        left : FunPtr fs b -> FunPtr (Branch fs _) b
        right : FunPtr fs b -> FunPtr (Branch _ fs) b
    

    现在,我们已经有了一个集合,可以表示应用于给定变量的所有函数的集合,我们终于可以在实现水平融合方面取得一些进展。

    重申一下,目标是将类似
    let xs = Input :: [A]
    in Concat2 (E $ ConcatMap f xs) (F $ ConcatMap g xs)
    where
      f :: A -> [B]
      g :: A -> [C]
    

    变成像
    let xs = Input :: [A]
        xs' = ConcatMap (\x -> map Left (f x) ++ map Right (g x)) xs :: [(Either B C)]
    in Concat2 (E $ ConcatMap (either return (const []) xs') (F $ ConcatMap (either (const []) return) xs')
    

    因此,首先,我们需要能够从应用于xs'的函数集合中对生成器(xs的定义)进行代码生成:
      memoType : Funs a -> Type
      memoType None = ()
      memoType (Leaf {b} _) = b
      memoType (Branch fs1 fs2) = Either (memoType fs1) (memoType fs2)
    
      memoFun : (fs : Funs a) -> (a -> List (memoType fs))
      memoFun None = const []
      memoFun (Leaf f) = f
      memoFun (Branch fs1 fs2) = (\xs => map Left (memoFun fs1 xs) <+> map Right (memoFun fs2 xs))
    
      memoExpr : (fs : Funs a) -> Dist (a :: ctx) (memoType fs)
      memoExpr fs = ConcatMap (memoFun fs) (Var here)
    

    如果我们以后无法查看这些记录的结果,将不会有太大用处:
      lookupMemo : {fs : Funs a} -> (i : FunPtr fs b) -> (memoType fs -> List b)
      lookupMemo {fs = Leaf f} here = \x => [x]
      lookupMemo {fs = (Branch fs1 fs2)} (left i) = either (lookupMemo i) (const [])
      lookupMemo {fs = (Branch fs1 fs2)} (right i) = either (const []) (lookupMemo i)
    

    现在,当我们遍历源代码树时,我们当然可以同时收集(通过ConcatMap)几个变量的用法,因为完全有可能像
    let xs = ...
    in Concat2 (ConcatMap f xs) (let ys = ... in ... (ConcatMap g xs) ...)
    

    这将与变量上下文一起逐步填充,因为在每个Let绑定(bind)中,我们还可以生成新变量的所有用法的备注。
    namespace Usages
      data Usages : Ctx -> Type where
        Nil : Usages []
        (::) : {a : Type} -> Funs a -> Usages ctx -> Usages (a :: ctx)
    
      unused : {ctx : Ctx} -> Usages ctx
      unused {ctx = []} = []
      unused {ctx = _ :: ctx} = None :: unused {ctx}
    
      instance Semigroup (Usages ctx) where
        [] <+> [] = []
        (fs1 :: us1) <+> (fs2 :: us2) = (fs1 <+> fs2) :: (us1 <+> us2)
    

    我们将为这些综合变量保留空间:
      ctxDup : {ctx : Ctx} -> Usages ctx -> Ctx
      ctxDup {ctx = []} us = []
      ctxDup {ctx = t :: ts} (fs :: us) = (memoType fs) :: t :: ctxDup us
    
      varDup : {us : Usages ctx} -> VarPtr ctx a -> VarPtr (ctxDup us) a
      varDup {us = _ :: _} here = there here
      varDup {us = _ :: _} (there v) = there $ there $ varDup v
    

    现在,我们终于可以定义优化器的内部中间表示形式:“带孔的Dist”。每个孔代表一个函数在变量上的应用,当我们知道所有用法并且在范围内拥有它们的所有综合变量时,将填充该孔:
    namespace HDist
      data Hole : Usages ctx -> Type -> Type where
        here : FunPtr u b -> Hole (u :: us) b
        there : Hole us b -> Hole (_ :: us) b
    
      resolve : {us : Usages ctx} -> Hole us b -> Exists (\a => (VarPtr (ctxDup us) a, a -> List b))
      resolve (here i) = Evidence _ (here, lookupMemo i)
      resolve (there h) with (resolve h) | Evidence a (v, f) = Evidence a (there $ there v, f)
    
      data HDist : Usages ctx -> Type -> Type where
        HInput : HDist us a
        HConcat : HDist us a -> HDist us a -> HDist us a
        HConcatMap : (b -> List a) -> HDist us b -> HDist us a
        HLet : HDist us a -> (fs : Funs a) -> HDist (fs :: us) b -> HDist us b
        HVar : {ctx : Ctx} -> {us : Usages ctx} -> VarPtr ctx a -> HDist us a
        HHole : (hole : Hole us a) -> HDist us a
    

    因此,一旦我们有了一个有漏洞的Dist,将其填充就可以解决它:
    fill : HDist us a -> Dist (ctxDup us) a
    fill HInput = Input
    fill (HConcat e1 e2) = Concat2 (fill e1) (fill e2)
    fill (HConcatMap f e) = ConcatMap f $ fill e
    fill (HLet e0 fs e) = Let (fill e0) $ Let (memoExpr fs) $ fill e
    fill (HVar x) = Var (varDup x)
    fill (HHole h) with (resolve h) | Evidence a (v, f) = ConcatMap f $ Var v
    

    因此,水平融合仅是肘部润滑脂的问题:将Dist ctx a转换为HDist us a,以便将每个ConcatMap f (Var v)转换为HHole。当从Usages的两个侧面组合两个Concat2时,我们需要做一些额外的有趣的舞蹈来转移漏洞。
    weakenHoleL : Hole us1 a -> Hole (us1 <+> us2) a
    weakenHoleL {us1 = _ :: _} {us2 = _ :: _} (here i) = here (left i)
    weakenHoleL {us1 = _ :: _} {us2 = _ :: _} (there h) = there $ weakenHoleL h
    
    weakenHoleR : Hole us2 a -> Hole (us1 <+> us2) a
    weakenHoleR {us1 = _ :: _} {us2 = _ :: _} (here i) = here (right i)
    weakenHoleR {us1 = _ :: _} {us2 = _ :: _} (there h) = there $ weakenHoleR h
    
    weakenL : HDist us1 a -> HDist (us1 <+> us2) a
    weakenL HInput = HInput
    weakenL (HConcat e1 e2) = HConcat (weakenL e1) (weakenL e2)
    weakenL (HConcatMap f e) = HConcatMap f (weakenL e)
    weakenL {us1 = us1} {us2 = us2} (HLet e fs x) = HLet (weakenL e) (Branch fs None) (weakenL {us2 = None :: us2} x)
    weakenL (HVar x) = HVar x
    weakenL (HHole hole) = HHole (weakenHoleL hole)
    
    weakenR : HDist us2 a -> HDist (us1 <+> us2) a
    weakenR HInput = HInput
    weakenR (HConcat e1 e2) = HConcat (weakenR e1) (weakenR e2)
    weakenR (HConcatMap f e) = HConcatMap f (weakenR e)
    weakenR {us1 = us1} {us2 = us2} (HLet e fs x) = HLet (weakenR e) (Branch None fs) (weakenR {us1 = None :: us1} x)
    weakenR (HVar x) = HVar x
    weakenR (HHole hole) = HHole (weakenHoleR hole)
    
    fuseHoriz : Dist ctx a -> Exists {a = Usages ctx} (\us => HDist us a)
    fuseHoriz Input = Evidence unused HInput
    fuseHoriz (Concat2 d1 d2) with (fuseHoriz d1)
      | Evidence us1 e1 with (fuseHoriz d2)
        | Evidence us2 e2 =
            Evidence (us1 <+> us2) $ HConcat (weakenL e1) (weakenR e2)
    fuseHoriz {ctx = _ :: ctx} (ConcatMap f (Var here)) =
        Evidence (Leaf f :: unused) (HHole (here here))
    fuseHoriz (ConcatMap f d) with (fuseHoriz d)
      | Evidence us e = Evidence us (HConcatMap f e)
    fuseHoriz (Let d0 d) with (fuseHoriz d0)
      | Evidence us0 e0 with (fuseHoriz d)
        | Evidence (fs :: us) e =
            Evidence (us0 <+> us) $ HLet (weakenL e0) (Branch None fs) $ weakenR {us1 = None :: us0} e
    fuseHoriz (Var v) = Evidence unused (HVar v)
    

    我们可以通过将它与fuseVert结合使用并将其提供给fill来使用这种怪物:
    fuse : Dist [] a -> Dist [] a
    fuse d = fill $ getProof $ fuseHoriz . fuseVert $ d
    

    然后:
    namespace Examples
      ex2 : Dist [] Int
      ex2 = Let Input $
            Concat2 (ConcatMap f (Var here))
                    (ConcatMap g (Var here))
    
      ex2' : Dist [] Int
      ex2' = Let Input $
             Let (ConcatMap (\x => map Left [] ++ map Right (map Left (f x) ++ map Right (g x))) (Var here)) $
             Concat2 (ConcatMap f' (Var here)) (ConcatMap g' (Var here))
        where
          f' : Either () (Either Int Int) -> List Int
          f' = either (const []) $ either return $ const []
    
          g' : Either () (Either Int Int) -> List Int
          g' = either (const []) $ either (const []) $ return
    
      prf2 : fuse ex2 = ex2'
      prf2 = Refl
    

    附录

    我希望我可以将fuseVert融合到fuseHoriz中,因为我认为它所需要的只是一个额外的情况:
    fuseHoriz (ConcatMap f (ConcatMap g d)) = fuseHoriz (ConcatMap (concatMap f . g) d)
    

    但是,这使Idris终止检查程序感到困惑,除非我在assert_smallerConcatMap (concatMap f . g) d上添加了ConcatMap f (ConcatMap g d)),但我不明白为什么,因为其中一层比另一层多一层ConcatMap构造函数。

    关于haskell - 使用标准AST实现同级融合,我们在Stack Overflow上找到一个类似的问题:https://stackoverflow.com/questions/24712273/

    10-12 13:56