
Hello all, I have massive (parallel if possible) system calls to an external non-deterministic program. Each time it is executed, it creates a file depending on a command line option 'opt' (input files path, for example). How can I ensure the file name will be unique? maybe with a global counter? My temporary solution have been to use a large random number: ----------- mysteriousExecution :: String -> IO () mysteriousExecution opt = do number <- rand run $ "mysterious-command " ⊕ opt ⊕ " --create-file=" ⊕ number rand = do a ← getStdRandom (randomR (1,999999999999999999999999999999999)) ∷ IO Int let r = take 20 $ randomRs ('a','z') (mkStdGen a) ∷ String return r ======== I'm trying to avoid additional parameters to 'mysteriousExecution'. I tried a counter also (to replace rand), but I don't know how could I start it inside 'mysteriousExecution'. c ∷ IO Counter c = do r ← newIORef 0 -- start return (do modifyIORef r (+1) readIORef r) If somebody says everything is wrong, ok. I understand. 18 years of imperative programming world can damage the brain. Thanks

This is what I'd do:
{-# LANGUAGE NoMonomorphismRestriction #-}
module Counter where
import Control.Monad.State
main = runStateT procedure (0 :: Integer) >> return ()
incCounter = do
n <- get
modify (+1)
return n
execFile = do
n <- incCounter
liftIO $ putStrLn $ ("command --createfile=tempfile" ++ show n ++ ".tmp")
procedure = do
execFile
execFile
liftIO $ putStrLn "do something"
execFile
On Fri, Jul 22, 2011 at 3:10 AM, Davi Santos
Hello all, I have massive (parallel if possible) system calls to an external non-deterministic program. Each time it is executed, it creates a file depending on a command line option 'opt' (input files path, for example). How can I ensure the file name will be unique? maybe with a global counter? My temporary solution have been to use a large random number: ----------- mysteriousExecution :: String -> IO () mysteriousExecution opt = do number <- rand run $ "mysterious-command " ⊕ opt ⊕ " --create-file=" ⊕ number rand = do a ← getStdRandom (randomR (1,999999999999999999999999999999999)) ∷ IO Int let r = take 20 $ randomRs ('a','z') (mkStdGen a) ∷ String return r ======== I'm trying to avoid additional parameters to 'mysteriousExecution'. I tried a counter also (to replace rand), but I don't know how could I start it inside 'mysteriousExecution'. c ∷ IO Counter c = do r ← newIORef 0 -- start return (do modifyIORef r (+1) readIORef r) If somebody says everything is wrong, ok. I understand. 18 years of imperative programming world can damage the brain. Thanks _______________________________________________ Beginners mailing list Beginners@haskell.org http://www.haskell.org/mailman/listinfo/beginners

I may misunderstand the issue, but why not using: System.IO.Temp.openTempFile and then use the returned FilePath? This should give unique names even for multiple runs of the controlling program. On 22.07.2011 11:46, David McBride wrote:
This is what I'd do:
{-# LANGUAGE NoMonomorphismRestriction #-} module Counter where
import Control.Monad.State
main = runStateT procedure (0 :: Integer)>> return ()
incCounter = do n<- get modify (+1) return n
execFile = do n<- incCounter liftIO $ putStrLn $ ("command --createfile=tempfile" ++ show n ++ ".tmp")
procedure = do execFile execFile liftIO $ putStrLn "do something" execFile
On Fri, Jul 22, 2011 at 3:10 AM, Davi Santos
wrote: Hello all, I have massive (parallel if possible) system calls to an external non-deterministic program. Each time it is executed, it creates a file depending on a command line option 'opt' (input files path, for example). How can I ensure the file name will be unique? maybe with a global counter? My temporary solution have been to use a large random number: ----------- mysteriousExecution :: String -> IO () mysteriousExecution opt = do number<- rand run $ "mysterious-command " ⊕ opt ⊕ " --create-file=" ⊕ number rand = do a ← getStdRandom (randomR (1,999999999999999999999999999999999)) ∷ IO Int let r = take 20 $ randomRs ('a','z') (mkStdGen a) ∷ String return r ======== I'm trying to avoid additional parameters to 'mysteriousExecution'. I tried a counter also (to replace rand), but I don't know how could I start it inside 'mysteriousExecution'. c ∷ IO Counter c = do r ← newIORef 0 -- start return (do modifyIORef r (+1) readIORef r) If somebody says everything is wrong, ok. I understand. 18 years of imperative programming world can damage the brain. Thanks _______________________________________________ Beginners mailing list Beginners@haskell.org http://www.haskell.org/mailman/listinfo/beginners
_______________________________________________ Beginners mailing list Beginners@haskell.org http://www.haskell.org/mailman/listinfo/beginners

Thanks David, Patrick and Thomas, I think 'openTempFile' is exactly what I need. Is there a way to use this function with no physical disk access? In other words, is it possible to work with files like they were in a ramdrive? To clarify a little, all this is needed because I can't call java classes directly into haskell code. I have seen Jaskell and other apparently dead projects out there. But they are even far from the little convenience of a "system call" and some file manipulation. I tried also Scala to substitute Haskell in this task, but it is too young language, with memory leaks, library code instability and other problems (version 2.9.0.1). Also the Scala IDE(Netbeans plugin), the only I managed to use, is as buggy as Leksah (0.10.0.4). Is somebody else trying to access java code? Maybe also the Weka library like me? Davi

I would look for the C version of the Java libs. Haskell is pretty
well integrated with C.
-deech
On Fri, Jul 22, 2011 at 11:45 AM, Davi Santos
Thanks David, Patrick and Thomas, I think 'openTempFile' is exactly what I need. Is there a way to use this function with no physical disk access? In other words, is it possible to work with files like they were in a ramdrive? To clarify a little, all this is needed because I can't call java classes directly into haskell code. I have seen Jaskell and other apparently dead projects out there. But they are even far from the little convenience of a "system call" and some file manipulation. I tried also Scala to substitute Haskell in this task, but it is too young language, with memory leaks, library code instability and other problems (version 2.9.0.1). Also the Scala IDE(Netbeans plugin), the only I managed to use, is as buggy as Leksah (0.10.0.4). Is somebody else trying to access java code? Maybe also the Weka library like me? Davi _______________________________________________ Beginners mailing list Beginners@haskell.org http://www.haskell.org/mailman/listinfo/beginners

Aditya, as I could search, If there is a C version of Weka, it appears to be very outdated by now. The library I use is http://www.cs.waikato.ac.nz/ml/weka/. Davi

Hello David, since your first approach was via the filesystem I assume you only need to call a more or less limited number of methods in Java. If this is the case then I would try to embed Java into C and call C from Haskell via the FFI. I have done both individually, it's not hard and it worked pretty well. I'm not sure if there are any lurking problems when "double embedding". But even if that should fail: before using the filesystem as communication mechanism I'd probably use some sort of IPC (probably network). If you really want a virtual filesystem for the communication, you can always set one up in your host OS: http://www.vanemery.com/Linux/Ramdisk/ramdisk.html Or search the web for "ramdisk <os of choice>" if you're not using Linux. I don't think Haskell provides this functionality as a library. I may be wrong, though. HTH, Thomas On 22.07.2011 19:23, Davi Santos wrote:
Aditya, as I could search, If there is a C version of Weka, it appears to be very outdated by now. The library I use is http://www.cs.waikato.ac.nz/ml/weka/.
Davi
_______________________________________________ Beginners mailing list Beginners@haskell.org http://www.haskell.org/mailman/listinfo/beginners

Thomas, the Weka Java library has a myriad of methods I want to call. To be clear, actually, it comes in three flavours: library, GUI and program. Unfortunately, as a library, it is unfeasible to map all of them to C or to a message passing system. When used as a program (such as I've done in Haskell), it arranges the methods in a way I can do almost everything just via command line options. The downside is that data can be exchanged only by files. So, I manipulate data in Haskell and send it ready to a file every time I need Weka to be called. Thousand times, BTW. Anyway, the perfect and impossible world would be to instantiate java classes directly in Haskell and use all Weka features. In time: when I run the program, I create a ramdisk this way: sudo mount -t tmpfs -o size=1024M tmpfs /tmp/ram/ it works, but makes the program to depend on external settings. May be I should do that via a Haskell system call also. I was hoping somebody would point out a secret Jaskell-like solution. :) Ah, to make myself even clearer, all of this is to avoid programming in Java, or better, to avoid hunting bugs all day in my own code. Davi[d] [the names are the same by here, no problem T. Holubar!]

Davi,
Perhaps you could use openTempFile
(http://haskell.org/ghc/docs/6.12.2/html/libraries/base-4.2.0.1/System-IO.htm...
It will create a file with a unique name and open it for you, you can
then just close it and pass the filename to your program.
Patrick
On Fri, Jul 22, 2011 at 3:10 AM, Davi Santos
Hello all, I have massive (parallel if possible) system calls to an external non-deterministic program. Each time it is executed, it creates a file depending on a command line option 'opt' (input files path, for example). How can I ensure the file name will be unique? maybe with a global counter? My temporary solution have been to use a large random number: ----------- mysteriousExecution :: String -> IO () mysteriousExecution opt = do number <- rand run $ "mysterious-command " ⊕ opt ⊕ " --create-file=" ⊕ number rand = do a ← getStdRandom (randomR (1,999999999999999999999999999999999)) ∷ IO Int let r = take 20 $ randomRs ('a','z') (mkStdGen a) ∷ String return r ======== I'm trying to avoid additional parameters to 'mysteriousExecution'. I tried a counter also (to replace rand), but I don't know how could I start it inside 'mysteriousExecution'. c ∷ IO Counter c = do r ← newIORef 0 -- start return (do modifyIORef r (+1) readIORef r) If somebody says everything is wrong, ok. I understand. 18 years of imperative programming world can damage the brain. Thanks _______________________________________________ Beginners mailing list Beginners@haskell.org http://www.haskell.org/mailman/listinfo/beginners
-- ===================== Patrick LeBoutillier Rosemère, Québec, Canada
participants (5)
-
aditya siram
-
Davi Santos
-
David McBride
-
Patrick LeBoutillier
-
Thomas