プログラミング Haskell 第10章 型とクラスの定義 その2

今日は第10章の例題の恒真式判定をするプログラムを写経してみたのですが、常に結果に True を返してしまうバグがあるのでそれを探すので時間切れでした。
というかまだ原因をみつけられません。どうやって調査しよう。

明日までにバグを取って次に進みたいところです。

見つけたー。bools 0 を空リスト1つのリストにするところをただの空リストにしていたせいで bools が常に空リストを返していました。

Bool <= Bool なんて演算子の使いかたがあるのを知りました。

module Tautology
where

data Prop = Const Bool
          | Var Char
          | Not Prop
          | And Prop Prop
          | Imply Prop Prop

type Assoc k v = [(k, v)]

find :: Eq k => k -> Assoc k v -> v
find k t = head [v | (kk, v) <- t, k == kk]

type Subst = Assoc Char Bool

eval :: Subst -> Prop -> Bool
eval _ (Const b) = b
eval s (Var x)     = find x s
eval s (Not p)     = not (eval s p)
eval s (And p q)   = eval s p && eval s q
eval s (Imply p q) = eval s p <= eval s q

vars :: Prop -> [Char]
vars (Const _)   = []
vars (Var x)     = [x]
vars (Not p)     = vars p
vars (And p q)   = vars p ++ vars q
vars (Imply p q) = vars p ++ vars q

bools :: Int -> [[Bool]]
bools 0 = [[]]
bools (n+1) = map (False:) bss ++ map (True:) bss
              where bss = bools n

rmdups :: Eq a => [a] -> [a]
rmdups [] = []
rmdups (x:xs) = x : rmdups (filter (/= x) xs)

substs :: Prop -> [Subst]
substs p = map (zip vs) (bools (length vs))
           where vs = rmdups (vars p)

isTaut :: Prop -> Bool
isTaut p = and [eval s p| s <- substs p]