I'm trying to pause a computation and later resume it on demand (upon a prompt from the user). It should resemble something like the following, only using the continuation monad.
import Control.Monad.IO.Class (liftIO,MonadIO(..))
import Data.Void
f :: MonadIO m => Int -> Int -> m Void
f x y = do
liftIO (print x)
input <- liftIO getLine
if input /= "pause"
then (f (x+1) y)
else (f' y x)
f' :: MonadIO m => Int -> Int -> m Void
f' x y = do
liftIO (print x)
input <- liftIO getLine
if input /= "pause"
then (f' (x-1) y)
else (f y x)
Example output:
λ> f 5 5
5
6
7
8
pause
5
4
3
2
pause
8
9
10
Interrupted.
Original version of the question:
-- Helpers
cond = fmap (not . (== "pause")) getLine
ch b x y = if b then x else y
ch' :: a -> a -> Bool -> a
ch' = flip . (flip ch)
-- Main code
f i i' = liftIO (print i) >> liftIO cond >>= ch' (f (i+1) i') (f' i' i)
f' i i' = liftIO (print i) >> liftIO cond >>= ch' (f' (i-1) i') (f i' i)
Related
I have the following code
newtype State s a = State { runState :: s -> (s,a) }
evalState :: State s a -> s -> a
evalState sa s = snd $ runState sa s
instance Functor (State s) where
fmap f sa = State $ \s ->
let (s',a) = runState sa s in
(s',f a)
instance Applicative (State s) where
pure a = State $ \s -> (s,a)
sf <*> sa = State $ \s ->
let (s',f) = runState sf s
(s'',a) = runState sa s' in
(s'', f a)
instance Monad (State s) where
sa >>= k = State $ \s ->
let (s',a) = runState sa s in
runState (k a) s'
get :: State s s
get = State $ \s -> (s,s)
set :: s -> State s ()
set s = State $ \_ -> (s,())
bar (acc,n) = if n <= 0
then return ()
else
set (n*acc,n-1)
f x = factLoop
factLoop = get >>= bar >>= f
And
runState factLoop (1,7)
gives ((5040,0),())
I'm trying to write the function
factLoop = get >>= bar >>= f
using the do notation
I tried
factLoop' = do
(x,y) <- get
h <- bar (x,y)
return ( f h)
But that does not give the correct type which should be State (Int, Int) ()
Any idea ?
Thanks!
Just remove the return on the final line :
factLoop' = do
(x,y) <- get
h <- bar (x,y)
f h
There is no return in your original code, so there should be none in the do notation version either. do notation simply "translates" uses of >>=, as you've already done.
>>= is infixl 1 (left-associating binary operator), so what you really have is
f x = factLoop
factLoop = get >>= bar >>= f
= (get >>= bar) >>= f
= (get >>= bar) >>= (\x -> f x)
= do { x <- (get >>= bar)
; f x }
= do { _ <- (get >>= bar)
; factLoop }
= do { _ <- (get >>= (\x -> bar x))
; factLoop }
= do { _ <- do { x <- get
; bar x }
; factLoop }
= do { x <- get
; _ <- bar x
; factLoop }
the last one is because of the monad associativity law ("Kleisli composition forms a category").
Doing this in the principled way you don't need to guess. After a little while you get a feeling for it of course, but until you do, being formal helps.
instance Monad ((->) r) where
return x = \_ -> x
h >>= f = \w -> f (h w) w
import Control.Monad.Instances
addStuff :: Int -> Int
addStuff = do
a <- (*2)
b <- (+10)
return (a+b)
I'm trying to understand this monad by unwiding the do notation, because I think the do notation hides what happens.
If I understood correctly, this is what happens:
(*2) >>= (\a -> (+10) >>= (\b -> return (a+b)))
Now, if we take the rule for >>=, we must understand (*2) as h and (\a -> (+10) >>= (\b -> return (a+b))) as f. Applying h to w is easy, let's just say it is 2w (I don't know if 2w is valid in haskell but just for reasoning lets keep it this way. Now we have to apply f to h w or 2w. Well, f simply returns (+10) >>= (\b -> return (a+b)) for an specific a, which is 2w in our case, so f (hw) is (+10) >>= (\b -> return (2w+b)). We must first get what happens to (+10) >>= (\b -> return (2w + b)) before finally applying it to w.
Now we reidentify (+10) >>= (\b -> return (2w + b)) with our rule, so h is +10 and f is (\b -> return (2w + b)). Let's first do h w. We get w + 10. Now we need to apply f to h w. We get (return (2w + w + 10)).
So (return (2w + w + 10)) is what we need to apply to w in the first >>= that we were tyring to uwind. But I'm totally lost and I don't know what happened.
Am I thinking in the rigth way? This is so confusing. Is there a better way to think of it?
You're forgetting that operator >>= doesn't return just f (h w) w, but rather \w -> f (h w) w. That is, it returns a function, not a number.
By substituting it incorrectly you lost the outermost parameter w, so it's no wonder it remains free in your final expression.
To do this correctly, you have to substitute function bodies for their calls completely, without dropping stuff.
If you substitute the outermost >>=, you will get:
(*2) >>= (\a -> ...)
==
\w -> (\a -> ...) (w*2) w
Then, if you substitute the innermost >>=, you get:
\a -> (+10) >>= (\b -> return (a+b))
==
\a -> \w1 -> (\b -> return (a+b)) (w1 + 10) w1
Note that I use w1 instead of w. This is to avoid name collisions later on when I combine the substitutions, because these two ws come from two different lambda abstractions, so they're different variables.
Finally, substitute the return:
return (a+b)
==
\_ -> a+b
Now insert this last substitution into the previous one:
\a -> (+10) >>= (\b -> return (a+b))
==
\a -> \w1 -> (\b -> return (a+b)) (w1 + 10) w1
==
\a -> \w1 -> (\b -> \_ -> a+b) (w1 + 10) w1
And finally insert this into the very first substitution:
(*2) >>= (\a -> ...)
==
\w -> (\a -> ...) (w*2) w
==
\w -> (\a -> \w1 -> (\b -> \_ -> a+b) (w1 + 10) w1) (w*2) w
And now that all substitutions are compete, we can reduce. Start with applying the innermost lambda \b -> ...:
\w -> (\a -> \w1 -> (\_ -> a+w1+10) w1) (w*2) w
Now apply the new innermost lambda \_ -> ...:
\w -> (\a -> \w1 -> a+w1+10) (w*2) w
Now apply \a -> ...:
\w -> (\w1 -> w*2+w1+10) w
And finally apply the only remaining lambda \w1 -> ...:
\w -> w*2+w+10
And voila! The whole function reduces to \w -> (w*2) + (w+10), completely as expected.
First, we write out the implicit argument in your definition explicitly,
addStuff :: Int -> Int
addStuff = do
a <- (*2)
b <- (+10)
return (a+b)
=
addStuff :: Int -> Int
addStuff x = ( do
a <- (*2)
b <- (+10)
return (a+b) ) x
=
....
Then, with
return x = const x
(f =<< h) w = f (h w) w -- (f =<< h) = (h >>= f)
it should be easier to follow and substitute the definitions, line for line:
....
=
( (*2) >>= (\a -> -- (h >>= f) =
(+10) >>= (\b ->
const (a+b) ) ) ) x
=
( (\a -> -- = (f =<< h)
(+10) >>= (\b ->
const (a+b) ) ) =<< (*2) ) x -- (f =<< h) w =
=
(\a ->
(+10) >>= (\b ->
const (a+b) ) ) ( (*2) x) x -- = f (h w) w
=
( let a = (*2) x in -- parameter binding
(+10) >>= (\b ->
const (a+b) ) ) x
=
let a = (*2) x in -- float the let
((\b ->
const (a+b) ) =<< (+10) ) x -- swap the >>=
=
let a = (*2) x in
(\b -> -- (f =<< h) w =
const (a+b) ) ( (+10) x) x -- = f (h w) w
=
let a = (*2) x in
(let b = (+10) x in -- application
const (a+b) ) x
=
let a = (*2) x in -- do a <- (*2)
let b = (+10) x in -- b <- (+10)
const (a+b) x -- return (a+b)
The essence of reader monad is application to same argument shared between all calls.
Intuitively, each function call on the right-hand side of the <- is given an additional argument, which you can think of as the argument to addStuff itself.
Take
addStuff :: Int -> Int
addStuff = do
a <- (*2)
b <- (+10)
return (a+b)
and turn it into
addStuff :: Int -> Int
addStuff x = let a = (*2) x
b = (+10) x
in (a+b)
It looks a little less "strange" if you use the MonadReader instance for (->) r, which provides ask as a way to get direct access to the implicit value.
import Control.Monad.Reader
addStuff :: Int -> Int
addStuff = do
x <- ask -- ask is literally just id in this case
let a = x * 2
let b = x + 10
return (a + b)
I want to extract the value of v from the following code into m2.
It is a little difficult to understand these chains. I am trying to understand the flow for a long, couldn't find any specific solution.
m1 <- newEmptyMVar
m2 <- newEmptyMVar
forkIO $ do
g <- view (hasLens . to seed)
let g' = mkStdGen $ fromMaybe (d' ^. defSeed) g
execStateT (evalRandT runCampaign g') (Campaign ((,Open (-1)) <$> ts) c d') where
step = runUpdate (updateTest v Nothing) >> lift u >> runCampaign
runCampaign = use (hasLens . tests . to (fmap snd)) >>= update
update c = view hasLens >>= \(CampaignConf tl q sl _ _) ->
if | any (\case Open n -> n < tl; _ -> False) c -> callseq v w q >> step
| any (\case Large n _ -> n < sl; _ -> False) c -> step
| otherwise -> lift u
Helping functions
runUpdate :: (MonadState x m, Has Campaign x) => ((SolTest, TestState) -> m (SolTest, TestState)) -> m ()
runUpdate f = use (hasLens . tests) >>= mapM f >>= (hasLens . tests .=)
updateTest :: ( MonadCatch m, MonadRandom m, MonadReader x m, Has TestConf x, Has CampaignConf x)
=> VM -> Maybe (VM, [Tx]) -> (SolTest, TestState) -> m (SolTest, TestState)
I tried to include putMVar m1 v as the following in the step line
step = runUpdate (updateTest v Nothing) >> lift u >> putMVar m1 v >> runCampaign
I thought these are just sequencing, putting putMVar m1 v in between produces following error.
parse error (possibly incorrect indentation or mismatched brackets)
|
192 | runCampaign = use (hasLens . tests . to (fmap snd)) >>= update
| ^
Some extra information
campaign u v w ts d = let d' = fromMaybe defaultDict d in fmap (fromMaybe mempty) (view (hasLens . to knownCoverage)) >>= \c -> do
g <- view (hasLens . to seed)
let g' = mkStdGen $ fromMaybe (d' ^. defSeed) g
execStateT (evalRandT runCampaign g') (Campaign ((,Open (-1)) <$> ts) c d') where
step = runUpdate (updateTest v Nothing) >> lift u >> runCampaign
runCampaign = use (hasLens . tests . to (fmap snd)) >>= update
update c = view hasLens >>= \(CampaignConf tl q sl _ _) ->
if | any (\case Open n -> n < tl; _ -> False) c -> callseq v w q >> step
| any (\case Large n _ -> n < sl; _ -> False) c -> step
| otherwise -> lift u
This is the code I'm trying to work on.
Here, I want to declare one variable m1 <- newEmptyMVar and m2.
Then I want to run the code from 2nd line(through the end) on two threads concurrently using forkIO .
I want v to get stored in m1 & m2 from both the threads. So that I can manually check if both threads have the same v
Hope it helps!
I'm in a situation where I have a data type like
data X = X {foo :: SInteger, bar :: SInteger}
and I want to prove e.g.
forAll_ $ \x -> foo x + bar x .== bar x + foo x
using haskell's sbv.
This doesn't compile because X -> SBool is not an instance of Provable. I can make it an instance with e.g.
instance (Provable p) => Provable (X -> p) where
forAll_ k = forAll_ $ \foo bar -> forAll_ $ k $ X foo bar
forAll (s : ss) k =
forAll ["foo " ++ s, "bar " ++ s] $ \foo bar -> forAll ss $ k $ X foo bar
forAll [] k = forAll_ k
-- and similarly `forSome_` and `forSome`
but this is tedious and error prone (e.g. using forSome when forAll should've been used). Is there a way to automatically derive Provable for my type?
It can at least be made less error-prone:
onX :: (((SInteger, SInteger) -> a) -> b) -> ((X -> a) -> b)
onX f g = f (g . uncurry X)
instance Provable p => Provable (X -> p) where
forAll_ = onX forAll_
forSome_ = onX forSome_
forAll = onX . forAll
forSome = onX . forSome
There's also a generalizable pattern, in case SBV's existing instances for up to 7-tuples are not sufficient.
data Y = Y {a, b, c, d, e, f, g, h, i, j :: SInteger}
-- don't try to write the types of these, you will wear out your keyboard
fmap10 = fmap . fmap . fmap . fmap . fmap . fmap . fmap . fmap . fmap . fmap
onY f g = f (fmap10 g Y)
instance Provable p => Provable (Y -> p) where
forAll_ = onY forAll_
forSome_ = onY forSome_
forAll = onY . forAll
forSome = onY . forSome
Still tedious, though.
Daniel's answer is "as good as it gets" if you really want to use quantifiers directly with your lambda-expressions. However, instead of creating a Provable instance, I'd strongly recommend defining a variant of free for your type:
freeX :: Symbolic X
freeX = do f <- free_
b <- free_
return $ X f b
Now you can use it like this:
test = prove $ do x <- freeX
return $ foo x + bar x .== bar x + foo x
This is much easier to use, and composes well with constraints. For instance, if your data type has the extra constraint that both components are positive, and the first one is larger than the second, then you can write freeX thusly:
freeX :: Symbolic X
freeX = do f <- free_
b <- free_
constrain $ f .> b
constrain $ b .> 0
return $ X f b
Note that this will work correctly in both prove and sat contexts, since free knows how to behave correctly in each case.
I think this is much more readable and easier to use, even though it forces you to use the do-notation. You can also create a version that accepts names, like this:
freeX :: String -> Symbolic X
freeX nm = do f <- free $ nm ++ "_foo"
b <- free $ nm ++ "_bar"
constrain $ f .> b
constrain $ b .> 0
return $ X f b
test = prove $ do x <- freeX "x"
return $ foo x + bar x .== bar x * foo x
Now we get:
*Main> test
Falsifiable. Counter-example:
x_foo = 3 :: Integer
x_bar = 1 :: Integer
You can also make X "parseable" by SBV. In this case the full code looks like this:
data X = X {foo :: SInteger, bar :: SInteger} deriving Show
freeX :: Symbolic X
freeX = do f <- free_
b <- free_
return $ X f b
instance SatModel X where
parseCWs xs = do (x, ys) <- parseCWs xs
(y, zs) <- parseCWs ys
return $ (X (literal x) (literal y), zs)
The following test demonstrates:
test :: IO (Maybe X)
test = extractModel `fmap` (prove $ do
x <- freeX
return $ foo x + bar x .== bar x * foo x)
We have:
*Main> test >>= print
Just (X {foo = -4 :: SInteger, bar = -5 :: SInteger})
Now you can take your counter-examples and post-process them as you wish.
On the page http://en.wikibooks.org/wiki/Haskell/do_Notation, there's a very handy way to transform the do syntax with binding to the functional form (I mean, using >>=). It works well for quite a few case, until I encountered a piece of code involving functions as monad ((->) r)
The code is
addStuff :: Int -> Int
addStuff = do
a <- (*2)
b <- (+10)
return (a+b)
this is equivalent as define
addStuff = \x -> x*2+(x+10)
Now if I use the handy way to rewrite the do part, I get
addStuff = (*2) >>= \a ->
(+10) >>= \b ->
a + b
which gives a compiling error. I understand that a, b are Int (or other types of Num), so the last function (\b -> a + b) has type Int -> Int, instead of Int -> Int -> Int.
But does this mean there's not always a way to transform from do to >>= ? Is there any fix to this? Or I'm just using the rule incorrectly?
Problem to make the last monadic:
addStuff = (*2) >>= \a ->
(+10) >>= \b ->
return (a + b)
(you've already been answered, that) The correct expression must use return on the last line:
addStuff = (*2) >>= \a ->
(+10) >>= \b ->
return (a + b)
(expounding on that, for some clarification) i.e. return is part of a monad definition, not of do notation.
Substituting the actual definitions for ((->) r) monad, it is equivalent to
addStuff x
= ((\a -> (\b -> return (a + b)) =<< (+10) ) =<< (*2) ) x
= (\a -> (\b -> return (a + b)) =<< (+10) ) (x*2) x
= ( (\b -> return ((x*2) + b)) =<< (+10) ) x
= (\b -> return ((x*2) + b)) (x+10) x
= return ((x*2) + (x+10)) x
= const ((x*2) + (x+10)) x
= (x*2) + (x+10)
as expected. So in general, for functions,
do { a <- f ; b <- g ; ... ; n <- h ; return r a b ... n }
is the same as
\ x -> let a = f x in let b = g x in ... let n = h x in r a b ... n
(except that each identifier a,b,...,n shouldn't appear in the corresponding function call, because let bindings are recursive, and do bindings aren't).
The above do code is also exactly how liftM2 is defined in Control.Monad:
> liftM2 (+) (*2) (+10) 100
310
liftM_N for any N can be coded with the use of liftM and ap:
> (\a b c -> a+b+c) `liftM` (*2) `ap` (+10) `ap` (+1000) $ 100
1410
liftM is the monadic equivalent of fmap, which for functions is (.), so
(+) `liftM` (*2) `ap` (+10) $ x
= (+) . (*2) `ap` (+10) $ x
= ((+) . (*2)) x ( (+10) x )
= (x*2) + (x+10)
because ap f g x = f x (g x) for functions (a.k.a. S-combinator).