你可以在构建过程中简化，而不是先构建然后反复拆除。所以：
module Simple (Expression, true, false, var, not, or, and) where
import Prelude hiding (not, or, and)
data Expression
= Literal Bool
| Variable String
| Not Expression
| Or Expression Expression
| And Expression Expression
deriving (Eq, Ord, Read, Show)
true = Literal True
false = Literal False
var = Variable
not (Literal True) = false
not (Literal False) = true
not x = Not x
or (Literal True) _ = true
or _ (Literal True) = true
or x y = Or x y
and (Literal False) _ = false
and _ (Literal False) = false
and x y = And x y
我们可以在ghci中试一下：
> and (var "x") (and (var "y") false)
Literal False
请注意构造函数没有被导出: 这确保了使用这些构造函数的人不能避免简化过程。实际上，这可能是一个缺点; 偶尔看到“完整”形式是很好的。处理这个问题的一个标准方法是将输出的智能构造函数作为类型类的一部分; 您可以使用它们来构建“完整”形式或“简化”的方式。为了避免定义类型两次，我们可以使用新类型或虚参; 我在这里选择后者以减少模式匹配中的噪声。
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
module Simple (Format(..), true, false, var, not, or, and) where
import Prelude hiding (not, or, and)
data Format = Explicit | Simplified
data Expression (a :: Format)
= Literal Bool
| Variable String
| Not (Expression a)
| Or (Expression a) (Expression a)
| And (Expression a) (Expression a)
deriving (Eq, Ord, Read, Show)
class Expr e where
true, false :: e
var :: String -> e
not :: e -> e
or, and :: e -> e -> e
instance Expr (Expression Explicit) where
true = Literal True
false = Literal False
var = Variable
not = Not
or = Or
and = And
instance Expr (Expression Simplified) where
true = Literal True
false = Literal False
var = Variable
not (Literal True) = false
not (Literal False) = true
not x = Not x
or (Literal True) _ = true
or _ (Literal True) = true
or x y = Or x y
and (Literal False) _ = false
and _ (Literal False) = false
and x y = And x y
现在在ghci中，我们可以用两种不同的方式“运行”相同的术语：
> :set -XDataKinds
> and (var "x") (and (var "y") false) :: Expression Explicit
And (Variable "x") (And (Variable "y") (Literal False))
> and (var "x") (and (var "y") false) :: Expression Simplified
Literal False
您可能希望稍后添加更多规则；例如，也许您想要：
and (Variable x) (Not (Variable y)) | x == y = false
and (Not (Variable x)) (Variable y) | x == y = false
需要重复两个“模式”的情况有点烦人。我们应该对其进行抽象！数据声明和类将保持不变，但我们将添加帮助函数eitherOrder并在and和or的定义中使用它。以下是使用此想法的更完整的简化集（及我们模块的最终版本）：
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
module Simple (Format(..), true, false, var, not, or, and) where
import Data.Maybe
import Data.Monoid
import Prelude hiding (not, or, and)
import Control.Applicative ((<|>))
data Format = Explicit | Simplified
data Expression (a :: Format)
= Literal Bool
| Variable String
| Not (Expression a)
| Or (Expression a) (Expression a)
| And (Expression a) (Expression a)
deriving (Eq, Ord, Read, Show)
class Expr e where
true, false :: e
var :: String -> e
not :: e -> e
or, and :: e -> e -> e
instance Expr (Expression Explicit) where
true = Literal True
false = Literal False
var = Variable
not = Not
or = Or
and = And
eitherOrder :: (e -> e -> e)
-> (e -> e -> Maybe e)
-> e -> e -> e
eitherOrder fExplicit fSimplified x y = fromMaybe
(fExplicit x y)
(fSimplified x y <|> fSimplified y x)
instance Expr (Expression Simplified) where
true = Literal True
false = Literal False
var = Variable
not (Literal True) = false
not (Literal False) = true
not (Not x) = x
not x = Not x
or = eitherOrder Or go where
go (Literal True) _ = Just true
go (Literal False) x = Just x
go (Variable x) (Variable y) | x == y = Just (var x)
go (Variable x) (Not (Variable y)) | x == y = Just true
go _ _ = Nothing
and = eitherOrder And go where
go (Literal True) x = Just x
go (Literal False) _ = Just false
go (Variable x) (Variable y) | x == y = Just (var x)
go (Variable x) (Not (Variable y)) | x == y = Just false
go _ _ = Nothing
现在在ghci中，我们可以进行更复杂的简化操作，例如：
> and (not (not (var "x"))) (var "x") :: Expression Simplified
Variable "x"
即使我们只编写了一条重写规则，两个命令都可以正常工作：
> and (not (var "x")) (var "x") :: Expression Simplified
Literal False
> and (var "x") (not (var "x")) :: Expression Simplified
Literal False
Not (Variable "True")这样的表达式不会通过类型检查，但重新思考后，Variable String 构造函数并没有返回特殊的东西。对于造成的困惑，我很抱歉！ - Jogger