递归式透镜

Recursive Type Lensing

我正在尝试创建一些代码,可以采用 任何 递归语法数据类型和该数据类型的任何表达式,并生成相同的所有子表达式的列表类型,建立起来,有点像类型递归上的 scan

我在下面为附带的玩具计算器语法类型编写了两个手动示例 EExp。第一个示例使用 Lens 库中的棱镜和透镜,仅适用于一个 eg1 示例表达式,而第二个函数仅使用手动代码,但适用于任何 EExp 表达式。

理想情况下,我可以使用模板 haskell 或其他东西来自动构建一个递归函数,该函数可以专注于该类型中任何类型的表达式的每个子表达式(例如 prism/lens ), 因此也很容易打印出给它的任何表达式的所有部分的列表。

不过,我对接下来要尝试或研究的内容有点困惑。非常感谢任何帮助!

import qualified Control.Lens as Lens
import qualified Control.Lens.TH as LTH


-- Syntax for toy language

data EExp a
  = ELit a
  | EAdd (EExp a) (EExp a)
  | EMul (EExp a) (EExp a)
  | ESub (EExp a) (EExp a)
  deriving Show

-- build out a set of focus functions using lens / TH

LTH.makePrisms ''EExp


-- An example "text" in the Syntax

eg1 :: EExp Int
eg1 = EAdd
        (ELit 1)
        (EAdd (ELit 2) (ELit 0))

-- using lenses, we build out all the
-- EExp possibilities from the example "text":

lensedOptions :: Show a => EExp a -> [EExp a]
lensedOptions exp =
  let
    maybeGet l = Lens.preview l exp
    listMaybes =
      [ Just exp
      , maybeGet (_EAdd.(Lens._1))
      , maybeGet (_EAdd.(Lens._2))
      , maybeGet (_EAdd.(Lens._2)._EAdd.(Lens._1))
      , maybeGet (_EAdd.(Lens._2)._EAdd.(Lens._2))
      ]
  in
    maybe [] id $ sequenceA listMaybes

printEm :: IO ()
printEm = sequence_ $ map print $ lensedOptions eg1

-- using handwritten code, we build out all the
-- EExp possibilities from the example "text":


buildOptions :: Show a => EExp a -> [EExp a]
buildOptions exp =
  let
    buildBinOpts e1 e2 = [exp] ++ buildOptions e1 ++ buildOptions e2
  in
    case exp of
      ELit i -> [exp]
      EAdd e1 e2 ->
        buildBinOpts e1 e2
      EMul e1 e2 ->
        buildBinOpts e1 e2
      ESub e1 e2 ->
        buildBinOpts e1 e2

printEm2 :: IO ()
printEm2 = sequence_ $ map print $ buildOptions eg1

您正在寻找 Control.Lens.Plated 模块。

先加一个Data推导:

{-# language DeriveDataTypeable #-}
import Data.Data
import Data.Data.Lens
import Control.Lens -- for universeOf function

data EExp a
  = ELit a
  | EAdd (EExp a) (EExp a)
  deriving (Show, Data) 

然后:

> buildOptions eg1
[EAdd (ELit 1) (EAdd (ELit 2) (ELit 0)),ELit 1,EAdd (ELit 2) (ELit 0),ELit 2,ELit 0]

> universeOf uniplate eg1
[EAdd (ELit 1) (EAdd (ELit 2) (ELit 0)),ELit 1,EAdd (ELit 2) (ELit 0),ELit 2,ELit 0]

uniplate 镜头发挥了大部分的作用;使用 Data typeclass, it is able to walk one step into any Data-friendly data structure to find self-similar children. It is also doing some high-altitude caching gymnastics 提供的信息来提高遍历效率,但我们可以安全地忽略它。

universeOf uniplate 重复调用 uniplate 以查找所有可传递后代。

有关 Data.Data 的更多信息,请查看 Lämmel 和 SPJ 的 Scrap Your Boilerplate paper