我正在尝试使用Data.Reify恢复简单AST的共享（在Type-Safe Observable Sharing in 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（应该同时引入Let和Var）应该简单而简短，但我对de Bruijn没有足够的经验索引，以了解是否有标准的方法来做到这一点。如何将Graph表示转换为Ast表示？
P.S。请注意，这是一个非常简并的情况，因为Ast'实际上没有自己的绑定构造函数;所有绑定都来自共享恢复。
P.P.S。理想情况下，我们不会为单用表达式引入Let（尽管我们可以使用内联传递删除它们。）
答案 0 :(得分：5)
我们将这个问题分为3个部分。第一部分是使用data-reify library恢复AstF的图表。第二部分将创建一个抽象语法树，其中Let绑定用de Bruijn索引表示。最后，我们将删除所有不必要的let绑定。
这些都是我们将沿途使用的所有玩具。 StandaloneDeriving和UndecidableInstances只需Eq和[{1}}个实例来提供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 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从data-reify转换为带有Graph绑定的de Bruijn索引抽象语法树。我们将使用以下类型表示AST。这种类型不需要了解AST的内部表示。
Let 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)
es表示使用变量的位置与声明它的Index之间的Let个数。您应该将Let视为Let a b
我们将图形转换为let (Var 0)=a in b AST的策略是从根节点开始遍历图形。在每个节点，我们将为该节点引入Indexed绑定。对于每个边缘，我们将检查它所引用的节点是否已经在范围内的引入Let绑定中。如果是，我们将用Let绑定的变量替换边。如果Let绑定尚未引入它，我们将遍历它。关于我们正在运行的AST，我们唯一需要了解的是它是Let。
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个。我们将在下一步中删除不必要的Let绑定。
要删除引入未使用变量的Let绑定，我们需要一个使用过的变量的概念。我们将为任何Let AST定义它。
Foldable当我们删除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绑定的数量，以及变量的de Bruijn指数的数量将会改变。我们需要能够从Let AST
Indexed 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
AST的任何地方应用removeUnusedLet。我们可以使用更通用的东西，但我们将自己定义如何在Indexed AST
Indexed然后我们可以用
删除所有未使用的letmapIndexed :: (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的相互递归表示。