64 lines
No EOL
2.1 KiB
Haskell
64 lines
No EOL
2.1 KiB
Haskell
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 _ = [] |