I am playing around with the machines module by Edward Kmett, and I'm getting a little confused here and there. I thought the best way to ask a question is to provide a toy use case. Described below.
Machines one and two sit at two prongs of a Wye.
Machine one takes as param a list of ints, and pushes it down stream.
Machine two takes as param a list of chars, and pushes it down stream.
Machine three keeps an internal state, beginning at mempty, then mappends the elements it receives from either machines from the Wye base on some condition (so not both). Machine three then gets the current state and pushes it downtream.
Machine four prints the elements it receives to console.
So far I've got this:
y1 :: PlanT k [Int] m ()
y1 = yield
y2 :: PlanT k [Char] m ()
y2 = yield
But I'm not sure how to combine y1 and y2; or roll an arbitrary process that hides a state, as opposed to using one of the stock combinators exported by Process.hs.
Per suggestion, the link to the machines package:
http://hackage.haskell.org/package/machines
And a pdf giving a very high level description of what it does: https://dl.dropboxusercontent.com/u/4588997/Machines.pdf
I'm also a beginer with machines, here is my result:
import Control.Monad
import Data.Char (intToDigit)
import Data.Machine
import Data.Machine.Plan
import Data.Machine.Source
-- | Produces integers from a list.
m1 :: [Int] -> Source Int
m1 = source
-- | Produces characters from a list.
m2 :: [Char] -> Source Char
m2 = source
-- | Reads a number from its left input. Then reads this many
-- characters from its right input. Outputs the resulting string,
-- together with the number of strings produced so far.
m3 :: Tee Int Char (Int, String)
m3 = construct (loop 0)
where
-- `loop` keeps internal state - the count of strings
-- produced so far.
loop count = do
-- Read a number from L.
n <- awaits L
-- Read this many characters from L.
s <- replicateM n (awaits R)
let count' = count + 1
-- Output the result.
yield (count', s)
loop count'
main = print . run $ tee (m1 [2,3,4,5])
(m2 "Lorem ipsum dolor sit amet") m3
I haven't used a monoid in m3, I used plain numbers instead, but the idea is the same. I also used Tee instead of Wye, because my example needs deterministic input - it chooses if it reads from L or R. But using Wye for a similar purpose would be just the same.
Update: Surely it's possible to use State instead of Identity to keep track of the count. For example:
m3State :: TeeT (State Int) Int Char (Int, String)
m3State = repeatedly $ do
n <- awaits L
s <- replicateM n (awaits R)
lift (modify (+ 1)) -- increment the counter
count <- lift get -- get the counter to output it
yield (count, s)
main = print . flip evalState 0 . runT $ input m3State
I suspect that using repeatedly on a plan is slightly faster than having an explicit monadic loop, but I think in this small example the difference is negligible.
Or if we wanted to just count the number of strings and output it only at the end, we could use Writer (Sum Int) instead. Full code here.
Related
I want to do some infinite sequence of IO actions processing with filtration their results in realtime+perfoming some IO actions in certain moments:
We have some function for reducing sequences (see my question haskell elegant way to filter (reduce) sequences of duplicates from infinte list of numbers):
f :: Eq a => [a] -> [a]
f = map head . group
and expression
join $ sequence <$> ((\l -> (print <$> l)) <$> (f <$> (sequence $ replicate 6 getLine)))
if we run this, user can generate any seq of numbers, for ex:
1
2
2
3
3
"1"
"2"
"3"
[(),(),()]
This means that at first all getLine actions performed (6 times in the example and at the end of this all IO actions for filtered list performed, but I want to do IO actions exactly in the moments then sequencing reduces done for some subsequences of same numbers.
How can I archive this output:
1
2
"1"
2
3
"2"
3
3
"3"
[(),(),()]
So I Want this expression not hangs:
join $ sequence <$> ((\l -> (print <$> l)) <$> (f <$> (sequence $ repeat getLine)))
How can I archive real-time output as described above without not blocking it on infinite lists?
Without a 3rd-party library, you can lazily read the contents of standard input, appending a dummy string to the end of the expected input to force output. (There's probably a better solution that I'm stupidly overlooking.)
import System.IO
print_unique :: (String, String) -> IO ()
print_unique (last, current) | last == current = return ()
| otherwise = print last
main = do
contents <- take 6 <$> lines <$> hGetContents stdin
traverse print_unique (zip <*> tail $ (contents ++ [""]))
zip <*> tail produces tuples consisting of the ith and i+1st lines without blocking. print_unique then immediately outputs a line if the following line is different.
Essentially, you are sequencing the output actions as the input is executed, rather than sequencing the input actions.
This seems like a job for a streaming library, like streaming.
{-# LANGUAGE ImportQualifiedPost #-}
module Main where
import Streaming
import Streaming.Prelude qualified as S
main :: IO ()
main =
S.mapM_ print
. S.catMaybes
. S.mapped S.head
. S.group
$ S.replicateM 6 getLine
"streaming" has an API reminiscent to that of lists, but works with effectful sequences.
The nice thing about streaming's version of group is that it doesn't force you to keep the whole group in memory if it isn't needed.
The least intuitive function in this answer is mapped, because it's very general. It's not obvious that streaming's version of head fits as its parameter. The key idea is that the Stream type can represent both normal effectful sequences, and sequences of elements on which groups have been demarcated. This is controlled by changing a functor type parameter (Of in the first case, a nested Stream (Of a) m in the case of grouped Streams).
mapped let's you transform that functor parameter while having some effect in the underlying monad (here IO). head processes the inner Stream (Of a) m groups, getting us back to an Of (Maybe a) functor parameter.
I found a nice solution with iterateUntilM
iterateUntilM (\_->False) (\pn -> getLine >>= (\n -> if n==pn then return n else (if pn/="" then print pn else return ()) >> return n) ) ""
I don't like some verbose with
(if pn/="" then print pn else return ())
if you know how to reduce this please comment)
ps.
It is noteworthy that I made a video about this function :)
And could not immediately apply it :(
I beg for your help, speeding up the following program:
main = do
jobsToProcess <- fmap read getLine
forM_ [1..jobsToProcess] $ \_ -> do
[r, k] <- fmap (map read . words) getLine :: IO [Int]
putStrLn $ doSomeReallyLongWorkingJob r k
There could(!) be a lot of identical jobs to do, but it's not up to me modifying the inputs, so I tried to use Data.HashMap for backing up already processed jobs. I already optimized the algorithms in the doSomeReallyLongWorkingJob function, but now it seems, it's quite as fast as C.
But unfortunately it seems, I'm not able to implement a simple cache without producing a lot of errors. I need a simple cache of Type HashMap (Int, Int) Int, but everytime I have too much or too few brackets. And IF I manage to define the cache, I'm stuck in putting data into or retrieving data from the cache cause of lots of errors.
I already Googled for some hours but it seems I'm stuck. BTW: The result of the longrunner is an Int as well.
It's pretty simple to make a stateful action that caches operations. First some boilerplate:
{-# LANGUAGE FlexibleContexts #-}
import Control.Monad.State
import Data.Map (Map)
import qualified Data.Map as M
import Debug.Trace
I'll use Data.Map, but of course you can substitute in a hash map or any similar data structure without much trouble. My long-running computation will just add up its arguments. I'll use trace to show when this computation is executed; we'll hope not to see the output of the trace when we enter a duplicate input.
reallyLongRunningComputation :: [Int] -> Int
reallyLongRunningComputation args = traceShow args $ sum args
Now the caching operation will just look up whether we've seen a given input before. If we have, we'll return the precomputed answer; otherwise we'll compute the answer now and store it.
cache :: (MonadState (Map a b) m, Ord a) => (a -> b) -> a -> m b
cache f x = do
mCached <- gets (M.lookup x)
case mCached of
-- depending on your goals, you may wish to force `result` here
Nothing -> modify (M.insert x result) >> return result
Just cached -> return cached
where
result = f x
The main function now just consists of calling cache reallyLongRunningComputation on appropriate inputs.
main = do
iterations <- readLn
flip evalStateT M.empty . replicateM_ iterations
$ liftIO getLine
>>= liftIO . mapM readIO . words
>>= cache reallyLongRunningComputation
>>= liftIO . print
Let's try it in ghci!
> main
5
1 2 3
[1,2,3]
6
4 5
[4,5]
9
1 2
[1,2]
3
1 2
3
1 2 3
6
As you can see by the bracketed outputs, reallyLongRunningComputation was called the first time we entered 1 2 3 and the first time we entered 1 2, but not the second time we entered these inputs.
I hope i'm not too far off base, but first you need a way to carry around the past jobs with you. Easiest would be to use a foldM instead of a forM.
import Control.Monad
import Data.Maybe
main = do
jobsToProcess <- fmap read getLine
foldM doJobAcc acc0 [1..jobsToProcess]
where
acc0 = --initial value of some type of accumulator, i.e. hash map
doJobAcc acc _ = do
[r, k] <- fmap (map read . words) getLine :: IO [Int]
case getFromHash acc (r,k) of
Nothing -> do
i <- doSomeReallyLongWorkingJob r k
return $ insertNew acc (r,k) i
Just i -> do
return acc
Note, I don't actually use the interface for putting and getting the hash table key. It doesn't actually have to be a hash table, Data.Map from containers could work. Or even a list if its going to be a small one.
Another way to carry around the hash table would be to use a State transformer monad.
I am just adding this answer since I feel like the other answers are diverging a bit from the original question, namely using hashtable constructs in Main function (inside IO monad).
Here is a minimal hashtable example using hashtables module. To install the module with cabal, simply use
cabal install hashtables
In this example, we simply put some values in a hashtable and use lookup to print a value retrieved from the table.
import qualified Data.HashTable.IO as H
main :: IO ()
main = do
t <- H.new :: IO (H.CuckooHashTable Int String)
H.insert t 22 "Hello world"
H.insert t 5 "No problem"
msg <- H.lookup t 5
print msg
Notice that we need to use explicit type annotation to specify which implementation of the hashtable we wish to use.
I'm playing around with conduit library, and have written a sample piece of code for extracting two numbers (2 & 3) when they appear in a sequence. Following is my code:
import Data.Conduit
import qualified Data.Conduit.List as CL
source = CL.sourceList [1,2,3,4,5,2,3] :: Source IO Int
-- Extract the consequent 2 and 3 number
extract23 :: Conduit Int IO Int
extract23 = do
a <- await
b <- await
case (a,b) of
(Just a,Just b) ->
if a == 2 && b == 3
then do yield a
yield b
extract23
else extract23
_ -> return ()
conduit1 :: Conduit Int IO String
conduit1 = CL.map show
sink1 :: Sink String IO ()
sink1 = CL.mapM_ putStrLn
main :: IO ()
main = source $= (extract23 =$= conduit1) $$ sink1
But when I execute the main function, I get no output. What I expect actually is something like this:
2
3
2
3
Any idea on what I'm doing wrong ?
Your code calls await twice in a row. What that says is "give me the next two values in the stream, and do not put them back in the stream." When you do this repeatedly, you are essentially breaking your stream into 2-value chunks. Using your original list, you are basically getting tuples that look like:
[(1,2),(3,4),(5,2)] -- final 3 is lost since it has no pair
The issue is that you 2,3 sequences always fall between two of these tuples. It seems to me like the algorithm you really want is:
Check if the first two values in the stream match 2,3.
Proceed forward in the stream by one element and repeat.
Currently, you're stepping forward two elements in the stream.
Fortunately, there's an easy solution to this problem: instead of using await to get the second value, which removes it from the stream at the same time, use peek, which will look at the value and put it back. If you replace b <- await with b <- CL.peek, you should get the behavior you're looking for.
UPDATE
Just to give a little bit more information. Under the surface, peek is implemented on top of two primitives in conduit: await and leftover, like so:
peek = do
mx <- await
case mx of
Nothing -> return Nothing
Just x -> do
leftover x
return (Just x)
There's nothing magical about this ability to look ahead by 1 element. You can similarly look ahead 2 elements. The only trick is making sure to do the leftovers in the correct order:
peek2 = do
mx <- await
my <- await
maybe (return ()) leftover my
maybe (return ()) leftover mx
return (mx, my)
I'm trying to spew out randomly generated dice for every roll that the user plays. The user has 3 rolls per turn and he gets to play 5 turns (I haven't implemented this part yet and I would appreciate suggestions).
I'm also wondering how I can display the colors randomly. I have the list of tuples in place, but I reckon I need some function that uses random and that list to match those colors. I'm struggling as to how.
module Main where
import System.IO
import System.Random
import Data.List
diceColor = [("Black",1),("Green",2),("Purple",3),("Red",4),("White",5),("Yellow",6)]
{-
randomList :: (RandomGen g) -> Int -> g -> [Integer]
random 0 _ = []
randomList n generator = r : randomList (n-1) newGenerator
where (r, newGenerator) = randomR (1, 6) generator
-}
rand :: Int -> [Int] -> IO ()
rand n rlst = do
num <- randomRIO (1::Int, 6)
if n == 0
then doSomething rlst
else rand (n-1) (num:rlst)
doSomething x = putStrLn (show (sort x))
main :: IO ()
main = do
--hSetBuffering stdin LineBuffering
putStrLn "roll, keep, score?"
cmd <- getLine
doYahtzee cmd
--rand (read cmd) []
doYahtzee :: String -> IO ()
doYahtzee cmd = do
if cmd == "roll"
then rand 5 []
else do print "You won"
There's really a lot of errors sprinkled throughout this code, which suggests to me that you tried to build the whole thing at once. This is a recipe for disaster; you should be building very small things and testing them often in ghci.
Lecture aside, you might find the following facts interesting (in order of the associated errors in your code):
List is deprecated; you should use Data.List instead.
No let is needed for top-level definitions.
Variable names must begin with a lower case letter.
Class prerequisites are separated from a type by =>.
The top-level module block should mainly have definitions; you should associate every where clause (especially the one near randomList) with a definition by either indenting it enough not to be a new line in the module block or keeping it on the same line as the definition you want it to be associated with.
do introduces a block; those things in the block should be indented equally and more than their context.
doYahtzee is declared and used as if it has three arguments, but seems to be defined as if it only has one.
The read function is used to parse a String. Unless you know what it does, using read to parse a String from another String is probably not what you want to do -- especially on user input.
putStrLn only takes one argument, not four, and that argument has to be a String. However, making a guess at what you wanted here, you might like the (!!) and print functions.
dieRoll doesn't seem to be defined anywhere.
It's possible that there are other errors, as well. Stylistically, I recommend that you check out replicateM, randomRs, and forever. You can use hoogle to search for their names and read more about them; in the future, you can also use it to search for functions you wish existed by their type.
I am writing a compiler for a small imperative language. The target language is Java bytecode, and the compiler is implemented in Haskell.
I've written a frontend for the language - i.e I have a lexer, parser and typechecker. I'm having trouble figuring out how to do code generation.
I keep a data structure representing the stack of local variables. I can query this structure with the name of a local variable and get its position in the stack. This data structure is passed around as I walk the syntax tree, and variables are popped and pushed as I enter and exit new scopes.
What I having trouble figuring out is how to emit the bytecode. Emitting strings at terminals and concatenating them at higher levels seems like a poor solution, both clarity- and performance-wise.
tl;dr How do I emit bytecode while waling the syntax tree?
My first project in Haskell a few months back was to write a c compiler, and what resulted was a fairly naive approach to code generation, which I'll walk through here. Please do not take this as an example of good design for a code generator, but rather view it as a quick and dirty (and ultimately naive) way to get something that works fairly quickly with decent performance.
I began by defining an intermediate representation LIR (Lower Intermediate Representation) which closely corresponded to my instruction set (x86_64 in my case):
data LIRInst = LIRRegAssignInst LIRReg LIRExpr
| LIRRegOffAssignInst LIRReg LIRReg LIRSize LIROperand
| LIRStoreInst LIRMemAddr LIROperand
| LIRLoadInst LIRReg LIRMemAddr
| LIREnterInst LIRInt
| LIRJumpLabelInst LIRLabel
| LIRIfInst LIRRelExpr LIRLabel LIRLabel -- false, then true
| LIRCallInst LIRLabel LIRLabel -- method label, return label
| LIRCalloutInst String
| LIRRetInst [LIRLabel] String -- list of successors, and the name of the method returning from
| LIRLabelInst LIRLabel
deriving (Show, Eq, Typeable)
Next up came a monad that would handle interleaving state throughout the translation (I was blissfully unaware of our friend-the State Monad-at the time):
newtype LIRTranslator a = LIRTranslator
{ runLIR :: Namespace -> (a, Namespace) }
instance Monad LIRTranslator where
return a = LIRTranslator (\s -> (a, s))
m >>= f = LIRTranslator (\s ->
let (a, s') = runLIR m s
in runLIR (f a) s')
along with the state that would be 'threaded' through the various translation phases:
data Namespace = Namespace
{ temp :: Int -- id's for new temporaries
, labels :: Int -- id's for new labels
, scope :: [(LIRLabel, LIRLabel)] -- current program scope
, encMethod :: String -- current enclosing method
, blockindex :: [Int] -- index into the SymbolTree
, successorMap :: Map.Map String [LIRLabel]
, ivarStack :: [(LIRReg, [CFGInst])] -- stack of ivars (see motioned code)
}
For convenience, I also specified a series of translator monadic functions, for example:
-- |Increment our translator's label counter
incLabel :: LIRTranslator Int
incLabel = LIRTranslator (\ns#(Namespace{ labels = l }) -> (l, ns{ labels = (l+1) }))
I then proceeded to recursively pattern-match my AST, fragment-by-fragment, resulting in many functions of the form:
translateBlock :: SymbolTree -> ASTBlock -> LIRTranslator [LIRInst]
translateBlock st (DecafBlock _ [] _) = withBlock (return [])
translateBlock st block =
withBlock (do b <- getBlock
let st' = select b st
declarations <- mapM (translateVarDeclaration st') (blockVars block)
statements <- mapM (translateStm st') (blockStms block)
return (concat declarations ++ concat statements))
(for translating a block of the target language's code) or
-- | Given a SymbolTree, Translate a single DecafMethodStm into [LIRInst]
translateStm st (DecafMethodStm mc _) =
do (instructions, operand) <- translateMethodCall st mc
final <- motionCode instructions
return final
(for translating a method call) or
translateMethodPrologue :: SymbolTree -> DecafMethod -> LIRTranslator [LIRInst]
translateMethodPrologue st (DecafMethod _ ident args _ _) =
do let numRegVars = min (length args) 6
regvars = map genRegVar (zip [LRDI, LRSI, LRDX, LRCX, LR8, LR9] args)
stackvars <- mapM genStackVar (zip [1..] (drop numRegVars args))
return (regvars ++ stackvars)
where
genRegVar (reg, arg) =
LIRRegAssignInst (symVar arg st) (LIROperExpr $ LIRRegOperand reg)
genStackVar (index, arg) =
do let mem = LIRMemAddr LRBP Nothing ((index + 1) * 8) qword -- ^ [rbp] = old rbp; [rbp + 8] = ret address; [rbp + 16] = first stack param
return $ LIRLoadInst (symVar arg st) mem
for an example of actually generating some LIR code. Hopefully these three examples will give you a good starting point; ultimately, you'll want to go slowly, focusing on one fragment (or intermediate type) within your AST at a time.
If you haven't done this before, you can do it in small passes:
1) for every statement produce some byte code (with out properly addressed memory locations)
2) after that is done, if you have looping, gotos, etc, put in the real addresses (you know them
now that you have it all layed out)
3) replace the memory fetches/stores with the correct locations
4) dump it out to a JAR file
Note that this is very simplified and doesn't try to do any performance optimisation. It will give you a functional program which will execute. This also assumes you know the codes for the JVM (which is where I am presuming you are going to execute it.)
To start, just have a subset of the language which does sequential arithmetic statements. This will allow you to figure out how to map variable memory locations to statements via the parse tree. Next add some looping to get jumps to work. Similarly add conditionals. Finally, you can add the final parts of your language.