转换数据。使用de Bruijn索引将显式共享图更新为AST [英] Converting Data.Reify explicit sharing graph to AST with de Bruijn indices
问题描述
我试图恢复分享（在类型安全使用 Data.Reify ：
{ - ＃LANGUAGE DeriveFoldable，DeriveFunctor，DeriveTraversable，TypeFamilies＃ - }
模块共享其中
导入Data.Foldable
导入Data.Reify
导入Data.Traversable
- 原始AST，不共享。表达为
的函数 - 与Data.Reify一起使用。
data AstF f =
LitF Int
| AddF ff
deriving（Foldable，Functor，Show，Traversable）
newtype修复f = In {out :: f（Fix f）}
实例可遍历的a => MuRef（修复a）其中
类型DeRef（修复a）= a
mapDeRef f =遍历f。 out
类型Ast'=修复AstF
- Final AST，显式共享。
data Ast =
Var Name
|让Ast Ast
| Lit Int
|添加Ast Ast
导出显示
类型名称= Int - de Bruijn索引
- 恢复共享并引入Lets / Vars。
recoverSharing :: Ast' - > IO Ast
recoverSharing e = introduceLets`fmap` reifyGraph e
where
introductoryLets :: Graph（DeRef Ast'） - > Ast
introductoryLets = undefined - ???
我感觉执行介绍（这应该引入让 s和 Var s）应该简单和简短，但我没有足够的经验与德Bruijn指数知道是否有一个标准的方式来做到这一点。你如何将图表表示转换为 Ast 表示？
PS请注意，这是一个相当简单的情况，因为 Ast'实际上并没有自己的绑定构造函数;所有绑定来自共享恢复。
P.P.S。理想情况下，我们不会为单次使用表达式引入>让 c>（尽管如果我们这样做了，我们可以使用内联传递将它们删除。）
我们将这个问题分成3部分。第一部分是使用 data-reify库来恢复 AstF的图表。第二部分将创建一个抽象语法树，其中包含用de Bruijn索引表示的 Let 绑定。最后，我们将删除所有不必要的允许绑定。
这些是我们将沿途使用的所有玩具。 StandaloneDeriving 和 UndecidableInstances 仅用于提供 Eq 和显示实例，例如 Fix 。
{ - ＃LANGUAGE TypeFamilies＃ - }
{ - ＃LANGUAGE DeriveFunctor＃ - }
{ - ＃LANGUAGE DeriveFoldable＃ - }
{ - ＃LANGUAGE DeriveTraversable＃ - }
{ - ＃LANGUAGE StandaloneDeriving＃ - }
{ - ＃LANGUAGE UndecidableInstances＃ - }
import Data.Foldable
import Data.Reify
import Data .Traversable
将限定的Data.List导入为列表
导入Data.IntMap（（！））
将限定的Data.IntMap导入为IntMap
导入Prelude hiding（any）
使用data-reify
数据AstF f = $ b您可以使用几乎所有的元素来使用data-reify库。 $ b LitF Int
| AddF ff
deriving（Eq，Show，Functor，Foldable，Traversable）
newtype修正f = In {out :: f（Fix f）}
导出实例Eq（f（Fix f））=>等式（固定f）
导出实例Show（f（Fix f））=>显示（修复f）
实例可穿越的a => MuRef（修复a）其中
类型DeRef（修复a）= a
mapDeRef f =遍历f。 out
缺少的是对 reifyGraph 。让我们来看一个小例子
do
let example = In（AddF（In（AddF（In（LitF 1） ）（In（LitF 2））））example）
graph< - reifyGraph example
print graph
输出
$ p $ let [（1，AddF 2 1），（2，AddF 3 4） ，（4，LitF 2），（3，LitF 1）] in 1
graph 具有类型 Graph AstF ，并由构造函数 Graph [（Unique，AstF Unique）]构造独特。构造函数的第一个参数是具有新唯一键的节点列表。结构中的每条边都被边缘头部节点的新唯一键替换。
将图转换为表示形式
我们将 Graph 从data-reify转换为de Bruijn索引抽象语法树，其中让绑定。我们将使用以下类型来表示AST。这种类型不需要知道任何关于AST的内部表示。
type Index = Int
- 这可以用Fix和Functor的组合来重写
数据索引f
= Var索引
|让（索引f）（索引f）
| Exp（f（Indexed f））
导出实例Eq（f（Indexed f））=> Eq（Indexed f）
导出实例Show（f（Indexed f））=>显示（索引f）
索引 es代表使用变量的地方让>和声明它的让>的数量。您应该阅读让ab 为 let（Var 0）= a in b
我们将图转换为 Indexed AST的策略是遍历从根节点开始的图。在每个节点上，我们将为该节点引入 Let 绑定。对于每条边，我们将检查它所引用的节点是否已经在介绍的 Let 绑定中，该范围内。如果是，我们将用该让绑定的变量替换边缘。如果它尚未由> 绑定引入，我们将遍历它。我们唯一需要知道的关于我们使用的AST的是它是 Functor 。
index :: Functor f =>图（DeRef（Fix f）） - >索引f
索引（图边缘根）= go [root]
其中
转到键@（键：_）=
设（Exp（fmap lookup（map！key） ））（Var 0）
其中
lookup unique =
大小写List.elemIndex
的唯一键Just n - > Var n
Nothing - > go（unique：keys）
map = IntMap.fromList边缘
我们将定义如下为了方便起见。
reifyLet :: Traversable f =>修复f - > IO（索引f）
reifyLet = fmap索引。 reifyGraph
我们将尝试与以前相同的示例
$ b $ （AddF（In（AddF（In（LitF 1））（In（LitF 2））））example）
（$）
$
让< - reifyLet示例
打印让
此输出 $ b $ （Exp（LitF 2））（Exp（LitF 1））（Var 0））（Let（Exp（LitF 2） ）（Var 0））））（Var 0））（Var 0）））（Var 0）
我们只在示例中绑定了1 let ，但它有4 让秒。我们将在下一步删除不必要的 Let 绑定。
删除不必要的`Let`绑定
要除去引入未使用变量的让绑定，我们需要一个使用变量的概念。我们将定义它为任何可折叠 AST。
used ::（可折叠f）=>索引 - >索引的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
当我们移除一个让绑定时，干预让绑定的次数，从而de Bruijn指数为变量，将会改变。我们需要能够从 Indexed AST
删除x ::（Functor f）=>索引 - >索引的f - >索引f
去除x（Var y）=
case y`比较`x
EQ - >错误已删除的正在使用的变量
LT - > Var y
GT - > Var（y-1）
remove x（Let ab）= Let（remove（x + 1 ）a）（删除（x + 1）b）
删除x（Exp a）= Exp（fmap（删除x）a）
let a = 1 in 2 ，或者它可以被轻易地使用，例如 let a = 1在中。第一个可以被替换 2 ，第二个可以替换为 1 。当我们移除让 binding，我们还需要用 remove 来调整AST中所有剩下的变量。不是的事情让不会引入未使用的变量，也无法替换。
removeUnusedLet ::（Functor f，Foldable f）=>索引f - >索引f
removeUnusedLet（让ab）=
if（used 0 b）
then
case b
Var 0 - >
if（used 0 a）
then（Let a b）
else remove 0 a
_ - > （让ab）
else删除0 b
removeUnusedLet x = x
我们我希望能够在 Indexed AST中的任何地方应用 removeUnusedLet 。我们可以为此使用更通用的东西，但我们将自己定义如何在索引 AST
$ b中的任何地方应用函数$ b
mapIndexed ::（Functor f）=> （索引f - >索引f） - >索引的f - >索引f
mapIndexed f（让ab）=令（fa）（fb）
mapIndexed f（Exp a）= Exp（fmap fa）
mapIndexed fx = x
postMap ::（Functor f）=> （索引f - >索引f） - >索引的f - >索引f
postMap f = go
其中
go = f。 mapIndexed go
然后我们可以删除所有未使用的让&b
removeUnusedLets = postMap removeUnusedLet
我们会再次尝试我们的例子
do
let example = In（AddF（In（AddF（In（LitF 1）） （In（LitF 2））））example）
让< - reifyLet示例
let simplified = removeUnusedLets让
打印简化
这只介绍一个让
<$ p $ （AddF（Exp（LitF 1））（Exp（LitF 2））））（Var 0）））（Var 0）
限制
相互递归定义不会导致相互递归让绑定。例如
do
let
left = In（AddF（In（LitF 1））right）
right = In（AddF left（In（LitF 2）））
example = In（AddF left right）
let< - reifyLet example
let simplified = removeUnusedLets let
print simplified
结果
<$ （Exp（LitF 1））
（Exp（AddF（Var 0））（Exp（LitF 2））））
））（Var 0））
（Exp（AddF $ Exp $（ExpF（LitF 1））（Var 0））
（Exp（LitF 2））
））（Var 0）））
I不要在 Indexed 中存在相互递归的表示，而不使用否定的索引。
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 -- ???
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?
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. Ideally we wouldn't introduce Lets for single use expressions (although if we do we can remove them using an inlining pass.)
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.
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)
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
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
This outputs
let [(1,AddF 2 1),(2,AddF 3 4),(4,LitF 2),(3,LitF 1)] in 1
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.
Convert graph to Let representation
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)
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
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
This outputs
Let (Exp (AddF (Let (Exp (AddF (Let (Exp (LitF 1)) (Var 0)) (Let (Exp (LitF 2)) (Var 0)))) (Var 0)) (Var 0))) (Var 0)
We only had 1 let binding in example but this has 4 Lets. We will remove the unnecessary Let binding in the next step.
Remove unnecessary `Let` bindings
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
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)
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
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
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
This introduces only a single Let
Let (Exp (AddF (Exp (AddF (Exp (LitF 1)) (Exp (LitF 2)))) (Var 0))) (Var 0)
Limitations
Mutually recursive definitions don't result in mutually recursive Let bindings. For example
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
Results in
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)))
I don't believe there is a mutually recursive representation for these in Indexed without using a negative Index.
这篇关于转换数据。使用de Bruijn索引将显式共享图更新为AST的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
