Skip to content

kore-repl: do not remove direct children of branchings when using clear command #1952

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
7 changes: 5 additions & 2 deletions kore/src/Kore/Repl/Data.hs
Original file line number Diff line number Diff line change
Expand Up @@ -358,8 +358,8 @@ helpText =
\tryf (<a|c><num>)|<name> attempts <a>xiom or <c>laim at\
\ index <num> or rule with <name>,\
\ and if successful, it will apply it.\n\
\clear [n] removes all node children from the\
\ proof graph\n\
\clear [n] removes all the node's children from the\
\ proof graph (****)\n\
\ (defaults to current node)\n\
\save-session file saves the current session to file\n\
\save-partial-proof [n] file creates a file, <file>.kore, containing a kore module\
Expand Down Expand Up @@ -414,6 +414,9 @@ helpText =
\ the current node is advanced to the (only) non-bottom leaf. If no such\n\
\ leaf exists (i.e the proof is complete), the current node remains the same\n\
\ and a message is emitted.\n\
\ (****) The clear command doesn't allow the removal of nodes which are direct\n\
\ descendants of branchings. The steps which create branchings cannot be\n\
\ partially redone. Therefore, if this were allowed it would result in invalid proofs.\n\
\\n\n\
\Rule names can be added in two ways:\n\
\ a) rule <k> ... </k> [label(myName)]\n\
Expand Down
23 changes: 16 additions & 7 deletions kore/src/Kore/Repl/Interpreter.hs
Original file line number Diff line number Diff line change
Expand Up @@ -32,6 +32,7 @@ import Control.Lens
import qualified Control.Lens as Lens
import Control.Monad
( void
, (<=<)
)
import Control.Monad.Extra
( ifM
Expand Down Expand Up @@ -935,16 +936,19 @@ clear
=> Maybe ReplNode
-- ^ 'Nothing' for current node, or @Just n@ for a specific node identifier
-> m ()
clear =
\case
clear maybeNode = do
graph <- getInnerGraph
case maybeNode of
Nothing -> Lens.use (field @"node") >>= clear . Just
Just node
| unReplNode node == 0 -> putStrLn' "Cannot clear initial node (0)."
| otherwise -> clear0 node
| unReplNode node == 0 ->
putStrLn' "Cannot clear initial node (0)."
| isDirectDescendentOfBranching node graph ->
putStrLn' "Cannot clear a direct descendant of a branching node."
| otherwise -> clear0 node graph
where
clear0 :: ReplNode -> m ()
clear0 rnode = do
graph <- getInnerGraph
clear0 :: ReplNode -> InnerGraph Axiom -> m ()
clear0 rnode graph = do
let node = unReplNode rnode
let
nodesToBeRemoved = collect (next graph) node
Expand All @@ -962,6 +966,11 @@ clear =
prevNode :: InnerGraph axiom -> Graph.Node -> Graph.Node
prevNode graph = fromMaybe 0 . headMay . fmap fst . Graph.lpre graph

isDirectDescendentOfBranching :: ReplNode -> InnerGraph axiom -> Bool
isDirectDescendentOfBranching (ReplNode node) graph =
let childrenOfParent = (Graph.suc graph <=< Graph.pre graph) node
in length childrenOfParent /= 1

-- | Save this sessions' commands to the specified file.
saveSession
:: forall m
Expand Down