¿Cuál es la mejor manera de escribir un código similar a un semáforo en Haskell?

Supongamos que tengo una función f que toma un argumento entero. f puede no terminar en algunos argumentos, pero su resultado es igualmente valioso. (Para ser más concreto, el argumento podría ser la semilla de un generador de números aleatorios, que se pasa a un solucionador SAT).

Quiero usar concurrencia e invocar f 1, f 2, f 3, etc., y volver cuando termine el primero. Por lo tanto, cada hilo debe ejecutar un código que se parezca a

comp <- start_proc (f 1)
wait(comp || anyDone) -- wait for _either_ of these signals to be true
if comp then
    set anyDone = True

¿Cuál es la forma más sencilla de hacer esto? Me viene a la mente el operador de AMB, pero tendría que ejecutar todos los procesos simultáneamente (por ejemplo, en una máquina de 24 u 80 núcleos). (Las soluciones de computación distribuida serían incluso mejores). Una mirada superficial a la Página wiki de AMB sugiere que puede que no admita procesos que no terminan?

prueba

Actualmente, no obtengo las respuestas para trabajar con lo que quiero. Creo que esto es probablemente más un problema con la forma en que estoy creando procesos que cualquier otra cosa.

Definir

runProc (x:xs) =
    createProcess (proc x xs) >>= \(_, _, _, h) -> waitForProcess h

Entonces, quiero correr runProc ["zsh", "-c", "sleep 3"] y runProc ["ls"]. Modifiqué un poco la respuesta de Thomas, pero no funcionó.

raceL :: [IO α] -> IO α
raceL ops = do
    mv <- newEmptyMVar
    tids <- forM ops (\op -> forkIO (op >>= putMVar mv))
    answer <- takeMVar mv
    mapM_ killThread tids
    return answer

Compilando con -threaded y corriendo con +RTS -N (Tengo una máquina de 4 núcleos) no parece ayudar.

preguntado el 27 de agosto de 11 a las 17:08

Parece que killThread (que opera lanzando una excepción asincrónica al hilo que se va a matar), no interrumpe waitForProcess. Esto podría deberse a que la excepción se está enmascarando. Sin embargo, incluso si esto sí logró funciona, solo mataría el hilo, no el proceso. -

Es posible que desee revisar Orco, una biblioteca DSL para orquestar tareas paralelas y lidiar con cosas como carreras y eliminar los hilos que no lo lograron. Sin embargo, la documentación de Hackage es bastante escasa, por lo que recomiendo ver la presentación o leyendo el papel en lugar de. -

4 Respuestas

¿Por qué no solo un MVar y forkIO?

import Control.Concurrent
import Control.Concurrent.MVar
import System.Environment
import Control.Monad

main = do
  mv <- newEmptyMVar
  [nrThreads] <- liftM (map read) getArgs
  tids <- replicateM nrThreads (forkIO $ operation mv)
  answer <- takeMVar mv
  mapM_ killThread tids

operation :: MVar Int -> IO ()
operation mv = putMVar mv 5

Esto se bifurcará nrThreads hilos de peso ligero. Una vez que un hilo ha terminado, debe colocar la respuesta en el MVar proporcionado. Todos los demás subprocesos serán eliminados por el subproceso principal. No se necesita un sondeo explícito ya que GHC RTS reprogramará main una vez el MVar se vuelve no vacío.

Respondido 28 ago 11, 02:08

En lugar de amb, considere unamb! Proporciona un puñado de buenas primitivas para cálculos de carreras, tanto puras como impuras. Por ejemplo:

Prelude Data.Unamb> unamb (last [1..]) 32
32
Prelude Data.Unamb> race (threadDelay 5000000 >> return 3) readLn
Prelude Data.Unamb Control.Concurrent> race (threadDelay 5000000 >> return 3) readLn
56
56
Prelude Data.Unamb Control.Concurrent> race (threadDelay 5000000 >> return 3) readLn
3

Respondido 29 ago 11, 08:08

