BinaryLogic.hs

module BinaryLogic where

type PVar = Int
data Boolean = T | F deriving Show

data Logic a = Boole Boolean | Var PVar | Conn a (Logic a) (Logic a) deriving Show

type Assignment = (PVar -> Boolean)

foldLogic :: Connective b => (Boolean -> a) -> (PVar -> a) -> (b -> a -> a -> a) -> (Logic b) -> a
foldLogic f g h (Boole b) = f b
foldLogic f g h (Var pv) = g pv
foldLogic f g h (Conn c p q) = h c (foldLogic f g h p) (foldLogic f g h q)

evaluate :: Connective c => Assignment -> (Logic c) -> Boolean
evaluate beta = foldLogic id beta apply

makeAssignment :: [(Int, Boolean)] -> Assignment
makeAssignment xs = 
    \i -> case lookup i xs of
           (Just b) -> b
           Nothing -> error ("Assignment not suitable for " ++ show i)

class Connective c where
    apply :: c -> Boolean -> Boolean -> Boolean


--Apply Utility Functions
uNot T _ = F
uNot _ _ = T
uAnd F _ = F
uAnd _ p = p
uOr T _ = T
uOr _ p = p
uImp F _ = T
uImp T p = p
uIff T T = T
uIff F F = T
uIff _ _ = F



--NOR STUFF
data NorConnective = Nor deriving Show
instance Connective NorConnective where
    apply Nor F F = T
    apply Nor _ _ = F
type NorLogic = Logic NorConnective

--NOR uilities
norNot,norOr,norAnd,norXor :: NorLogic -> NorLogic -> NorLogic 
norNot p _ = Conn Nor p p
norOr p q = norNot (Conn Nor p q) p
norAnd p q = Conn Nor (norNot p p) (norNot q q)
norXor p q = Conn Nor (norAnd p q) (Conn Nor p q)



--Propositional STUFF
data PConnective = Not | And | Or | Imp | Iff deriving Show
instance Connective PConnective where
    apply Not = uNot
    apply And = uAnd
    apply Or = uOr
    apply Imp = uImp
    apply Iff = uIff
data PLogic = PLogic deriving Show