resolution/app/Main.hs

module Main where

import FOLSyntax ( Formula(Conj, Neg, Impl), Term(..) )
import Parser ( parseFormula )
import Resolution ( CNF, doResolution )
import Normalforms
    ( makeNNF,
      renameBinders,
      makePNF,
      makeSkolem,
      makeCNF,
      makeClauseSet )

{-
To prove a formula we:
1. Construct `Neg phi`
2. Transform `Neg phi` to a clause list
3. doResolution on clause list
-}
proveFormula :: Formula -> Either () CNF
proveFormula form = doResolution . makeClauseSet . makeCNF . makeSkolem . makePNF . renameBinders . makeNNF $ Neg form

-- unification examples
terma1 :: Term
terma1 = Fun "f" [Var "x", Fun "g" [Var "y"]]
termb1 :: Term
termb1 = Fun "f" [Fun "g" [Var "z"], Var "z"]
terma2 :: Term
terma2 = Fun "f" [Var "x", Fun "g" [Var "x"], Fun "h" [Var "y"]]
termb2 :: Term
termb2 = Fun "f" [Fun "k" [Var "y"], Fun "g" [Var "z"], Var "z"]
terma3 :: Term
terma3 = Fun "f" [Var "x", Fun "g" [Var "x"]]
termb3 :: Term
termb3 = Fun "f" [Var "z", Var "z"]

-- NNF example from gloin
formula1 :: Formula
formula1 = parseFormula "!((A () \\/ !B()) /\\ (C ()))"

-- PNF and skolem example from gloin
formula2 :: Formula
formula2 = parseFormula "forall x. (forall y. L(y,x)) -> exists y.M(x,y)"

-- Resolution example from gloin script
formula3 :: Formula
formula3 = parseFormula "P(a()) /\\ (forall x. P(x) -> P(f(x))) -> (exists x. P(f(f(x)))) "

-- Resolution example from gloin exercises (sheet 11, ex 5) [already in CNF]
formula4 :: Formula
formula4 = parseFormula "((S(f(x), y)) \\/ (S(y, z)) \\/ (P(y))) /\\ (!(S(f(f(x)), x))) /\\ (!P(f(z)))"

-- now a big example, sheet 11, exercise 6: Drogenschmuggel, this doesn't work yet but I'm sure its just the exercise thats wrong...
formula5 :: Formula
formula5 = Impl (Conj phi1 (Conj phi2 phi3)) psi
    where
        phi1 = parseFormula "forall x.E(x) /\\ !I(x) -> exists y.Z(y) /\\ S(y,x)"
        phi2 = parseFormula "exists x. (D(x) /\\ E(x)) /\\ forall y. S(y,x) -> D(y)"
        phi3 = parseFormula "forall x.I(x) -> !D(x)"
        psi = parseFormula "exists x. Z(x) /\\ D(x)"

-- aerzte und quacksalber v2
formula6 :: Formula
formula6 = Impl (Conj psi1 psi2) psi3
    where
        psi1 = parseFormula "forall x. D(x) -> exists y. P(y) /\\ L(y,x)"
        psi2 = parseFormula "forall x. P(x) -> forall y. Q(y) -> !L(x, y)"
        psi3 = parseFormula "forall x. D(x) -> !Q(x)"

main :: IO ()
main = do
    putStrLn $ "Now making NNF of formula: " ++ show formula1
    print $ makeNNF formula1
    putStrLn $ "Now making PNF of formula: " ++ show formula2
    print . makePNF . renameBinders $ makeNNF formula2
    putStrLn $ "Now making Skolemform of formula: " ++ show formula2
    print . makeSkolem . makePNF . renameBinders $ makeNNF formula2
    putStrLn $ "Now proving formula by resolution: " ++ show formula3
    case proveFormula formula3 of
        Left _ -> putStrLn "Success!"
        Right _ -> return ()
    putStrLn $ "Now Proving formula by resolution: " ++ show formula4
    case doResolution $ makeClauseSet formula4 of
        Left _ -> putStrLn "Success!"
        Right _ -> return ()
    putStrLn $ "Now Proving formula by resolution: " ++ show formula5
    case proveFormula formula5 of
        Left _ -> putStrLn "Success!"
        Right _ -> return ()
    putStrLn $ "Now Proving formula by resolution: " ++ show formula6
    case proveFormula (Neg formula6) of
        Left _ -> putStrLn "Success!"
        Right _ -> return ()