haskell - 使用 Uniplate 简化 GADT

Question

我正在尝试回答 this stackoverflow question, using uniplate as I suggested ，但 the only solution I've come up with so far 非常难看。

这似乎是一个相当普遍的问题，所以我想知道是否有更优雅的解决方案。

基本上，我们有一个 GADT，它可以解析为 Expression Int 或 Expression Bool (忽略 codataIf = If (B True) codataIf codataIf ):

data Expression a where
    I :: Int -> Expression Int
    B :: Bool -> Expression Bool
    Add :: Expression Int  -> Expression Int  -> Expression Int
    Mul :: Expression Int  -> Expression Int  -> Expression Int
    Eq  :: Expression Int  -> Expression Int  -> Expression Bool
    And :: Expression Bool -> Expression Bool -> Expression Bool
    Or  :: Expression Bool -> Expression Bool -> Expression Bool
    If  :: Expression Bool -> Expression a    -> Expression a -> Expression a

并且(在我的问题版本中)我们希望能够使用一个简单的操作从下到上评估表达式树，将叶子组合成一个新的叶子:

step :: Expression a -> Expression a
step = \case
  Add (I x) (I y)   -> I $ x + y
  Mul (I x) (I y)   -> I $ x * y
  Eq (I x) (I y)    -> B $ x == y
  And (B x) (B y)   -> B $ x && y
  Or (B x) (B y)    -> B $ x || y
  If (B b) x y      -> if b then x else y
  z                 -> z

我在使用 DataDeriving 派生 Uniplate 和 Biplate 实例时遇到了一些困难(这可能应该是一个危险信号)，所以
我为 Uniplate 、 Expression Int 和 Expression Bool 实例为 Biplate 、 (Expression a) (Expression a) 和 (Expression Int) (Expression Bool) 滚动了我自己的 (Expression Bool) (Expression Int) 实例。

这让我想出了这些自下而上的遍历:

evalInt :: Expression Int -> Expression Int
evalInt = transform step

evalIntBi :: Expression Bool -> Expression Bool
evalIntBi = transformBi (step :: Expression Int -> Expression Int)

evalBool :: Expression Bool -> Expression Bool
evalBool = transform step

evalBoolBi :: Expression Int -> Expression Int
evalBoolBi = transformBi (step :: Expression Bool -> Expression Bool)

但是由于它们中的每一个都只能进行一次转换(组合 Int 叶子或 Bool 叶子，但两者都不能)，它们不能进行完全简化，而必须手动链接在一起:

λ example1
If (Eq (I 0) (Add (I 0) (I 0))) (I 1) (I 2)
λ evalInt it
If (Eq (I 0) (I 0)) (I 1) (I 2)
λ evalBoolBi it
If (B True) (I 1) (I 2)
λ evalInt it
I 1
λ example2
If (Eq (I 0) (Add (I 0) (I 0))) (B True) (B False)
λ evalIntBi it
If (Eq (I 0) (I 0)) (B True) (B False)
λ evalBool it
B True

我的 hackish 解决方法是为 Uniplate 定义一个 Either (Expression Int) (Expression Bool) 实例:

type  WExp = Either (Expression Int) (Expression Bool)

instance Uniplate WExp where
  uniplate = \case
      Left (Add x y)    -> plate (i2 Left Add)  |* Left x  |* Left y
      Left (Mul x y)    -> plate (i2 Left Mul)  |* Left x  |* Left y
      Left (If b x y)   -> plate (bi2 Left If)  |* Right b |* Left x  |* Left y
      Right (Eq x y)    -> plate (i2 Right Eq)  |* Left x  |* Left y
      Right (And x y)   -> plate (b2 Right And) |* Right x |* Right y
      Right (Or x y)    -> plate (b2 Right Or)  |* Right x |* Right y
      Right (If b x y)  -> plate (b3 Right If)  |* Right b |* Right x |* Right y
      e                 -> plate e
    where i2 side op (Left x) (Left y) = side (op x y)
          i2 _ _ _ _ = error "type mismatch"
          b2 side op (Right x) (Right y) = side (op x y)
          b2 _ _ _ _ = error "type mismatch"
          bi2 side op (Right x) (Left y) (Left z) = side (op x y z)
          bi2 _ _ _ _ _ = error "type mismatch"
          b3 side op (Right x) (Right y) (Right z) = side (op x y z)
          b3 _ _ _ _ _ = error "type mismatch"

evalWExp :: WExp -> WExp
evalWExp = transform (either (Left . step) (Right . step))

现在我可以做完整的简化:

λ evalWExp . Left $ example1
Left (I 1)
λ evalWExp . Right $ example2
Right (B True)

但是为了完成这项工作，我必须做大量的 error 和包装/展开，这让我觉得这不雅和错误。

有没有用 uniplate 解决这个问题 的正确方法？

Answer 1

单板没有解决这个问题的正确方法，但是有一个正确的方法可以用相同的机制解决这个问题。 uniplate 库不支持对类型为 * -> * 的数据类型进行单板化。 ，但我们可以创建另一个类来适应它。这是一个用于种类类型的最小单板库* -> * .它基于当前 git 版本的 Uniplate已更改为使用 Applicative而不是 Str .

{-# LANGUAGE RankNTypes #-}

import Control.Applicative
import Control.Monad.Identity

class Uniplate1 f where
    uniplate1 :: Applicative m => f a -> (forall b. f b -> m (f b)) -> m (f a)

    descend1 :: (forall b. f b -> f b) -> f a -> f a
    descend1 f x = runIdentity $ descendM1 (pure . f) x

    descendM1 :: Applicative m => (forall b. f b -> m (f b)) -> f a -> m (f a)
    descendM1 = flip uniplate1

transform1 :: Uniplate1 f => (forall b. f b -> f b) -> f a -> f a
transform1 f = f . descend1 (transform1 f)

现在我们可以写一个 Uniplate1 Expression 的实例:

instance Uniplate1 Expression where
    uniplate1 e p = case e of
        Add x y -> liftA2 Add (p x) (p y)
        Mul x y -> liftA2 Mul (p x) (p y)
        Eq  x y -> liftA2 Eq  (p x) (p y)
        And x y -> liftA2 And (p x) (p y)
        Or  x y -> liftA2 Or  (p x) (p y)
        If  b x y -> pure If <*> p b <*> p x <*> p y
        e -> pure e

此实例与 emap 非常相似。我在 my answer to the original question 中写的函数，除了此实例将每个项目放入 Applicative Functor . descend1简单地将它的论点提升为 Identity和 runIdentity的结果，使 desend1等同于 emap .因此 transform1等同于 postmap从上一个答案。

现在，我们可以定义 reduce根据 transform1 .

reduce = transform1 step

这足以运行一个示例:

"reduce"
If (And (B True) (Or (B False) (B True))) (Add (I 1) (Mul (I 2) (I 3))) (I 0)
I 7