Parece que hay algo raro con race para cálculos puros. race (return 32) (return $ last [1..]) se congela para mí (invertir el orden funciona) .` - gatoatigrado

También estoy teniendo problemas con los IO. Definir runProc (x:xs) = createProcess (proc x xs) >>= \(_, _, _, h) -> waitForProcess h, entonces race (runProc ["zsh", "-c", "sleep 3"]) (runProc ["ls"]) no sale cuando termina "ls". - gatoatigrado

@gatoatigrado: Ambos terminaron correctamente para mí cuando agregué +RTS -N2 a mi línea de comando ghci. No me sorprendería si last [1..] se optimiza en un bucle que no realiza asignación (y, por lo tanto, nunca ofrece la oportunidad de cambiar de hilo verde). Sin embargo, no estoy seguro del otro. - Daniel Wagner

Ambos terminan para mí también, pero debería terminar inmediatamente, no después de que termine el "sueño 3". Esto probablemente tenga más que ver con cómo funciona la creación de procesos ... ¡gracias! - gatoatigrado

@gatoigrado: Hm, parece un error en 7.0.3. Puedo reproducir en 7.0.3, pero no en GHC HEAD. Entonces, la actualización (eventualmente) debería resolver su problema. - Daniel Wagner

Una opción sería utilizar STM para detectar la terminación, luego elimine explícitamente todos los demás subprocesos. Podemos definir:

start_proc :: IO a -> IO (ThreadId, TVar (Maybe a))

start_proc job = do
  resultVar <- newTVarIO Nothing
  forkIO $ job >>= (atomically . writeTVar resultVar)
  return resultVar

Entonces hazlo:

any_parallel :: [IO a] -> IO a
any_parallel jobs = do
  (threads, vars) <- liftM unzip $ mapM start_proc jobs
  result <- atomically $ foldl orElse retry (map check_job vars)
  mapM_ killThread threads
  return result
  where
    check_job :: TVar (Maybe a) -> STM a
    check_job resultVar = do
      val <- readTVar resultVar
      case val of
        Nothing -> retry
        Just x  -> return x

La clave aquí es que la primera vez que run_multiple revisa su conjunto de variables de resultado, todas son Nothing, y entonces retrys. La mónada STM registra qué TVars lo miró, y cada vez que se escribe alguno de ellos, la transacción STM se vuelve a ejecutar. En este punto, ve uno de los TVars no es Nothingy puede tomar el resultado en ese punto.

Una vez que tenemos un resultado, por supuesto, simplemente terminamos todos los hilos. Es probable que esto sea más rápido que hacer que verifiquen en su bucle interno alguna bandera compartida; hay menos contención en un MVar compartido (o lo que sea).

Tenga en cuenta que killThread espera a que el hilo de destino alcance un 'punto seguro' (es decir, asignación de memoria) antes de matar el hilo. No se puede garantizar que esto ocurra si el subproceso de destino tiene un bucle interno estrecho que no realiza ninguna asignación de memoria. Es posible que desee asegurarse de que los subprocesos realicen periódicamente una IO acción que obliga a que se produzca la asignación.

Respondido 27 ago 11, 21:08

¿Es una acción periódica de E / S realmente un cuello de botella menos que una verificación periódica en una bandera compartida? - Owen

@Owen, depende de la duración de estas acciones. N killThreads vs N * M readIOVar justo en tu bucle interno, después de todo. También puede colocar killThreads en un nuevo hilo de fondo (es decir, forkIO $ mapM_ killThread threads) - bdonlan

Estoy hablando de "Es posible que desee asegurarse de que los subprocesos realicen periódicamente una acción de E / S que obligue a que se produzca la asignación". ¿Hay alguna razón por la que la verificación de una bandera tenga que ocurrir con más frecuencia? - Owen

@Owen, la mayoría de los cálculos terminarán haciendo algún grado de asignaciones de todos modos, por lo que con killThread obtienes el cheque gratis. Es solo si usted, por algún milagro, tiene algunos verdaderamente bucle interno apretado que esto sería un problema. - bdonlan

@bdonlan Creas un MVar vacío, luego tienes todos los procesos haciendo una puesta y luego el proceso principal haciendo una toma. Cuando el proceso principal obtiene el valor, mata a todos los demás procesos. - augusts

Otra forma de hacerlo es programar manualmente su código usando una mónada para modelar los pasos de la computación.

Esto puede permitirle cambiar manualmente entre diferentes subprocesos de cálculo, escalonando cada uno unos pocos a la vez, hasta que uno de ellos termine:

sum5 :: [ Computation (Int, Int) ]
sum5 = [ sum5' x 0 | x <- [ 0, 1.. ] ]
  where sum5' x y = if x + y == 5
                      then return (x,y)
                      else do 
                        y' <- return (y+1) 
                        sum5' x y'

prod6 :: [ Computation (Int, Int) ]
prod6 = [ prod6' x 0 | x <- [ 0, 1.. ] ]
  where prod6' x y = if x * y == 6
                      then return (x,y)
                      else do 
                        y' <- return (y+1) 
                        prod6' x y'

firstSolution :: [Computation a] -> Strategy a -> a
firstSolution cs s = head . toList . runComputation $ s cs

Luego puede ver cómo le permite intercalar cálculos (incluso los que no terminan)

ghci> firstSolution sum5 fair
(5,0)
ghci> firstSolution sum5 diagu
(0,5)
ghci> firstSolution sum5 diagd
(5,0)
ghci> firstSolution prod6 fair
^CInterrupted.
ghci> firstSolution prod6 diagu
(2,3)
ghci> firstSolution prod6 diagd
(3,2)

Respondido 29 ago 11, 00:08

No es la respuesta que estás buscando? Examinar otras preguntas etiquetadas or haz tu propia pregunta.