如何简化此模式匹配？

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

功能正常。 但是我可以使用一些数据构造函数“wildcard”来获得更简单的函数吗？

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.

通过这样做，你失去了可爱的中缀构造函数。 但是，如果你真的想要它们，那么就有一个奇特的技巧： 查看模式 （另请参阅此问题以获取更多示例和讨论）。

Answer 2

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

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

使用uniplate步骤：

1. 使用DeriveDataTypeable pragma。
2. 自动派生Data和可Typeable
3. 导入Data.Data和像Data.Generics.Uniplate.Data这样的uniplate模块

你想仅仅是转换功能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"))

关于uniplate的介绍教程：

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