我怎样才能简化这种模式匹配？

Question

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

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.

这样做你就失去了可爱的中缀构造函数。但是，如果您真的想要它们回来，可以使用一个花哨的技巧：view patterns (see also this question 以获取更多示例和讨论）。

Answer 2

这是使用泛型包之一的经典案例，syb or uniplate。

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

使用 uniplate 的步骤：

使用 DeriveDataTypeable pragma。
自动导出 Data 和 Typeable
导入 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"))

uniplate 入门教程：

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

我怎样才能简化这种模式匹配？

How can I simplify this pattern matching?

logic

haskell

pattern-matching