{-# LANGUAGE CPP #-}
#if (__GLASGOW_HASKELL__ >= 802)
{-# LANGUAGE DerivingStrategies #-}
#endif
module Swish.Proof
( Proof(..), Step(..)
, checkProof, explainProof, checkStep, showProof, showsProof, showsFormula )
where
import qualified Data.Set as S
import Data.Foldable(Foldable(..))
import Data.List (union, intersect, intercalate)
import Data.Maybe (catMaybes, isNothing)
import Data.String.ShowLines (ShowLines(..))
import Prelude hiding (Foldable(..))
import Swish.Rule (Expression(..), Formula(..), Rule(..))
import Swish.Rule (showsFormula, showsFormulae)
import Swish.Ruleset (Ruleset(..))
data Step ex = Step
{ forall ex. Step ex -> Rule ex
stepRule :: Rule ex
, forall ex. Step ex -> [Formula ex]
stepAnt :: [Formula ex]
, forall ex. Step ex -> Formula ex
stepCon :: Formula ex
} deriving
#if (__GLASGOW_HASKELL__ >= 802)
stock
#endif
Int -> Step ex -> ShowS
[Step ex] -> ShowS
Step ex -> String
(Int -> Step ex -> ShowS)
-> (Step ex -> String) -> ([Step ex] -> ShowS) -> Show (Step ex)
forall ex. Show ex => Int -> Step ex -> ShowS
forall ex. Show ex => [Step ex] -> ShowS
forall ex. Show ex => Step ex -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall ex. Show ex => Int -> Step ex -> ShowS
showsPrec :: Int -> Step ex -> ShowS
$cshow :: forall ex. Show ex => Step ex -> String
show :: Step ex -> String
$cshowList :: forall ex. Show ex => [Step ex] -> ShowS
showList :: [Step ex] -> ShowS
Show
data Proof ex = Proof
{ forall ex. Proof ex -> [Ruleset ex]
proofContext :: [Ruleset ex]
, forall ex. Proof ex -> Formula ex
proofInput :: Formula ex
, forall ex. Proof ex -> Formula ex
proofResult :: Formula ex
, forall ex. Proof ex -> [Step ex]
proofChain :: [Step ex]
}
proofAxioms :: Proof a -> [Formula a]
proofAxioms :: forall a. Proof a -> [Formula a]
proofAxioms = (Ruleset a -> [Formula a]) -> [Ruleset a] -> [Formula a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Ruleset a -> [Formula a]
forall ex. Ruleset ex -> [Formula ex]
rsAxioms ([Ruleset a] -> [Formula a])
-> (Proof a -> [Ruleset a]) -> Proof a -> [Formula a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proof a -> [Ruleset a]
forall ex. Proof ex -> [Ruleset ex]
proofContext
proofRules :: Proof a -> [Rule a]
proofRules :: forall a. Proof a -> [Rule a]
proofRules = (Ruleset a -> [Rule a]) -> [Ruleset a] -> [Rule a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Ruleset a -> [Rule a]
forall ex. Ruleset ex -> [Rule ex]
rsRules ([Ruleset a] -> [Rule a])
-> (Proof a -> [Ruleset a]) -> Proof a -> [Rule a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proof a -> [Ruleset a]
forall ex. Proof ex -> [Ruleset ex]
proofContext
proofAxiomsUsed :: Proof ex -> [Formula ex]
proofAxiomsUsed :: forall a. Proof a -> [Formula a]
proofAxiomsUsed Proof ex
proof = ([Formula ex] -> [Formula ex] -> [Formula ex])
-> [Formula ex] -> [[Formula ex]] -> [Formula ex]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [Formula ex] -> [Formula ex] -> [Formula ex]
forall a. Eq a => [a] -> [a] -> [a]
union [] ([[Formula ex]] -> [Formula ex]) -> [[Formula ex]] -> [Formula ex]
forall a b. (a -> b) -> a -> b
$ (Step ex -> [Formula ex]) -> [Step ex] -> [[Formula ex]]
forall a b. (a -> b) -> [a] -> [b]
map Step ex -> [Formula ex]
stepAxioms (Proof ex -> [Step ex]
forall ex. Proof ex -> [Step ex]
proofChain Proof ex
proof)
where
stepAxioms :: Step ex -> [Formula ex]
stepAxioms Step ex
st = Step ex -> [Formula ex]
forall ex. Step ex -> [Formula ex]
stepAnt Step ex
st [Formula ex] -> [Formula ex] -> [Formula ex]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` Proof ex -> [Formula ex]
forall a. Proof a -> [Formula a]
proofAxioms Proof ex
proof
checkProof ::
(Expression ex, Ord ex)
=> Proof ex -> Bool
checkProof :: forall ex. (Expression ex, Ord ex) => Proof ex -> Bool
checkProof Proof ex
pr =
[Rule ex] -> [ex] -> [Step ex] -> ex -> Bool
forall ex.
(Expression ex, Ord ex) =>
[Rule ex] -> [ex] -> [Step ex] -> ex -> Bool
checkProof1 (Proof ex -> [Rule ex]
forall a. Proof a -> [Rule a]
proofRules Proof ex
pr) [ex]
initExpr (Proof ex -> [Step ex]
forall ex. Proof ex -> [Step ex]
proofChain Proof ex
pr) ex
goalExpr
where
initExpr :: [ex]
initExpr = Formula ex -> ex
forall ex. Formula ex -> ex
formExpr (Proof ex -> Formula ex
forall ex. Proof ex -> Formula ex
proofInput Proof ex
pr) ex -> [ex] -> [ex]
forall a. a -> [a] -> [a]
: (Formula ex -> ex) -> [Formula ex] -> [ex]
forall a b. (a -> b) -> [a] -> [b]
map Formula ex -> ex
forall ex. Formula ex -> ex
formExpr (Proof ex -> [Formula ex]
forall a. Proof a -> [Formula a]
proofAxioms Proof ex
pr)
goalExpr :: ex
goalExpr = Formula ex -> ex
forall ex. Formula ex -> ex
formExpr (Formula ex -> ex) -> Formula ex -> ex
forall a b. (a -> b) -> a -> b
$ Proof ex -> Formula ex
forall ex. Proof ex -> Formula ex
proofResult Proof ex
pr
checkProof1 ::
(Expression ex, Ord ex)
=> [Rule ex] -> [ex] -> [Step ex] -> ex -> Bool
checkProof1 :: forall ex.
(Expression ex, Ord ex) =>
[Rule ex] -> [ex] -> [Step ex] -> ex -> Bool
checkProof1 [Rule ex]
_ [ex]
prev [] ex
res = ex
res ex -> [ex] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ex]
prev
checkProof1 [Rule ex]
rules [ex]
prev (Step ex
st:[Step ex]
steps) ex
res =
[Rule ex] -> [ex] -> Step ex -> Bool
forall ex. Ord ex => [Rule ex] -> [ex] -> Step ex -> Bool
checkStep [Rule ex]
rules [ex]
prev Step ex
st Bool -> Bool -> Bool
&&
[Rule ex] -> [ex] -> [Step ex] -> ex -> Bool
forall ex.
(Expression ex, Ord ex) =>
[Rule ex] -> [ex] -> [Step ex] -> ex -> Bool
checkProof1 [Rule ex]
rules (Formula ex -> ex
forall ex. Formula ex -> ex
formExpr (Step ex -> Formula ex
forall ex. Step ex -> Formula ex
stepCon Step ex
st)ex -> [ex] -> [ex]
forall a. a -> [a] -> [a]
:[ex]
prev) [Step ex]
steps ex
res
checkStep ::
Ord ex
=> [Rule ex]
-> [ex]
-> Step ex
-> Bool
checkStep :: forall ex. Ord ex => [Rule ex] -> [ex] -> Step ex -> Bool
checkStep [Rule ex]
rules [ex]
prev Step ex
step = Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe String -> Bool) -> Maybe String -> Bool
forall a b. (a -> b) -> a -> b
$ [Rule ex] -> [ex] -> Step ex -> Maybe String
forall ex. Ord ex => [Rule ex] -> [ex] -> Step ex -> Maybe String
explainStep [Rule ex]
rules [ex]
prev Step ex
step
explainProof ::
(Expression ex, Ord ex) => Proof ex -> Maybe String
explainProof :: forall ex. (Expression ex, Ord ex) => Proof ex -> Maybe String
explainProof Proof ex
pr =
[Rule ex] -> [ex] -> [Step ex] -> ex -> Maybe String
forall ex.
(Expression ex, Ord ex) =>
[Rule ex] -> [ex] -> [Step ex] -> ex -> Maybe String
explainProof1 (Proof ex -> [Rule ex]
forall a. Proof a -> [Rule a]
proofRules Proof ex
pr) [ex]
initExpr (Proof ex -> [Step ex]
forall ex. Proof ex -> [Step ex]
proofChain Proof ex
pr) ex
goalExpr
where
initExpr :: [ex]
initExpr = Formula ex -> ex
forall ex. Formula ex -> ex
formExpr (Proof ex -> Formula ex
forall ex. Proof ex -> Formula ex
proofInput Proof ex
pr) ex -> [ex] -> [ex]
forall a. a -> [a] -> [a]
: (Formula ex -> ex) -> [Formula ex] -> [ex]
forall a b. (a -> b) -> [a] -> [b]
map Formula ex -> ex
forall ex. Formula ex -> ex
formExpr (Proof ex -> [Formula ex]
forall a. Proof a -> [Formula a]
proofAxioms Proof ex
pr)
goalExpr :: ex
goalExpr = Formula ex -> ex
forall ex. Formula ex -> ex
formExpr (Formula ex -> ex) -> Formula ex -> ex
forall a b. (a -> b) -> a -> b
$ Proof ex -> Formula ex
forall ex. Proof ex -> Formula ex
proofResult Proof ex
pr
explainProof1 ::
(Expression ex, Ord ex)
=> [Rule ex] -> [ex] -> [Step ex] -> ex -> Maybe String
explainProof1 :: forall ex.
(Expression ex, Ord ex) =>
[Rule ex] -> [ex] -> [Step ex] -> ex -> Maybe String
explainProof1 [Rule ex]
_ [ex]
prev [] ex
res =
if ex
res ex -> [ex] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ex]
prev then Maybe String
forall a. Maybe a
Nothing else String -> Maybe String
forall a. a -> Maybe a
Just String
"Result not demonstrated"
explainProof1 [Rule ex]
rules [ex]
prev (Step ex
st:[Step ex]
steps) ex
res =
case [Rule ex] -> [ex] -> Step ex -> Maybe String
forall ex. Ord ex => [Rule ex] -> [ex] -> Step ex -> Maybe String
explainStep [Rule ex]
rules [ex]
prev Step ex
st of
Maybe String
Nothing -> [Rule ex] -> [ex] -> [Step ex] -> ex -> Maybe String
forall ex.
(Expression ex, Ord ex) =>
[Rule ex] -> [ex] -> [Step ex] -> ex -> Maybe String
explainProof1 [Rule ex]
rules (Formula ex -> ex
forall ex. Formula ex -> ex
formExpr (Step ex -> Formula ex
forall ex. Step ex -> Formula ex
stepCon Step ex
st)ex -> [ex] -> [ex]
forall a. a -> [a] -> [a]
:[ex]
prev) [Step ex]
steps ex
res
Just String
ex -> String -> Maybe String
forall a. a -> Maybe a
Just (String
"Invalid step: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ScopedName -> String
forall a. Show a => a -> String
show (Formula ex -> ScopedName
forall ex. Formula ex -> ScopedName
formName (Formula ex -> ScopedName) -> Formula ex -> ScopedName
forall a b. (a -> b) -> a -> b
$ Step ex -> Formula ex
forall ex. Step ex -> Formula ex
stepCon Step ex
st) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ex)
explainStep ::
Ord ex
=> [Rule ex]
-> [ex]
-> Step ex
-> Maybe String
explainStep :: forall ex. Ord ex => [Rule ex] -> [ex] -> Step ex -> Maybe String
explainStep [Rule ex]
rules [ex]
prev Step ex
step =
if [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
errors then Maybe String
forall a. Maybe a
Nothing else String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
errors
where
srul :: Rule ex
srul = Step ex -> Rule ex
forall ex. Step ex -> Rule ex
stepRule Step ex
step
sant :: [ex]
sant = (Formula ex -> ex) -> [Formula ex] -> [ex]
forall a b. (a -> b) -> [a] -> [b]
map Formula ex -> ex
forall ex. Formula ex -> ex
formExpr ([Formula ex] -> [ex]) -> [Formula ex] -> [ex]
forall a b. (a -> b) -> a -> b
$ Step ex -> [Formula ex]
forall ex. Step ex -> [Formula ex]
stepAnt Step ex
step
scon :: ex
scon = Formula ex -> ex
forall ex. Formula ex -> ex
formExpr (Formula ex -> ex) -> Formula ex -> ex
forall a b. (a -> b) -> a -> b
$ Step ex -> Formula ex
forall ex. Step ex -> Formula ex
stepCon Step ex
step
errors :: [String]
errors = [Maybe String] -> [String]
forall a. [Maybe a] -> [a]
catMaybes
[ Bool -> String -> Maybe String
forall {a}. Bool -> a -> Maybe a
require (Rule ex -> ScopedName
forall ex. Rule ex -> ScopedName
ruleName Rule ex
srul ScopedName -> [ScopedName] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Rule ex -> ScopedName) -> [Rule ex] -> [ScopedName]
forall a b. (a -> b) -> [a] -> [b]
map Rule ex -> ScopedName
forall ex. Rule ex -> ScopedName
ruleName [Rule ex]
rules)
(String
"rule " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ScopedName -> String
forall a. Show a => a -> String
show (Rule ex -> ScopedName
forall ex. Rule ex -> ScopedName
ruleName Rule ex
srul) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" not present")
, Bool -> String -> Maybe String
forall {a}. Bool -> a -> Maybe a
require ([ex] -> Set ex
forall a. Ord a => [a] -> Set a
S.fromList [ex]
sant Set ex -> Set ex -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`S.isSubsetOf` [ex] -> Set ex
forall a. Ord a => [a] -> Set a
S.fromList [ex]
prev)
String
"antecedent not axiom or previous result"
, Bool -> String -> Maybe String
forall {a}. Bool -> a -> Maybe a
require (Rule ex -> [ex] -> ex -> Bool
forall ex. Rule ex -> [ex] -> ex -> Bool
checkInference Rule ex
srul [ex]
sant ex
scon)
String
"rule does not deduce consequence from antecedents"
]
require :: Bool -> a -> Maybe a
require Bool
b a
s = if Bool
b then Maybe a
forall a. Maybe a
Nothing else a -> Maybe a
forall a. a -> Maybe a
Just a
s
showsProof ::
(ShowLines ex)
=> String
-> Proof ex
-> ShowS
showsProof :: forall ex. ShowLines ex => String -> Proof ex -> ShowS
showsProof String
newline Proof ex
proof =
if [Formula ex] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Formula ex]
axioms then ShowS
shProof else ShowS
shAxioms ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
shProof
where
axioms :: [Formula ex]
axioms = Proof ex -> [Formula ex]
forall a. Proof a -> [Formula a]
proofAxiomsUsed Proof ex
proof
shAxioms :: ShowS
shAxioms =
String -> ShowS
showString (String
"Axioms:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
newline) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> [Formula ex] -> String -> ShowS
forall ex.
ShowLines ex =>
String -> [Formula ex] -> String -> ShowS
showsFormulae String
newline (Proof ex -> [Formula ex]
forall a. Proof a -> [Formula a]
proofAxiomsUsed Proof ex
proof) String
newline
shProof :: ShowS
shProof =
String -> ShowS
showString (String
"Input:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
newline) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> Formula ex -> ShowS
forall ex. ShowLines ex => String -> Formula ex -> ShowS
showsFormula String
newline (Proof ex -> Formula ex
forall ex. Proof ex -> Formula ex
proofInput Proof ex
proof) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> ShowS
showString (String
newline String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Proof:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
newline) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> [Step ex] -> ShowS
forall ex. ShowLines ex => String -> [Step ex] -> ShowS
showsSteps String
newline (Proof ex -> [Step ex]
forall ex. Proof ex -> [Step ex]
proofChain Proof ex
proof)
showProof ::
(ShowLines ex)
=> String
-> Proof ex
-> String
showProof :: forall ex. ShowLines ex => String -> Proof ex -> String
showProof String
newline Proof ex
proof = String -> Proof ex -> ShowS
forall ex. ShowLines ex => String -> Proof ex -> ShowS
showsProof String
newline Proof ex
proof String
""
showsSteps :: (ShowLines ex) => String -> [Step ex] -> ShowS
showsSteps :: forall ex. ShowLines ex => String -> [Step ex] -> ShowS
showsSteps String
_ [] = ShowS
forall a. a -> a
id
showsSteps String
newline [Step ex
s] = String -> Step ex -> ShowS
forall ex. ShowLines ex => String -> Step ex -> ShowS
showsStep String
newline Step ex
s
showsSteps String
newline (Step ex
s:[Step ex]
ss) = String -> Step ex -> ShowS
forall ex. ShowLines ex => String -> Step ex -> ShowS
showsStep String
newline Step ex
s ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> ShowS
showString String
newline ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> [Step ex] -> ShowS
forall ex. ShowLines ex => String -> [Step ex] -> ShowS
showsSteps String
newline [Step ex]
ss
showsStep :: (ShowLines ex) => String -> Step ex -> ShowS
showsStep :: forall ex. ShowLines ex => String -> Step ex -> ShowS
showsStep String
newline Step ex
s = String -> Formula ex -> ShowS
forall ex. ShowLines ex => String -> Formula ex -> ShowS
showsFormula String
newline (Step ex -> Formula ex
forall ex. Step ex -> Formula ex
stepCon Step ex
s) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> ShowS
showString String
newline ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> ShowS
showString (String
" (by [" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
rulename String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"] from " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
antnames String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")")
where
rulename :: String
rulename = ScopedName -> String
forall a. Show a => a -> String
show (ScopedName -> String)
-> (Rule ex -> ScopedName) -> Rule ex -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rule ex -> ScopedName
forall ex. Rule ex -> ScopedName
ruleName (Rule ex -> String) -> Rule ex -> String
forall a b. (a -> b) -> a -> b
$ Step ex -> Rule ex
forall ex. Step ex -> Rule ex
stepRule Step ex
s
antnames :: String
antnames = [String] -> String
showNames ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Formula ex -> String) -> [Formula ex] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (ScopedName -> String
forall a. Show a => a -> String
show (ScopedName -> String)
-> (Formula ex -> ScopedName) -> Formula ex -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Formula ex -> ScopedName
forall ex. Formula ex -> ScopedName
formName) (Step ex -> [Formula ex]
forall ex. Step ex -> [Formula ex]
stepAnt Step ex
s)
showNames :: [String] -> String
showNames :: [String] -> String
showNames [] = String
"<nothing>"
showNames [String
n] = ShowS
showName String
n
showNames [String
n1,String
n2] = ShowS
showName String
n1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" and " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
showName String
n2
showNames (String
n1:[String]
ns) = ShowS
showName String
n1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
showNames [String]
ns
showName :: String -> String
showName :: ShowS
showName String
n = String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"