代码之家 › 专栏 › 技术社区 › rampion

用Uniplate简化GADT

uniplate gadt haskell

14

rampion · 技术社区 · 10 年前

我想回答 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公司 的实例 表达式Int , 表达式布尔 和 双极板 的实例 (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

我笨拙的变通方法是定义 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 为了完成这项工作,我不得不进行包装/展开,这让我觉得不雅观和不对。

有没有 正确的 解决这个问题的方法 具有 单板的 ?

1 回复 | 直到 8 年前

1

7

Community CDub 8 年前

用单板解决这个问题没有正确的方法,但用相同的机制解决这个问题有正确的方法。单极库不支持将数据类型与种类进行单极化 * -> * ,但我们可以创建另一个类来适应这一点。这里有一个用于种类类型的最小单板库 *->* 。它基于当前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 ,但此实例将每个项目放入 适用的 Functor . descend1 简单地将其论点 Identity 和 runIdentity 这就是结果 desend1 与相同 电子地图 因此 transform1 与相同 postmap 从上一个答案中。

现在,我们可以定义 reduce 依据 变压器1 .

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