使用de Bruijn索引将Data.Reify显式共享图转换为AST

Question

我正在尝试恢复共享(在Haskell意义上的类型安全可观察共享中)以获得简单的AST,使用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表示？

PS请注意,这是一个非常简并的情况,因为Ast'它实际上没有自己的绑定构造函数; 所有绑定都来自共享恢复.

PPS理想情况下,我们不会Let为单用表达式引入s(但如果我们这样做,我们可以使用内联传递删除它们.)

Answer 1

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

这些都是我们将沿途使用的所有玩具.StandaloneDeriving并且UndecidableInstances只需要提供Eq和Show实例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库的所有部分.

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表示

我们Graph将从data-reify转换为带有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)

的IndexES表示的数目LetS其中所述可变的使用量和之间Let,其中它被宣布.你应该读Let a b作let (Var 0)=a in b

我们将图形转换为IndexedAST的策略是从根节点开始遍历图形.在每个节点,我们将Let为该节点引入绑定.对于每个边缘,我们将检查它所引用的节点是否已经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)

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

删除不必要的`Let`绑定

要删除Let引入未使用变量的绑定,我们需要一个使用过的变量的概念.我们将为任何FoldableAST 定义它.

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指数将发生变化.我们需要能够从IndexedAST中删除变量

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绑定时,我们还需要调整AST中的所有剩余变量remove.事情是不是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

我们希望能够removeUnusedLet在IndexedAST的任何地方应用.我们可以使用更通用的东西,但我们将自己定义如何在IndexedAST中的任何地方应用函数

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

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.