使用 de Bruijn 索引将 Data.Reify 显式共享图转换为 AST [英] Converting Data.Reify explicit sharing graph to AST with de Bruijn indices

问题描述

我正在尝试恢复共享(在 Type-Safe使用 Data.Reify 的简单 AST 的 Haskell 意义上的可观察共享:

I'm trying to recover sharing (in the Type-Safe Observable Sharing in Haskell sense) for a simple AST, using Data.Reify:

{-# LANGUAGE DeriveFoldable, DeriveFunctor, DeriveTraversable, TypeFamilies #-}
module Sharing where

import Data.Foldable
import Data.Reify
import Data.Traversable

-- Original AST, without sharing. Expressed as a functor for ease of
-- use with Data.Reify.
data AstF f =
      LitF Int
    | AddF f f
    deriving (Foldable, Functor, Show, Traversable)

newtype Fix f = In { out :: f (Fix f) }

instance Traversable a => MuRef (Fix a) where
    type DeRef (Fix a) = a
    mapDeRef f = traverse f . out

type Ast' = Fix AstF

-- Final AST, with explicit sharing.
data Ast =
      Var Name
    | Let Ast Ast
    | Lit Int
    | Add Ast Ast
    deriving Show

type Name = Int  -- de Bruijn index

-- Recover sharing and introduce Lets/Vars.
recoverSharing :: Ast' -> IO Ast
recoverSharing e = introduceLets `fmap` reifyGraph e
  where
    introduceLets :: Graph (DeRef Ast') -> Ast
    introduceLets = undefined  -- ???

我觉得实现 introduceLets(应该引入 Lets 和 Vars)应该简单而简短，但我对 de Bruijn 指数没有足够的经验来知道是否有标准的方法来做到这一点.您如何将 Graph 表示转换为 Ast 表示?

I have the feeling that implementing introduceLets (which should introduce both Lets and Vars) ought to simple and short, but I don't have enough experience with de Bruijn indices to know if there's a standard way to do it. How would you convert the Graph representation into the Ast representation?

附言请注意，这是一个相当退化的情况，因为 Ast' 实际上没有自己的绑定构造函数；所有绑定都来自共享恢复.

P.S. Note that this is a quite degenerate case, as Ast' doesn't actually have a binding constructor of its own; all bindings come from the sharing recovery.

P.P.S.理想情况下，我们不会为单次使用的表达式引入 Lets(尽管如果我们这样做，我们可以使用内联传递删除它们.)

P.P.S. Ideally we wouldn't introduce Lets for single use expressions (although if we do we can remove them using an inlining pass.)

推荐答案

我们将把这个问题分成 3 个部分.第一部分是使用data-reify library来恢复AstF.第二部分将创建一个抽象语法树，其中 Let 绑定用 de Bruijn 索引表示.最后，我们将删除所有不必要的 let 绑定.​​

We'll divide this problem into 3 parts. The first part is to use the data-reify library to recover the graph of the AstF. The second part will create an abstract syntax tree with Let bindings represented with de Bruijn indices. Finally, we will remove all of the unnecessary let bindings.

这些是我们一路上会用到的所有玩具.StandaloneDeriving 和 UndecidableInstances 只需要为 Fix 之类的东西提供 Eq 和 Show 实例>.

These are all the toys we will use along the way. StandaloneDeriving and UndecidableInstances are only needed to provide Eq and Show instances for things like Fix.

{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}

import Data.Foldable
import Data.Reify
import Data.Traversable
import qualified Data.List as List

import Data.IntMap ((!))
import qualified Data.IntMap as IntMap

import Prelude hiding (any)

使用数据具体化

您几乎已准备好使用 data-reify 库的所有部分.

Use data-reify

You have almost all of the pieces in place to use the data-reify library.

data AstF f =
      LitF Int
    | AddF f f
    deriving (Eq, Show, Functor, Foldable, Traversable)


newtype Fix f = In { out :: f (Fix f) }

deriving instance Eq (f (Fix f)) => Eq (Fix f)
deriving instance Show (f (Fix f)) => Show (Fix f)

instance Traversable a => MuRef (Fix a) where
    type DeRef (Fix a) = a
    mapDeRef f = traverse f . out

缺少的只是对reifyGraph 的调用.让我们尝试一个小例子

All that's missing is the call to reifyGraph. Let's try a small example

do
    let example = In (AddF (In (AddF (In (LitF 1)) (In (LitF 2)))) example)
    graph <- reifyGraph example
    print graph

这个输出

let [(1,AddF 2 1),(2,AddF 3 4),(4,LitF 2),(3,LitF 1)] in 1

graph 的类型为Graph AstF，由构造函数Graph [(Unique, AstF Unique)] Unique 构造.构造函数的第一个参数是具有新唯一键的节点列表.结构中的每条边都已替换为该边首部节点的新唯一键.构造函数的第二个参数是树根节点的唯一键.

graph has the type Graph AstF, and is constructed by the constructor Graph [(Unique, AstF Unique)] Unique. The first argument to the constructor is the list of nodes with their new unique keys. Each edge in the structure has been replaced with the new unique key of the node at the edge's head. The second argument to the constructor is the unique key of the node of the root of the tree.

我们将把 Graph 从 data-reify 转换成带有 Let 绑定的 de Bruijn 索引抽象语法树.我们将使用以下类型表示 AST.这种类型不需要知道任何关于 AST 内部表示的信息.

We will convert the Graph from data-reify into a de Bruijn indexed abstract syntax tree with Let bindings. We will represent the AST using the following type. This type doesn't need to know anything about the internal representation of the AST.

type Index = Int

-- This can be rewritten in terms of Fix and Functor composition
data Indexed f
    = Var Index
    | Let (Indexed f) (Indexed f)
    | Exp (f (Indexed f))

deriving instance Eq (f (Indexed f)) => Eq (Indexed f)
deriving instance Show (f (Indexed f)) => Show (Indexed f)

Indexes 表示使用变量的位置和声明变量的 Let 之间的 Let 的数量.您应该将 Let a b 读作 let (Var 0)=a in b

The Indexes represent the number of Lets between where the variable is used and the Let where it was declared. You should read Let a b as let (Var 0)=a in b

我们将图转换为 Indexed AST 的策略是从根节点开始遍历图.在每个节点，我们将为该节点引入一个 Let 绑定.对于每条边，我们将检查它所引用的节点是否已经在引入的 Let 绑定中，该绑定在范围内.如果是，我们将用 Let 绑定的变量替换边.如果它尚未由 Let 绑定引入，我们将遍历它.关于我们正在操作的 AST，我们唯一需要知道的是它是一个 Functor.

Our strategy to convert the graph into an Indexed AST is to traverse the graph starting at the root node. At every node, we will introduce a Let binding for that node. For every edge we will check to see if the node it refers to is already in an introduced Let binding that is in scope. If it is, we will replace the edge with the variable for that Let binding. If it is not already introduced by a Let binding, we will traverse it. The only thing we need to know about the AST we are operating on is that it is a Functor.

index :: Functor f => Graph (DeRef (Fix f)) -> Indexed f
index (Graph edges root) = go [root]
    where
        go keys@(key:_) =
            Let (Exp (fmap lookup (map ! key))) (Var 0)
                where
                    lookup unique = 
                        case List.elemIndex unique keys of
                            Just n -> Var n
                            Nothing -> go (unique:keys)
        map = IntMap.fromList edges

为方便起见，我们将定义以下内容.

We will define the following for convenience.

reifyLet :: Traversable f => Fix f -> IO (Indexed f)
reifyLet = fmap index . reifyGraph

我们将尝试与之前相同的示例

We'll try the same example as before

do
    let example = In (AddF (In (AddF (In (LitF 1)) (In (LitF 2)))) example)
    lets <- reifyLet example
    print lets

这个输出

Let (Exp (AddF (Let (Exp (AddF (Let (Exp (LitF 1)) (Var 0)) (Let (Exp (LitF 2)) (Var 0)))) (Var 0)) (Var 0))) (Var 0)

我们在 example 中只有 1 个 let 绑定，但这有 4 个 Let .我们将在下一步中删除不必要的 Let 绑定.

We only had 1 let binding in example but this has 4 Lets. We will remove the unnecessary Let binding in the next step.

要移除引入未使用变量的 Let 绑定，我们需要了解已使用变量是什么.我们将为任何 Foldable AST 定义它.

To remove Let bindings that introduce unused variables, we need a notion of what a used variable is. We will define it for any Foldable AST.

used :: (Foldable f) => Index -> Indexed f -> Bool
used x (Var y) = x == y
used x (Let a b) = used (x+1) a || used (x+1) b
used x (Exp a)  = any (used x) a

当我们移除一个 Let 绑定时，介入的 Let 绑定的数量以及变量的 de Bruijn 索引都会改变.我们需要能够从 Indexed AST

When we remove a Let bindings, the number of intervening Let bindings, and thus the de Bruijn indices for variables, will change. We will need to be able to remove a variable from an Indexed AST

remove x :: (Functor f) => Index -> Indexed f -> Indexed f
remove x (Var y) =
    case y `compare` x of
        EQ -> error "Removed variable that's being used`
        LT -> Var y
        GT -> Var (y-1)
remove x (Let a b) = Let (remove (x+1) a) (remove (x+1) b)
remove x (Exp a) = Exp (fmap (remove x) a)

Let 绑定可以通过两种方式引入未使用的变量.变量可以完全不用，例如let a = 1 in 2，也可以随意使用，如let a = 1 in a.第一个可以用 2 代替，第二个可以用 1 代替.当我们移除 Let 绑定时，我们还需要使用 remove 调整 AST 中所有剩余的变量.不是Let的东西不要引入未使用的变量，也没有什么可以替代的.

There are two ways a Let binding can introduce an unused variable. The variable can be completely unused, for example let a = 1 in 2, or it can be trivially used, as in let a = 1 in a. The first can be replaced by 2 and the second can be replaced by 1. When we remove the Let binding, we also need to adjust all of the remaining variables in the AST with remove. Things that aren't Let don't introduce unused variables, and have nothing to replace.

removeUnusedLet :: (Functor f, Foldable f) => Indexed f -> Indexed f
removeUnusedLet (Let a b) =
    if (used 0 b) 
    then
        case b of
            Var 0 ->
                if (used 0 a)
                then (Let a b)
                else remove 0 a
            _     -> (Let a b)
    else remove 0 b
removeUnusedLet x = x

我们希望能够在 Indexed AST 中的任何地方应用 removeUnusedLet.我们可以为此使用更通用的东西，但我们将自己定义如何在 Indexed AST

We'd like to be able to apply removeUnusedLet everywhere in the Indexed AST. We could use something more generic for this, but we'll just define for ourselves how to apply a function everywhere in an Indexed AST

mapIndexed :: (Functor f) => (Indexed f -> Indexed f) -> Indexed f -> Indexed f
mapIndexed f (Let a b) = Let (f a) (f b)
mapIndexed f (Exp a)   = Exp (fmap f a)
mapIndexed f x         = x

postMap :: (Functor f) => (Indexed f -> Indexed f) -> Indexed f -> Indexed f
postMap f = go
    where
        go = f . mapIndexed go

然后我们可以删除所有未使用的 let

Then we can remove all the unused lets with

removeUnusedLets = postMap removeUnusedLet

我们将再次尝试我们的示例

We'll try our example again

do
    let example = In (AddF (In (AddF (In (LitF 1)) (In (LitF 2)))) example)
    lets <- reifyLet example
    let simplified = removeUnusedLets lets
    print simplified

这里只引入了一个 Let

   Let (Exp (AddF (Exp (AddF (Exp (LitF 1)) (Exp (LitF 2)))) (Var 0))) (Var 0)

限制

相互递归的定义不会导致相互递归的 Let 绑定.例如

do
    let
        left   =  In (AddF (In (LitF 1)) right       )
        right   = In (AddF left         (In (LitF 2)))
        example = In (AddF left          right       )
    lets <- reifyLet example
    let simplified = removeUnusedLets lets
    print simplified

结果

Exp (AddF
    (Let (Exp (AddF
        (Exp (LitF 1))
        (Exp (AddF (Var 0) (Exp (LitF 2))))
    )) (Var 0))
    (Let (Exp (AddF
        (Exp (AddF (Exp (LitF 1)) (Var 0)))
        (Exp (LitF 2))
    )) (Var 0)))

我不认为在不使用负 Index 的情况下，Indexed 中的这些存在相互递归表示.

I don't believe there is a mutually recursive representation for these in Indexed without using a negative Index.

这篇关于使用 de Bruijn 索引将 Data.Reify 显式共享图转换为 AST的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！