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的{{1}}，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

我的hackish解决方法是为λ 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定义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 解决此问题？

Answer 1

用uniplate解决这个问题没有正确的方法，但有一种正确的方法可以用同样的机制来解决这个问题。 uniplate库不支持使用类型* -> *单独创建数据类型，但我们可以创建另一个类来适应它。这是类型* -> *类型的一个小的最小uniplate库。它基于Uniplate的当前git版本，已更改为使用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

此实例与我在my answer to the original question中编写的emap函数非常相似，但此实例会将每个项目放入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

使用Uniplate简化GADT

1 个答案: