PROSAGA码农传奇-数据融合-使用标准AST实现兄弟融合

<div class =“post-text”itemprop =“text”>
  
    我创造了一个我将在世界上释放出来的怪物。以下是您在Idris中进行转换的实现。
  
  
    我首先在Haskell中开始研究这个问题，问题是我们本质上是在寻找一种方法来为每个变量收集一组函数
     <code>
 f1 :: a -> b1, f2 :: a -> b2, ...
 </code>
     。在Haskell中提出一个很好的代表是很棘手的，因为一方面，我们想要隐藏
     <code>
 b1, b2, ...
 </code>
     存在主义背后的类型，但另一方面，当我们看到一个
     <code>
 ConcatMap
 </code>
     我们需要构造一个从我们的中提取正确坐标的函数
     <code>
 [Either b1 (Either b2 (...))]
 </code>
     在恰当的类型。
  
  
    所以，首先，让我们通过索引确保我们的变量引用具有良好的范围和良好的类型
     <code>
 Dist
 </code>
     使用范围中的变量并使用De Bruijn索引变量出现：
  
   <pre>
 <code>
 %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

</code>
 </pre>
  
    可以看出，我做了两个简化
     <code>
 Dist
 </code>
    ：
  
  <UL>
    <LI>
      
        无论如何，一切都总是像列表一样，所以
         <code>
 ConcatMap
 </code>
        的类型是
         <code>
 Dist ctx a -> Dist ctx b
 </code>
         代替
         <code>
 Dist ctx (List a) -> Dist ctx (List b)
 </code>
        。只使用原始问题中提供的组合器，唯一的值
         <code>
 Dist
 </code>
         无论如何，一个人可以建立列表。这使得实现更简单（换句话说，在我做出这个改变之前，我遇到了各种不必要的并发症）。
      
    </LI>
    <LI>
      
         <code>
 Concat2
 </code>
         是二元而不是
        
          ñ
        
        进制。更改
         <code>
 fuseHoriz
 </code>
         下面是支持
        
          ñ
        
        -ary concatenation是一个留给读者的练习。
      
    </LI>
  </UL>
  
    让我们首先实现垂直融合，只是为了让我们的脚湿透：
  
   <pre>
 <code>
 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

</code>
 </pre>
  
    到现在为止还挺好：
  
   <pre>
 <code>
 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

</code>
 </pre>
  
    现在是有趣的部分。我们需要很好地表示“来自同一领域的函数集合”以及指向该集合中特定函数（具有特定codomain）的方法。我们将从中收集这些功能
     <code>
 ConcatMap f (Var v)
 </code>
     电话，键入
     <code>
 v
 </code>
    ;然后用一个洞来替换呼叫本身，一旦我们完成收集所有内容就会填充这个洞。
  
  
    当我们遇到
     <code>
 Concat2 d1 d2
 </code>
    ，我们需要合并从两侧收集的功能，然后削弱其中的漏洞
     <code>
 d1
 </code>
     和
     <code>
 d2
 </code>
     超越这个扩展的集合。
由于这个原因，我使用二叉树而不是平面列表：因此弱化很容易实现。
  
  
    它进入自己的命名空间，因为我正在重用它
     <code>
 here
 </code>
    /
     <code>
 there
 </code>
     术语：
  
   <pre>
 <code>
 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

</code>
 </pre>
  
    既然我们已经对给定变量上应用的所有函数的集合进行了表示，那么我们最终可以在实现水平融合方面取得一些进展。
  
  
    重申一下，目标是变成类似的东西
  
   <pre>
 <code>
 let xs = Input :: [A]
in Concat2 (E $ ConcatMap f xs) (F $ ConcatMap g xs)
where
 f :: A -> [B]
 g :: A -> [C]

</code>
 </pre>
  
    变成类似的东西
  
   <pre>
 <code>
 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')

</code>
 </pre>
  
    首先，我们需要能够对memoizer进行编码（定义
     <code>
 xs'
 </code>
    ）从应用的函数集合
     <code>
 xs
 </code>
    ：
  
   <pre>
 <code>
 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)

</code>
 </pre>
  
    如果我们以后不能查看这些记忆结果，那将没有多大用处：
  
   <pre>
 <code>
 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)

</code>
 </pre>
  
    现在，当我们遍历源代码树时，我们当然会收集使用情况（通过
     <code>
 ConcatMap
 </code>
    ）同时有几个变量，因为完全可能有类似的东西
  
   <pre>
 <code>
 let xs = ...
in Concat2 (ConcatMap f xs) (let ys = ... in ... (ConcatMap g xs) ...)

</code>
 </pre>
  
    这将与变量上下文一起填充，因为在每个中都是如此
     <code>
 Let
 </code>
     绑定，我们还可以生成新变量的所有用法的memoizer。
  
   <pre>
 <code>
 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)

</code>
 </pre>
  
    我们将为这些合成变量保留空间：
  
   <pre>
 <code>
 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

</code>
 </pre>
  
    现在我们终于准备好定义优化器的内部中间表示：“
     <code>
 Dist
 </code>
     每个孔代表一个函数在变量上的应用，当我们知道所有用法时，它将被填充，并且我们在范围内拥有它们的所有合成变量：
  
   <pre>
 <code>
 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

</code>
 </pre>
  
    所以一旦我们有这样一个漏洞
     <code>
 Dist
 </code>
    填充它只是走路和解决漏洞的问题：
  
   <pre>
 <code>
 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

</code>
 </pre>
  
    因此，水平融合只是肘部油脂的问题：转动一个
     <code>
 Dist ctx a
 </code>
     进入
     <code>
 HDist us a
 </code>
     每一个
     <code>
 ConcatMap f (Var v)
 </code>
     变成了一个
     <code>
 HHole
 </code>
    。我们需要做一些额外的搞笑结合两个时，跳舞可以移动周围的洞
     <code>
 Usages
 </code>
     来自两个方面
     <code>
 Concat2
 </code>
    。
  
   <pre>
 <code>
 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)

</code>
 </pre>
  
    我们可以通过将它与它结合使用这种怪物
     <code>
 fuseVert
 </code>
     并喂它
     <code>
 fill
 </code>
    ：
  
   <pre>
 <code>
 fuse : Dist [] a -> Dist [] a
fuse d = fill $ getProof $ fuseHoriz . fuseVert $ d

</code>
 </pre>
  
    并且presto：
  
   <pre>
 <code>
 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

</code>
 </pre>
  <H1>
    附录
  </H1>
  
    我希望我能拥有
    
      融合
    
     <code>
 fuseVert
 </code>
     成
     <code>
 fuseHoriz
 </code>
    ，因为我认为它应该需要的是一个额外的案例：
  
   <pre>
 <code>
 fuseHoriz (ConcatMap f (ConcatMap g d)) = fuseHoriz (ConcatMap (concatMap f . g) d)

</code>
 </pre>
  
    然而，除非我添加一个，否则这会混淆Idris终止检查器
     <code>
 assert_smaller
 </code>
     上
     <code>
 ConcatMap (concatMap f . g) d
 </code>
     VS
     <code>
 ConcatMap f (ConcatMap g d))
 </code>
     我不明白为什么，因为一个人有一层
     <code>
 ConcatMap
 </code>
     构造函数比另一个。
  
</DIV>