resolution/app/FOLSyntax.hs

module FOLSyntax where

import Data.List ( find )
import Data.Maybe ( fromJust )

data Term = Var String | Fun String [Term] deriving (Eq, Ord)
data Formula
    = Pred String [Term]
    | Neg Formula
    | Conj Formula Formula
    | Disj Formula Formula
    | Impl Formula Formula
    | All String Formula
    | Exists String Formula
    | T
    | F
    deriving (Eq, Ord)


instance Show Term where
    show (Var x) = x
    show (Fun f []) = f
    show (Fun f (x : xs)) = f ++ "(" ++ show x ++ foldr ((++) . (", "++) . show) ")" xs

instance Show Formula where
    show (Pred p []) = p
    show (Pred p (x : xs)) = p ++ "(" ++ show x ++ foldr ((++) . (", "++) . show) ")" xs
    show (Neg f) = "!(" ++ show f ++ ")"
    show (Conj f1 f2) = "(" ++ show f1 ++ " /\\ " ++ show f2 ++ ")"
    show (Disj f1 f2) = "(" ++ show f1 ++ " \\/ " ++ show f2 ++ ")"
    show (Impl f1 f2) = "(" ++ show f1 ++ " -> " ++ show f2 ++ ")"
    show (All x f) = "(forall " ++ x ++ ". " ++ show f ++ ")"
    show (Exists x f) = "(exists " ++ x ++ ". " ++ show f ++ ")"
    show T = "true"
    show F = "false"

-- infinite list of variable names
vars :: [String]
vars = ['v' : show n | n <- [(0 :: Int)..]]

-- finds a fresh variable i.e. a variable not occuring in vs
findFresh :: [String] -> String
findFresh vs = fromJust $ find (`notElem` vs) vars

-- free variables of a term
termFreeVars :: Term -> [String]
termFreeVars (Var x) = [x]
termFreeVars (Fun _ ts) = concatMap termFreeVars ts

-- substitution on terms
termSubst :: Term -> String -> Term -> Term
termSubst t@(Var x) y s = if x == y then s else t
termSubst (Fun f ts) y s = Fun f $ map (\t' -> termSubst t' y s) ts

-- return *all* vars in a formula, i.e. bound ones and free ones
formulaVars :: Formula -> [String]
formulaVars (Pred _ ts) = concatMap termFreeVars ts
formulaVars (Neg f) = formulaVars f
formulaVars (Conj f1 f2) = formulaVars f1 ++ formulaVars f2
formulaVars (Disj f1 f2) = formulaVars f1 ++ formulaVars f2
formulaVars (Impl f1 f2) = formulaVars f1 ++ formulaVars f2
formulaVars (All x f) = x : formulaVars f
formulaVars (Exists x f) = x : formulaVars f
formulaVars _ = []