logo标签列表

将Data.Reify显式共享图转换为使用de Bruijn指数的AST

haskellabstract-syntax-tree
8

我正在尝试使用来恢复简单AST的共享（在Haskell中类型安全的可观察共享的意义上）：

{-# 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表示？
注：这是一个相当恶劣的情况，因为Ast'实际上没有自己的绑定构造函数；所有绑定都来自共享恢复。
另外，理想情况下，我们不会为单次使用的表达式引入Lets（尽管如果我们这样做，我们可以使用内联传递来删除它们）。
3
AstF不应该直接递归 - 这就是Fix的作用。将AddF情况更改为AddF f f，否则无法通过reifyGraph恢复任何共享。另外，如果有人编写递归或相互递归的表达式，您希望发生什么？ De Bruijn指数不能表示它（我想）。最后，我认为这并不是完全微不足道的，因为reifyGraph中绑定列表没有按拓扑排序。 - GS - Apologise to Monica
@GaneshSittampalam 修复了 AstF 的定义。 - tibbe
1个回答
5
我们将把这个问题分为三个部分。第一部分是使用data-reify库来恢复AstF的图形。第二部分将创建一个抽象语法树，其中包含用de Bruijn索引表示的Let绑定。最后，我们将删除所有不必要的let绑定。
这些都是我们沿途使用的工具。只有提供Eq和Show实例的东西（如Fix）才需要使用StandaloneDeriving和UndecidableInstances。
{-# 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

您几乎已经具备了使用 data-reify 库所需的所有要素。

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函数。让我们试一个小例子。

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 构建。构造函数的第一个参数是带有新唯一键的节点列表。结构中的每个边缘都已被替换为边缘头部节点的新唯一键。构造函数的第二个参数是树根节点的唯一键。

将图形转换为 Let 表示

我们将把来自 data-reify 的 Graph 转换为具有 Let 绑定的 de Bruijn 索引抽象语法树。我们将使用以下类型表示 AST。此类型不需要了解 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)
Index表示变量在使用时与声明时之间的Let数。将Let a b解读为let (Var 0)=a in b。
我们将从根节点开始遍历图形，将其转换为Indexed AST。在每个节点上，我们会引入一个Let绑定。对于每条边，我们将检查它所指向的节点是否已经被引入了处于作用域内的Let绑定。如果是，则将该边替换为该Let绑定的变量。如果还没有被引入，则会继续遍历它。我们需要知道的唯一一件事就是我们操作的AST是一个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

为了方便，我们将定义以下内容。

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

我们将尝试与之前相同的示例。
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中只有一个let绑定，但是这里有四个Let。在下一步中，我们将删除不必要的Let绑定。
移除不必要的Let绑定
为了移除引入未使用变量的Let绑定，我们需要一个被使用变量的概念。我们将为任何可折叠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中移除一个变量。

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的东西不会引入未使用的变量，因此没有什么可以替换的。

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中应用函数。请注意保留HTML标记。
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

然后我们可以使用以下代码删除所有未使用的变量：
removeUnusedLets = postMap removeUnusedLet

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

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)))

我不相信在Indexed中有一种互递归的表示方式，而不使用负Index。

有一种更复杂的 removeUnusedLet 版本，它计算了 Let 右侧变量的使用次数，并且如果计数为 1 或更少（并且该变量在左侧未使用），则将所有该变量的出现替换为 Let 左侧。 - Cirdec
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接