The Tactic monad is non-associative
Closed this issue · 3 comments
First, a quick example of the problem:
printTac :: String -> Tactic Judgement ()
printTac s = Tactic $ \j -> (T $ reportWarning s) >> return (pure ((), j))
tactic "pair1" [t| forall a b. a -> b -> (a,b) |] $ do
forall
intros_
(split >> printTac "a") >> printTac "b"
assumption
tactic "pair2" [t| forall a b. a -> b -> (a,b) |] $ do
forall
intros_
split >> (printTac "a" >> printTac "b")
assumption
Running the 1st tactic will print out "aabb", and running the 2nd will print out "abab".
The core of this issue is that ProofState
is not a monad transformer. I'm not sure exactly how to fix this at this point.
After messing around for a while, I think I have come to a solution. The general idea is as follows:
newtype TacticT jdg ext m a = TacticT { unTacticT :: jdg -> Client (a, jdg) ext m ext }
instance (Monad m) => Functor (TacticT jdg ext m) where
fmap f (TacticT t) = TacticT $ (request . first f) \>\ t
instance (Monad m) => Applicative (TacticT jdg ext m) where
pure a = TacticT $ \j -> request (a, j)
(TacticT tf) <*> (TacticT ta) = TacticT $ (\(f, j) -> (request . first (f $)) >\\ ta j) \>\ tf
instance (Monad m) => Monad (TacticT jdg ext m) where
return = pure
(TacticT t) >>= k = TacticT $ (\(a, j) -> unTacticT (k a) j) \>\ t
instance MonadTrans (TacticT jdg ext) where
lift m = TacticT $ \j -> do
a <- lift m
request (a, j)
instance (MonadIO m) => MonadIO (TacticT jdg ext m) where
liftIO m = TacticT $ \j -> do
a <- liftIO m
request (a, j)
runTactic :: (Monad m, Show jdg) => TacticT jdg ext m a -> jdg -> m ext
runTactic (TacticT t) j = runEffect $ ((\(_, j) -> fail $ "Unsolved Goal:" ++ show j) >+> t) j
All that needs to be done is to figure out what do do when all of the subgoals are not proved,
and how to dump the intermediate proof state.
EDIT: Slight update: It seems to be very difficult to collect together all of the unsolved goals.
What we are essentially doing here is a streaming, depth-first traversal through all of the subgoals, solving them as we go. Therefore, when we hit our first unsolved goal, we have to bail out.
With a bit of massaging and mmorph
magic, I believe I have ironed out all of the problems!
(<..>) :: (Monad m) => TacticT jdg ext m () -> [TacticT jdg ext m ()] -> TacticT jdg ext m ()
(TacticT t) <..> ts = TacticT $ \j -> flip evalStateT (ts ++ repeat (pure ())) $ distribute $ applyTac >\\ (hoist lift $ t j)
where
applyTac :: (Monad m) => ((), jdg) -> Client ((), jdg) ext (StateT [TacticT jdg ext m ()] m) ext
applyTac (_, j) = do
t <- gets (unTacticT . head)
modify tail
hoist lift $ t j
runTacticT :: (Monad m, Extract ext) => TacticT jdg ext m () -> jdg -> m (ext, [jdg])
runTacticT (TacticT t) j = fmap (second reverse) $ flip runStateT [] $ runEffect $ server +>> (hoist lift $ t j)
where
server :: (MonadState [jdg] m, Extract ext) => ((), jdg) -> Server ((), jdg) ext m ext
server (_, j) = do
modify (j:)
respond hole >>= server
All that remains is a good Alternative
instance, which should be pretty easy.