How can we print current state value, for debugging purposes? E.g., in code from concrete-example-1 of http://www.haskell.org/haskellwiki/State_Monad , how can we print the current state value after each input character is read?
module StateGame where
import Control.Monad.State
type GameValue = Int
type GameState = (Bool, Int)
playGame :: String -> State GameState GameValue
playGame [] = do
(_, score) <- get
return score
playGame (x:xs) = do
(on, score) <- get
case x of
'a' | on -> put (on, score + 1)
'b' | on -> put (on, score - 1)
'c' -> put (not on, score)
_ -> put (on, score)
playGame xs
startState = (False, 0)
main = print $ evalState (playGame "abcaaacbbcabbab") startState
For quick and dirty debugging, use trace from Debug.Trace. I often find it useful to flip the argument order and define
infixl 0 `debug`
debug :: a -> String -> a
debug = flip trace
Then you can tack the debugging to the end of the line and it's easier to comment out (and at the end remove).
For more principled logging, combine the State with a Writer and tell the logging messages or use StateT s IO if you directly want to log to a file or stderr.
As n.m. points out there is Debug.Trace, but it's easy to write something yourself. However I strongly recommend to use this only for debugging, and to remove it for real world code. Here is an example:
import System.IO.Unsafe
output a b = seq (unsafePerformIO (print a)) b
(output "test" 23) * 25
-- "test"
-- 527
Here output takes an argument to print out, and a return value, behaving like a const, just with a side effect. seq is needed to force the evaluation of print, else laziness will prevent to print anything.
Related
I'm trying to learn how to work with IO in Haskell by writing a function that, if there is a flag, will take a list of points from a file, and if there is no flag, it asks the user to enter them.
dispatch :: [String] -> IO ()
dispatch argList = do
if "file" `elem` argList
then do
let (path : otherArgs) = argList
points <- getPointsFile path
else
print "Enter a point in the format: x;y"
input <- getLine
if (input == "exit")
then do
print "The user inputted list:"
print $ reverse xs
else (inputStrings (input:xs))
if "help" `elem` argList
then help
else return ()
dispatch [] = return ()
dispatch _ = error "Error: invalid args"
getPointsFile :: String -> IO ([(Double, Double)])
getPointsFile path = do
handle <- openFile path ReadMode
contents <- hGetContents handle
let points_str = lines contents
let points = foldl (\l d -> l ++ [tuplify2 $ splitOn ";" d]) [] points_str
hClose handle
return points
I get this: do-notation in pattern Possibly caused by a missing 'do'?` after `if "file" `elem` argList.
I'm also worried about the binding issue, assuming that I have another flag that says which method will be used to process the points. Obviously it waits for points, but I don't know how to make points visible not only in if then else, constructs. In imperative languages I would write something like:
init points
if ... { points = a}
else points = b
some actions with points
How I can do something similar in Haskell?
Here's a fairly minimal example that I've done half a dozen times when I'm writing something quick and dirty, don't have a complicated argument structure, and so can't be bothered to do a proper job of setting up one of the usual command-line parsing libraries. It doesn't explain what went wrong with your approach -- there's an existing good answer there -- it's just an attempt to show what this kind of thing looks like when done idiomatically.
import System.Environment
import System.Exit
import System.IO
main :: IO ()
main = do
args <- getArgs
pts <- case args of
["--help"] -> usage stdout ExitSuccess
["--file", f] -> getPointsFile f
[] -> getPointsNoFile
_ -> usage stderr (ExitFailure 1)
print (frobnicate pts)
usage :: Handle -> ExitCode -> IO a
usage h c = do
nm <- getProgName
hPutStrLn h $ "Usage: " ++ nm ++ " [--file FILE]"
hPutStrLn h $ "Frobnicate the points in FILE, or from stdin if no file is supplied."
exitWith c
getPointsFile :: FilePath -> IO [(Double, Double)]
getPointsFile = {- ... -}
getPointsNoFile :: IO [(Double, Double)]
getPointsNoFile = {- ... -}
frobnicate :: [(Double, Double)] -> Double
frobnicate = {- ... -}
if in Haskell doesn't inherently have anything to do with control flow, it just switches between expressions. Which, in Haskell, happen to include do blocks of statements (if we want to call them that), but you still always need to make that explicit, i.e. you need to say both then do and else do if there are multiple statements in each branch.
Also, all the statements in a do block need to be indented to the same level. So in your case
if "file" `elem` argList
...
if "help" `elem` argList
Or alternatively, if the help check should only happen in the else branch, it needs to be indented to the statements in that do block.
Independent of all that, I would recommend to avoid parsing anything in an IO context. It is usually much less hassle and easier testable to first parse the strings into a pure data structure, which can then easily be processed by the part of the code that does IO. There are libraries like cmdargs and optparse-applicative that help with the parsing part.
I'm trying to find out why the following code has a memory leak:
module Main where
import System.IO
func :: Int -> Int -> ([Int], Int)
func input 0 = ([], input)
func input numTimes = do
let (rest, ret) = func (input + 1) (numTimes - 1)
((input : rest), ret)
main :: IO ()
main = do
hSetBuffering stdout LineBuffering
let (list, final) = func 0 10000000000
listStr = map (\x -> (show x) ++ "\n") list
putStr (foldr (++) "" listStr)
putStr (show final)
printStrs :: [String] -> String -> IO ()
printStrs [] str = do
putStrLn str
printStrs (first : rest) str = do
putStr first
printStrs rest str
When I compile it with ghc --make Main and run it, the top command shows it eating up more and more memory even though the amount of memory it uses should be constant because of lazy evaluation. I've tried using the printStrs function I wrote instead, and it still eats up all memory. I've tried using ghci on the code and using :sprint to print out the thunks from func and it seems like the thunks aren't increasing the amount of memory used for each evaluation of an element in the list.
I honestly don't know what else to do.
The problem is that func will build a huge list and laziness will not be able to avoid it. It reminds me of continuation passing where the order of computations are sequentialized.
I think, the part with foldr is responsible for the memory consumption. By avoiding it and compiling it with ghc -O3, the memory usage is constant in my test:
module Main where
import System.IO
func :: Int -> Int -> ([Int], Int)
func input 0 = ([], input)
func input numTimes = do
let (rest, ret) = func (input + 1) (numTimes - 1)
((input : rest), ret)
main :: IO ()
main = do
hSetBuffering stdout LineBuffering
let (list, final) = func 0 10000000000
mapM_ (putStrLn . show) list
putStr (show final)
In ghci, it still blows the memory. But it might be because the interpreter is not able to optimize the recursion away.
You mention in a comment that
I just want to get intermediate values so I can have some idea of how much progress the program is making and then take the final value as a separate return value
Let's try defining a special-purpose datatype which models the idea of "inspect some bit of progress, or get hold of the final result, if we have finished". Something like
{-# LANGUAGE DeriveFunctor #-}
data Progress a r = Emit a (Progress a r) | Result r
deriving Functor -- maps over the result value r, not over the as
Notice that, unlike ([Int], Int), Progress doesn't give us "direct" access to the final result until we have gone trough all the nested Emit constructors. Hopefully this will help us avoid unexpected dependencies between thunks.
Now let's define func like this:
{-# LANGUAGE BangPatterns #-}
func :: Int -> Int -> Progress Int Int
func input 0 =
Result input
-- the bang avoids the accumulation of thunks behind the input param
func !input numTimes =
Emit input (func (input + 1) (numTimes - 1))
Notice that we don't need to go through all the recursive calls to get hold of the first progress "notification". Even if input is 10000000000, we can pattern-match on the outermost Emit constructor after the first iteration!
The disadvantage of the Progress a r datatype is that we can't easily use regular list functions to print the progress. But we can define our own:
printProgress :: Show a => Progress a r -> IO r
printProgress (Result r) =
pure r
printProgress (Emit a rest) =
do print a
printProgress rest
In practice, we often also want to be able to perform monadic effects at each "step". At that point, it's common to turn to some streaming library like streaming. If you squint a little, the Stream type from "streaming" and similar libraries is basically an effectful list which returns a special result after reaching the end.
I'm learning Monad Transformers and decided to write an interpreter for a simple language(with loop constructs) similar to Brainfuck using Monad Transformers. I would like to terminate the interpreter after certain number of statements.
This simple language is made of single memory cell capable of holding an Int and 5 instructions Input, Output, Increment, Decrement and Loop. A loop terminates when value in the memory is zero. Input is read from a list and similarly output is written to another list. Increment and Decrement does +1 and -1 to memory correspondingly.
I'm using World type to keep track of input, output (streams) and memory, Sum Int to count number of instructions evaluated. Except World to terminate evaluation after certain statements.
module Transformers where
import qualified Data.Map as Map
import Data.Maybe
import Control.Monad.State.Lazy
import Control.Monad.Writer.Lazy
import Control.Monad.Except
data Term = Input
| Output
| Increment
| Decrement
| Loop [Term]
deriving (Show)
data World = World {
inp :: [Int],
out :: [Int],
mem :: Int
} deriving Show
op_limit = 5
loop
:: [Term]
-> StateT World (WriterT (Sum Int) (Except World)) ()
-> StateT World (WriterT (Sum Int) (Except World)) ()
loop terms sp = sp >> do
s <- get
if mem s == 0 then put s else loop terms (foldM (\_ t -> eval t) () terms)
limit :: StateT World (WriterT (Sum Int) (Except World)) ()
limit = do
(s, count) <- listen get
when (count >= op_limit) $ throwError s
tick :: StateT World (WriterT (Sum Int) (Except World)) ()
tick = tell 1
eval :: Term -> StateT World (WriterT (Sum Int) (Except World)) ()
eval Input =
limit >> tick >> modify (\s -> s { inp = tail (inp s), mem = head (inp s) })
eval Output = limit >> tick >> modify (\s -> s { out = mem s : out s })
eval Increment = limit >> tick >> modify (\s -> s { mem = mem s + 1 })
eval Decrement = limit >> tick >> modify (\s -> s { mem = mem s - 1 })
eval (Loop terms) = loop terms (void get)
type Instructions = [Term]
interp :: Instructions -> World -> Either World (World, Sum Int)
interp insts w =
let sp = foldM (\_ inst -> eval inst) () insts
in runExcept (runWriterT (execStateT sp w))
Example run in ghci:
*Transformers> interp [Loop [Output, Decrement]] $ World [] [] 5
Right (World {inp = [], out = [1,2,3,4,5], mem = 0},Sum {getSum = 10})
The monad limit based on count and should decide to either Fail with current state or do nothing. But I noticed that count in (s, count) <- listen get is always zero. I don't understand why is this happening. Please help me understand where I went wrong.
Is my ordering of transformers in the stack correct? Are there any rules (informal) to decide the layering?
Computations inside the Writer monad can't have access to their own accumulator. What's more: the accumulator is never forced while the computation runs, not even to WHNF. This applies to both the strict and lazy variants of Writer—the strict variant is strict in a sense unrelated to the accumulator. This unavoidable laziness in the accumulator can be a source of space leaks if the computation runs for too long.
Your limit function is not branching on the value of the "mainline" WriterT accumulator. The get action (you are using mtl) simply reads the state from the StateT layer, and performs no effects in the other layers: it adds mempty to its WriterT accumulator an throws no error.
Then, the listen extracts the Writer accumulator of the get action (only of the get, not of the whole computation) and adds it to the "mainline" accumulator. But this extracted value (the one returned in the tuple) will always be mempty, that is, Sum 0!
Instead of WriterT, you could put the counter in the StateT state, as #chi has mentioned. You could also use AccumT, which is very similar to WriterT but lets you inspect the accumulator (it also lets you force it to WHNF using bang patterns).
AccumT doesn't seem to have a corresponding mtl typeclass though, so you'll need to sprinkle a few lifts in order to use it.
Being quite new to Haskell, I'm currently trying to improve my skills by writing an interpreter for a simple imperative toy language.
One of the expressions in this language is input, which reads a single integer from standard input. However, when I assign the value of this expression to a variable and then use this variable later, it seems ot me that I actually stored the computation of reading a value rather the read value itself. This means that e.g. the statements
x = input;
y = x + x;
will cause the interpreter to invoke the input procedure three times rather than one.
Internally in the evaluator module, I use a Map to store the values of variables. Because I need to deal with IO, this gets wrapped in an IO monad, as immortalized in the following minimal example:
import qualified Data.Map as Map
type State = Map.Map String Int
type Op = Int -> Int -> Int
input :: String -> IO State -> IO State
input x state = do line <- getLine
st <- state
return $ Map.insert x (read line) st
get :: String -> IO State -> IO Int
get x state = do st <- state
return $ case Map.lookup x st of
Just i -> i
eval :: String -> Op -> String -> IO State -> IO Int
eval l op r state = do i <- get l state
j <- get r state
return $ op i j
main :: IO ()
main = do let state = return Map.empty
let state' = input "x" state
val <- eval "x" (+) "x" state'
putStrLn . show $ val
The second line in the main function simulates the assignment of x, while the third line simulates the evaluation of the binary + operator.
My question is: How do I get around this, such that the code above only inputs once? I suspect that it is the IO-wrapping that causes the problem, but as we're dealing with IO I see no way out of that..?
Remember that IO State is not an actual state, but instead the specification for an IO machine which eventually produces a State. Let's consider input as an IO-machine transformer
input :: String -> IO State -> IO State
input x state = do line <- getLine
st <- state
return $ Map.insert x (read line) st
Here, provided a machine for producing a state, we create a bigger machine which takes that passed state and adding a read from an input line. Again, to be clear, input name st is an IO-machine which is a slight modification of the IO-machine st.
Let's now examine get
get :: String -> IO State -> IO Int
get x state = do st <- state
return $ case Map.lookup x st of
Just i -> i
Here we have another IO-machine transformer. Given a name and an IO-machine which produces a State, get will produce an IO-machine which returns a number. Note again that get name st is fixed to always use the state produced by the (fixed, input) IO-machine st.
Let's combine these pieces in eval
eval :: String -> Op -> String -> IO State -> IO Int
eval l op r state = do i <- get l state
j <- get r state
return $ op i j
Here we call get l and get r each on the same IO-machine state and thus produce two (completely independent) IO-machines get l state and get r state. We then evaluate their IO effects one after another and return the op-combination of their results.
Let's examine the kinds of IO-machines built in main. In the first line we produce a trivial IO-machine, called state, written return Map.empty. This IO-machine, each time it's run, performs no side effects in order to return a fresh, blank Map.Map.
In the second line, we produce a new kind of IO-machine called state'. This IO-machine is based off of the state IO-machine, but it also requests an input line. Thus, to be clear, each time state' runs, a fresh Map.Map is generated and then an input line is read to read some Int, stored at "x".
It should be clear where this is going, but now when we examine the third line we see that we pass state', the IO-machine, into eval. Previously we stated that eval runs its input IO-machine twice, once for each name, and then combines the results. By this point it should be clear what's happening.
All together, we build a certain kind of machine which draws input and reads it as an integer, assigning it to a name in a blank Map.Map. We then build this IO-machine into a larger one which uses the first IO-machine twice, in two separate invocations, in order to collect data and combine it with an Op.
Finally, we run this eval machine using do notation (the (<-) arrow indicates running the machine). Clearly it should collect two separate lines.
So what do we really want to do? Well, we need to simulate ambient state in the IO monad, not just pass around Map.Maps. This is easy to do by using an IORef.
import Data.IORef
input :: IORef State -> String -> IO ()
input ref name = do
line <- getLine
modifyIORef ref (Map.insert name (read line))
eval :: IORef State -> Op -> String -> String -> IO Int
eval ref op l r = do
stateSnapshot <- readIORef ref
let Just i = Map.lookup l stateSnapshot
Just j = Map.lookup l stateSnapshot
return (op i j)
main = do
st <- newIORef Map.empty -- create a blank state, embedded into IO, not a value
input st "x" -- request input *once*
val <- eval st (+) "x" "x" -- compute the op
putStrLn . show $ val
It's fine to wrap your actions such as getLine in IO, but to me it looks like your problem is that you're trying to pass your state in the IO monad. Instead, I think this is probably time you get introduced to monad transformers and how they'll let you layer the IO and State monads to get the functionality of both in one.
Monad transformers are a pretty complex topic and it'll take a while to get to where you're comfortable with them (I'm still learning new things all the time about them), but they're a very useful tool when you need to layer multiple monads. You'll need the mtl library to follow this example.
First, imports
import qualified Data.Map as Map
import Control.Monad.State
Then types
type Op = Int -> Int -> Int
-- Renamed to not conflict with Control.Monad.State.State
type AppState = Map.Map String Int
type Interpreter a = StateT AppState IO a
Here Interpreter is the Monad in which we'll build our interpreter. We also need a way to run the interpreter
-- A utility function for kicking off an interpreter
runInterpreter :: Interpreter a -> IO a
runInterpreter interp = evalStateT interp Map.empty
I figured defaulting to Map.empty was sufficient.
Now, we can build our interpreter actions in our new monad. First we start with input. Instead of returning our new state, we just modify what is current in our map:
input :: String -> Interpreter ()
input x = do
-- IO actions have to be passed to liftIO
line <- liftIO getLine
-- modify is a member of the MonadState typeclass, which StateT implements
modify (Map.insert x (read line))
I had to rename get so that it didn't conflict with get from Control.Monad.State, but it does basically the same thing as before, it just takes our map and looks up that variable in it.
-- Had to rename to not conflict with Control.Monad.State.get
-- Also returns Maybe Int because it's safer
getVar :: String -> Interpreter (Maybe Int)
getVar x = do
-- get is a member of MonadState
vars <- get
return $ Map.lookup x vars
-- or
-- get x = fmap (Map.lookup x) get
Next, eval now just looks up each variable in our map, then uses liftM2 to keep the return value as Maybe Int. I prefer the safety of Maybe, but you can rewrite it if you prefer
eval :: String -> Op -> String -> Interpreter (Maybe Int)
eval l op r = do
i <- getVar l
j <- getVar r
-- liftM2 op :: Maybe Int -> Maybe Int -> Maybe Int
return $ liftM2 op i j
Finally, we write our sample program. It stores user input to the variable "x", adds it to itself, and prints out the result.
-- Now we can write our actions in our own monad
program :: Interpreter ()
program = do
input "x"
y <- eval "x" (+) "x"
case y of
Just y' -> liftIO $ putStrLn $ "y = " ++ show y'
Nothing -> liftIO $ putStrLn "Error!"
-- main is kept very simple
main :: IO ()
main = runInterpreter program
The basic idea is that there is a "base" monad, here IO, and these actions are "lifted" up to the "parent" monad, here StateT AppState. There is a typeclass implementation for the different state operations get, put, and modify in the MonadState typeclass, which StateT implements, and in order to lift IO actions there's a pre-made liftIO function that "lifts" IO actions to the parent monad. Now we don't have to worry about passing around our state explicitly, we can still perform IO, and it has even simplified the code!
I would recommend reading the Real World Haskell chapter on monad transformers to get a better feel for them. There are other useful ones as well, such as ErrorT for handling errors, ReaderT for static configuration, WriterT for aggregating results (usually used for logging), and many others. These can be layered into what is called a transformer stack, and it's not too difficult to make your own either.
Instead of passing an IO State, you can pass State and then use higher-level functions to deal with IO. You can go further and make get and eval free from side-effects:
input :: String -> State -> IO State
input x state = do
line <- getLine
return $ Map.insert x (read line) state
get :: String -> State -> Int
get x state = case Map.lookup x state of
Just i -> i
eval :: String -> Op -> String -> State -> Int
eval l op r state = let i = get l state
j = get r state
in op i j
main :: IO ()
main = do
let state = Map.empty
state' <- input "x" state
let val = eval "x" (+) "x" state'
putStrLn . show $ val
If you're actually building an interpreter, you'll presumably have a list of instructions to execute at some point.
This is my rough translation of your code (although I'm only a beginner myself)
import Data.Map (Map, empty, insert, (!))
import Control.Monad (foldM)
type ValMap = Map String Int
instrRead :: String -> ValMap -> IO ValMap
instrRead varname mem = do
putStr "Enter an int: "
line <- getLine
let intval = (read line)::Int
return $ insert varname intval mem
instrAdd :: String -> String -> String -> ValMap -> IO ValMap
instrAdd varname l r mem = do
return $ insert varname result mem
where result = (mem ! l) + (mem ! r)
apply :: ValMap -> (ValMap -> IO ValMap) -> IO ValMap
apply mem instr = instr mem
main = do
let mem0 = empty
let instructions = [ instrRead "x", instrAdd "y" "x" "x" ]
final <- foldM apply mem0 instructions
print (final ! "y")
putStrLn "done"
The foldM applies a function (apply) to a start value (mem0) and a list (instructions) but does so within a monad.
I am building some moderately large DIMACS files, however with the method used below the memory usage is rather large compared to the size of the files generated, and on some of the larger files I need to generate I run in to out of memory problems.
import Control.Monad.State.Strict
import Control.Monad.Writer.Strict
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad
import qualified Text.Show.ByteString as BS
import Data.List
main = printDIMACS "test.cnf" test
test = do
xs <- freshs 100000
forM_ (zip xs (tail xs))
(\(x,y) -> addAll [[negate x, negate y],[x,y]])
type Var = Int
type Clause = [Var]
data DIMACSS = DS{
nextFresh :: Int,
numClauses :: Int
} deriving (Show)
type DIMACSM a = StateT DIMACSS (Writer B.ByteString) a
freshs :: Int -> DIMACSM [Var]
freshs i = do
next <- gets nextFresh
let toRet = [next..next+i-1]
modify (\s -> s{nextFresh = next+i})
return toRet
fresh :: DIMACSM Int
fresh = do
i <- gets nextFresh
modify (\s -> s{nextFresh = i+1})
return i
addAll :: [Clause] -> DIMACSM ()
addAll c = do
tell
(B.concat .
intersperse (B.pack " 0\n") .
map (B.unwords . map BS.show) $ c)
tell (B.pack " 0\n")
modify (\s -> s{numClauses = numClauses s + length c})
add h = addAll [h]
printDIMACS :: FilePath -> DIMACSM a -> IO ()
printDIMACS file f = do
writeFile file ""
appendFile file (concat ["p cnf ", show i, " ", show j, "\n"])
B.appendFile file b
where
(s,b) = runWriter (execStateT f (DS 1 0))
i = nextFresh s - 1
j = numClauses s
I would like to keep the monadic building of clauses since it is very handy, but I need to overcome the memory problem. How do I optimize the above program so that it doesn't use too much memory?
If you want good memory behavior, you need to make sure that you write out the clauses as you generate them, instead of collecting them in memory and dumping them as such, either using lazyness or a more explicit approach such as conduits, enumerators, pipes or the like.
The main obstacle to that approach is that the DIMACS format expects the number of clauses and variables in the header. This prevents the naive implementation from being sufficiently lazy. There are two possibilities:
The pragmatic one is to write the clauses first to a temporary location. After that the numbers are known, so you write them to the real file and append the contents of the temporary file.
The prettier approach is possible if the generation of clauses has no side effects (besides the effects offered by your DIMACSM monad) and is sufficiently fast: Run it twice, first throwing away the clauses and just calculating the numbers, print the header line, run the generator again; now printing the clauses.
(This is from my experience with implementing SAT-Britney, where I took the second approach, because it fitted better with other requirements in that context.)
Also, in your code, addAll is not lazy enough: The list c needs to be retained even after writing (in the MonadWriter sense) the clauses. This is another space leak. I suggest you implement add as the primitive operation and then addAll = mapM_ add.
As explained in Joachim Breitner's answer the problem was that DIMACSM was not lazy enough, both because the strict versions of the monads was used and because the number of variables and clauses are needed before the ByteString can be written to the file. The solution is to use the lazy versions of the Monads and execute them twice. It turns out that it is also necessary to have WriterT be the outer monad:
import Control.Monad.State
import Control.Monad.Writer
...
type DIMACSM a = WriterT B.ByteString (State DIMACSS) a
...
printDIMACS :: FilePath -> DIMACSM a -> IO ()
printDIMACS file f = do
writeFile file ""
appendFile file (concat ["p cnf ", show i, " ", show j, "\n"])
B.appendFile file b
where
s = execState (execWriterT f) (DS 1 0)
b = evalState (execWriterT f) (DS 1 0)
i = nextFresh s - 1
j = numClauses s