使用Uniplate简化GADT

Question

我正在尝试按照我的建议回答这个stackoverflow问题,uniplate但到目前为止我提出的唯一解决方案非常难看.

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

基本上,我们有一个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没有正确的方法来解决这个问题,但是有一种正确的方法可以用相同的机制来解决这个问题.uniplate库不支持使用kind来封装数据类型* -> *,但是我们可以创建另一个类来适应它.这是一个类型最小的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我在原始问题的答案中写的函数非常相似,除了这个实例将每个项放入一个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