Haskellの33行のゼロからの協調スレッド

種類

• ストリームは既存の命令シーケンスを拡張する必要があります
• スレッドは一連の操作をサポートする必要があります：分岐、制御転送、終了
• スレッドは異なるタイプのスケジューラーを許可する必要があります

• 「複数の通訳者/プランナー/バックエンド」と聞いたら、「無料」と考えるべきです（「無料オブジェクト」のように）
• 「コマンドのシーケンス」を聞いたら、「モナド」と考える必要があります。
• 何かを「拡張」したいときは、「トランス」と考えるべきです。

構文ツリー

{-# LANGUAGE DeriveFunctor #-} data ThreadF next = Fork next next | Yield next | Done deriving (Functor) 

 instance Functor ThreadF where f `fmap` (Fork next next) = Fork (f next) (f next) f `fmap` (Yield next) = Yield (f next) f `fmap` Done = Done 

 --  `free`  import Control.Monad.Trans.Free type Thread = FreeT ThreadF 

説明書

 yield :: (Monad m) => Thread m () yield = liftF (Yield ()) done :: (Monad m) => Thread mr done = liftF Done cFork :: (Monad m) => Thread m Bool cFork = liftF (Fork False True) 

• yieldコマンドは()をその子として保存するため、関数の戻り値は()
• doneコマンドには子がないため、コンパイラーはポリモーフィックな戻り値（つまりr ）があると推測します。つまり、終了しないことを意味します。
• cForkコマンドはブール値を子として保存するため、 Bool返します

 import Control.Monad fork :: (Monad m) => Thread ma -> Thread m () fork thread = do child <- cFork when child $ do thread done 

無料のモナド

 do yield done 

ループフローマネージャー

 --   O(1)      import Data.Sequence roundRobin :: (Monad m) => Thread ma -> m () roundRobin t = go (singleton t) --     where go ts = case (viewl ts) of --   : ! EmptyL -> return () --   :      t :< ts' -> do x <- runFreeT t --     case x of --       Free (Fork t1 t2) -> go (t1 <| (ts' |> t2)) --       Free (Yield t') -> go (ts' |> t') --  :     Free Done -> go ts' Pure _ -> go ts' 

カスタムスレッド

 mainThread :: Thread IO () mainThread = do lift $ putStrLn "Forking thread #1" fork thread1 lift $ putStrLn "Forking thread #1" fork thread2 thread1 :: Thread IO () thread1 = forM_ [1..10] $ \i -> do lift $ print i yield thread2 :: Thread IO () thread2 = replicateM_ 3 $ do lift $ putStrLn "Hello" yield 

 >>> roundRobin mainThread :: IO () Forking thread #1 Forking thread #1 1 Hello 2 Hello 3 Hello 4 5 6 7 8 9 10 

 import Control.Monad.Trans.Writer logger :: Thread (Writer [String]) () logger = do fork helper lift $ tell ["Abort"] yield lift $ tell ["Fail"] helper :: Thread (Writer [String]) () helper = do lift $ tell ["Retry"] yield lift $ tell ["!"] 

 roundRobin logger :: Writer [String] () 

 execWriter (roundRobin logger) :: [String] 

 >>> execWriter (roundRobin logger) ["Abort","Retry","Fail","!"] 

おわりに

 data FreeF fax = Pure a | Free (fx) newtype FreeT fma = FreeT { runFreeT :: m (FreeF fa (FreeT fma)) } instance (Functor f, Monad m) => Monad (FreeT fm) where return a = FreeT (return (Pure a)) FreeT m >>= f = FreeT $ m >>= \v -> case v of Pure a -> runFreeT (fa) Free w -> return (Free (fmap (>>= f) w)) instance MonadTrans (FreeT f) where lift = FreeT . liftM Pure liftF :: (Functor f, Monad m) => fr -> FreeT fmr liftF x = FreeT (return (Free (fmap return x)))