如何简化这种模式匹配？

Question

我试图在 Haskell 中创建一个命题逻辑模型，我需要一个函数来将一些逻辑规则应用于特定的子表达式。函数“apply”获取一个列表，该列表指示子表达式在树中的位置（根据左右序列）、一个逻辑规则和一个逻辑表达式，并返回一个新的逻辑表达式。

data LogicExp  a = P a                              | 
                     True'                      | 
                     False'                                 | 
                     Not' (LogicExp a)                  |  
                     (LogicExp a) :&  (LogicExp a)  | 
                     (LogicExp a) :|  (LogicExp a)  | 
                     (LogicExp a) :=> (LogicExp a)    |
                     (LogicExp a) :=  (LogicExp a)
    deriving Show


type LExp = LogicExp String

data Position = L | R

deMorgan :: LExp -> LExp
deMorgan (e1 :& e2) = Not' ((Not e1) :| (Not e2))
deMorgan (e1 :| e2) = Not' ((Not e1) :& (Not e2))
deMorgan x = x

apply :: [Position] -> (LExp -> LExp) -> LExp -> LExp
apply [] f e = f e
apply (L:xs) f (e1 :& e2) = (apply xs f e1) :& e2
apply (R:xs) f (e1 :& e2) = e1 :& (apply xs f e2)
apply (L:xs) f (e1 :| e2) = (apply xs f e1) :| e2
apply (R:xs) f (e1 :| e2) = e1 :| (apply xs f e2)
apply (L:xs) f (e1 :=> e2) = (apply xs f e1) :=> e2
apply (R:xs) f (e1 :=> e2) = e1 :=> (apply xs f e2)
apply (L:xs) f (e1 := e2) = (apply xs f e1) := e2
apply (R:xs) f (e1 := e2) = e1 := (apply xs f e2)
apply (x:xs) f (Not' e) = apply xs f e

该功能运行良好。但是我可以使用一些数据构造函数“通配符”来拥有像这样更简单的功能吗？

apply :: [Position] -> (LExp -> LExp) -> LExp -> LExp
apply [] f e = f e
apply (L:xs) f (e1 ?? e2) = (apply xs f e1) ?? e2
apply (R:xs) f (e1 ?? e2) = e1 ?? (apply xs f e2)
apply (x:xs) f (Not' e) = apply xs f e

Answer 1

目前我不记得有什么花哨的技巧可以做到这一点。但是，您可能想做的一件事是在 LogicExp 构造函数中分解出通用结构：

data LogicExp a
    = P a
    | True'
    | False'
    | Not' (LogicExp a) 
    | Bin' BinaryOp (LogicExp a) (LogicExp a)
    deriving Show

data BinaryOp = And' | Or' | Impl' | Equiv'
    deriving Show

apply :: [Position] -> (LExp -> LExp) -> LExp -> LExp
apply [] f e = f e
apply (L:xs) f (Bin' op e1 e2) = Bin' op (apply xs f e1) e2
apply (R:xs) f (Bin' op e1 e2) = Bin' op e1 (apply xs f e2)
apply (x:xs) f (Not' e) = apply xs f e
-- ... and the P, True' and False' cases.

这样做你会失去可爱的中缀构造函数。但是，如果您真的想要他们回来，有一个花哨的技巧：view patterns（有关更多示例和讨论，另请参阅this question）。

Answer 2

这是使用其中一个泛型包的经典案例，syb 或 uniplate。

通常uniplate 更快，但不如syb 强大。幸运的是，在这种情况下，您可以使用 uniplate。

使用uniplate的步骤：

1. 使用DeriveDataTypeable 编译指示。
2. 自动导出Data 和Typeable
3. 导入Data.Data 和像Data.Generics.Uniplate.Data 这样的单板模块

您想要的转换函数只是带有适当类型签名的transform：

doit :: LExp -> LExp
doit = transform deMorgan

deMorgan 和你写的完全一样。

完整示例：

{-# LANGUAGE DeriveDataTypeable #-}
module Lib6 where

import Data.Data
import Data.Generics.Uniplate.Data
import Text.Show.Pretty (ppShow)

data LogicExp  a = P a                              |
                     True'                      |
                     False'                                 |
                     Not' (LogicExp a)                  |
                     (LogicExp a) :&  (LogicExp a)  |
                     (LogicExp a) :|  (LogicExp a)  |
                     (LogicExp a) :=> (LogicExp a)    |
                     (LogicExp a) :=  (LogicExp a)
    deriving (Show, Data, Typeable)

type LExp = LogicExp String

data Position = L | R

deMorgan :: LExp -> LExp
deMorgan (e1 :& e2) = Not' ((Not' e1) :| (Not' e2))
deMorgan (e1 :| e2) = Not' ((Not' e1) :& (Not' e2))
deMorgan x = x

doit :: LExp -> LExp
doit = transform deMorgan

example = (P "a" :& P "b") :| (P "c")

test = putStrLn $ ppShow (doit example)

运行test 产生：

Not' (Not' (Not' (Not' (P "a") :| Not' (P "b"))) :& Not' (P "c"))

单板入门教程：

http://community.haskell.org/~ndm/darcs/uniplate/uniplate.htm