用Uniplate简化GADT [英] Simplifying a GADT with Uniplate

问题描述

我试图回答这个计算器的问题，使用 uniplate 按我的建议，但只有解决方案，我到目前为止是非常丑陋的。

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

基本上，我们有一个GADT可以解析为 Expression Int 或表达式Bool （忽略 codataIf = If（B真）codataIf codataIf ）：

 数据表达式a其中
 I :: Int  - >表达式Int 
 B :: Bool  - >表达式Bool 
 Add :: Expression Int  - >表达式Int  - >表达式Int 
 Mul ::表达式Int  - >表达式Int  - >表达式Int 
 Eq ::表达式Int  - >表达式Int  - >表达式Bool 
 And :: Expression Bool  - >表达式Bool  - >表达式Bool 
 Or :: Expression Bool  - >表达式Bool  - >表达式Bool 
如果:: Expression Bool  - >表达式a  - >表达式a  - >表达式a 
  

并且（在我的版本中）我们希望能够评估表达式树从下往上使用一个简单的操作将叶子组合成新的叶子：

  step :: Expression a  - >表达式a 
 step = \ case 
 Add（I x）（I y） - > I $ x + y 
 Mul（I x）（I y） - > I x * y 
等式（I x）（I y） - > B x x == y 
并且（B x）（B y） - > B $ x&& y 
或（B x）（B y） - > B $ x || y 
如果（B b）x y  - >如果b则x else y 
 z  - > z 
  

使用 DataDeriving 派生 Uniplate 和 Biplate 实例（这可能应该是一个红旗），所以
我滚为表达式Int ，表达式Bool 拥有 Uniplate 实例，以及（表达式a）（表达式a），（表达式Int）（表达式a） Bool）和（Expression Bool）（Expression Int）。

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

pre $ evalInt :: Expression Int - >表达式Int
evalInt =变换步骤

evalIntBi ::表达式Bool - >表达式Bool
evalIntBi = transformBi（step :: Expression Int - > Expression Int）

evalBool :: Expression Bool - >表达式Bool
evalBool =转换步骤

evalBoolBi ::表达式Int - >表达式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 
λ示例2 
如果（Eq（I 0）（Add（I 0）（I 0）））（B True）（B False）
λevalIntBi it 
 If（Eq （B True）（B False）
λevalBool it 
 B True 
  

我的解决办法是为 Either（Expression Int）（Expression Bool）定义一个 Uniplate 实例：

 类型WExp =或者（Expression Int）（Expression Bool）
 
 instan ce Uniplate WExp其中
 uniplate = \ case 
 Left（Add x y） - >板（i2 Left Add）| * Left x | * Left y 
 Left（Mul x y） - >板（i2左Mul）| *左x | *左y 
向左（如果b x y） - >板（bi2 Left If）| * Right b | * Left x | * Left y 
 Right（Eq x y） - >板（i2 Right Eq）| * Left x | * Left y 
 Right（and x y） - >板（b2右和）| *右x | *右y 
右（或xy） - >板（b2右或）| *右x | *右y 
右（如果b x y） - >板（b3 Right If）| * Right b | * Right x | * Right y 
 e  - > （右x）（左y）=侧（op xy）
 i2 _ _ _ _ =错误类型不匹配
 b2 side op（Right x） （右y）=侧（op xy）
 b2 _ _ _ _ =错误类型不匹配
 bi2 side op（Right x）（Left y）（Left z）= side（op xyz） 
 bi2 _ _ _ _ _ = errortype mismatch
 b3 side op（Right x）（Right y）（Right z）= side（op xyz）
 b3 _ _ _ _ _ =错误类型不匹配
 
 evalWExp :: WExp  - > WExp 
 evalWExp = transform（或者（Left。step）（Right。step））
  

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

 λevalWExp。留下$ example1 
向左（I 1）
λevalWExp。正确的$ example2 
正确的（B真）
  

但是错误和包装/解包我必须这样做才能让这种感觉变得不雅和错误。

是否有< >解决方案

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

  { - ＃LANGUAGE RankNTypes＃ - } 
 
 import Control.Applicative 
 import Control.Monad.Identity 
 
 class Uniplate1 f where 
 uniplate1 :: Applicative m => f a  - > （全部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 => （全部b·f b→m（f b））→> f a  - > m（f a）
 descendM1 = flip uniplate1 
 
 transform1 :: Uniplate1 f => （全部b·f b→f b）→> f a  - > f a 
 transform1 f = f。现在我们可以写一个 Uniplate1  
 $ / code> 


$ b

 实例Uniplate1表达式
 uniplate1 ep = case $ e 
添加xy  - > liftA2 Add（p x）（p y）
 Mul x y  - > liftA 2 Mul（p x）（p y）
 Eq x y  - > liftA2 Eq（p x）（p y）
并且x y  - > liftA2和（p x）（p y）
或x y  - > liftA2或（p x）（p y）
如果b x y  - >纯的如果< *> p b * p x * p y 
 e  - >纯e 
  

这个实例非常类似于 emap 函数我在对原始问题的回答中写道，除了此实例将每个项目放入 Applicative Functor 。 descend1 简单地将其参数提升为标识和 runIdentity 的s结果，使 desend1 与 emap 相同。因此， transform1 与前面的答案中的 postmap 相同。

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

  reduce = transform1步骤
  

运行一个例子：

 reduce
 If（And（B True）（Or（B False）（B True）））（Add（I 1）（Mul（I 2）（I 3）））（I 0）
 I 7 
  

I'm trying to answer this stackoverflow question, using uniplate as I suggested, but the only solution I've come up with so far is pretty ugly.

This seems like a fairly common issue, so I wanted to know if there was a more elegant solution.

Basically, we've got a GADT which resolves to either Expression Int or Expression Bool (ignoring 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

And (in my version of the problem) we want to be able to evaluate the expression tree from the bottom-up using a simple operation to combine leaves into a new leaf:

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

I had some difficulty using DataDeriving to derive Uniplate and Biplate instances (which maybe should have been a red flag), so I rolled my own Uniplate instances for Expression Int, Expression Bool, and Biplate instances for (Expression a) (Expression a), (Expression Int) (Expression Bool), and (Expression Bool) (Expression Int).

This let me come up with these bottom-up traversals:

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)

But since each of these can only do one transformation (combine Int leaves or Bool leaves, but not either), they can't do the complete simplification, but must be chained together manually:

λ 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

My hackish workaround was to define a Uniplate instance for 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))

Now I can do the complete simplification:

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

But the amount of error and wrapping/unwrapping I had to do to make this work just makes this feel inelegant and wrong to me.

Is there a right way to solve this problem with uniplate?

解决方案

There isn't a right way to solve this problem with uniplate, but there is a right way to solve this problem with the same mechanism. The uniplate library doesn't support uniplating a data type with kind * -> *, but we can create another class to accommodate that. Here's a little minimal uniplate library for types of kind * -> *. It is based on the current git version of Uniplate that has been changed to use Applicative instead of 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)

Now we can write a Uniplate1 instance for 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

This instance is very similar to the emap function I wrote in my answer to the original question, except this instance places each item into an Applicative Functor. descend1 simply lifts its argument into Identity and runIdentity's the result, making desend1 identical to emap. Thus transform1 is identical to postmap from the previous answer.

Now, we can define reduce in terms of transform1.

reduce = transform1 step

This is enough to run an example:

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

这篇关于用Uniplate简化GADT的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！