haskell - 有效地解释抽象语法图

Question

采用最小语言(显然称为 Hutton's Razor):

{-# OPTIONS_GHC -fno-warn-missing-methods #-}

data Expr =
    Lit Int
  | Add Expr Expr
  deriving (Eq, Show)

instance Num Expr where
  fromInteger = Lit . fromInteger
  (+)         = Add

tree 0 = 1
tree n =
  let shared = tree (n - 1)
  in  shared + shared

如果我们只运行 tree 30在 GHCi 中，类型将默认为 Integer我们将立即得到答案，作为 tree 的递归计算是共享的。但是如果我们运行 tree 30 :: Expr ，我们得到一个巨大的语法树作为 Haskell 的 let 提供的共享。不会转移到嵌入式语言中的表达式。
data-reify library 可用于观察表达式中可能存在的任何隐式共享。我们可以添加一些机制来启用它:

{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TypeFamilies #-}

import Control.Applicative
import Data.Reify

data ExprF e =
    LitF Int
  | AddF e e
  deriving (Eq, Show, Functor)

instance MuRef Expr where
  type DeRef Expr = ExprF
  mapDeRef f (Add e0 e1) = Add <$> f e0 <*> f e1
  mapDeRef _ (Lit d)     = pure (LitF d)

并应用 reifyGraph像 tree 30 :: Expr 这样的表达式的函数现在返回一个图表，其中共享是明确的。这是一个更容易理解的例子:

> reifyGraph (tree 2 :: Expr)
let [(1,AddF 2 2),(2,AddF 3 3),(3,LitF 1)] in 1

所以现在我对解释抽象语法图而不是抽象语法树感兴趣。

一个天真的evalGraph函数通过将共享解释为一棵树来消除共享:

evalGraph (Graph env r) = go r where
  go j = case lookup j env of
    Just (AddF a b) -> go a + go b
    Just (LitF d)   -> d
    Nothing         -> 0

可以通过尝试验证

> evalGraph <$> reifyGraph (tree 50 :: Expr)

在这类事情上没有经验，我发现想出一个简单而有效的 evalGraph 实现非常困难。 .

Oliveira and Löh提供一个示例，其中使用这样的图在代理语言中构建表达式，其中共享是显式的(然后可以在该设置中进行评估)，但如果我只是想要，这似乎是一种不必要的重量级方法立即使用图表。

在保持共享的同时评估这种类型的图的最佳方法是什么？

编辑:

备忘录 Data.StableMemo从一开始就完美地处理所有事情，但是在 DAG 结构中给出一些语法(无论出于何种原因)，我认为拓扑排序 + 内存是正确的方法。

这是一个基于图形的快速/hacky评估器:

import Data.Graph
import Data.Maybe
import System.IO.Unsafe

graphEval :: Expr -> Int
graphEval expr = consume reified where
  reified = unsafePerformIO (toGraph <$> reifyGraph expr)
  toGraph (Reify.Graph env _) = graphFromEdges . map toNode $ env
  toNode (j, AddF a b) = (AddF a b, j, [a, b])
  toNode (j, LitF d)   = (LitF d, j, [])

consume :: Eq a => (Graph, Vertex -> (ExprF a, a, b), c) -> Int
consume (g, vmap, _) = go (reverse . topSort $ g) [] where
  go [] acc = snd $ head acc
  go (v:vs) acc =
    let nacc = evalNode (vmap v) acc : acc
    in  go vs nacc

evalNode :: Eq a => (ExprF a, b, c) -> [(a, Int)] -> (b, Int)
evalNode (LitF d, k, _)   _ = (k, d)
evalNode (AddF a b, k, _) l =
  let v = fromJust ((+) <$> lookup a l <*> lookup b l)
  in  (k, v)

Answer 1

您还不必放弃树方法。确实发生了共享，问题只是即使在共享子表达式上也没有记住函数调用。

通过在 eval 函数中使用基于身份的内存，您可以很容易地解决这个问题。

eval = go
 where go = memo eval'
       eval' (Lit i) = i
       eval' (Add e1 e2) = go e1 + go e2

我使用 stable-memo package 对此进行了测试它似乎运作良好。