[Haskell-cafe] Implementing parallelism using actors. How to improve the code.
Luc Duponcheel
luc.duponcheel at gmail.com
Thu Sep 10 15:01:55 UTC 2020
-- Hello, I am Luc Duponcheel.
-- I started as a Haskell programmer,
-- went to Java for a living,
-- naturally evolved to Scala,
-- and, being retired now,
-- went back to my first love ...
-- I am working on a library
-- _______ __ __ _______
-- / ___ /\ / /\ / /\ / ___ /\
-- / /__/ / / _____/ / / / /_/__ / /__/ / /
-- / _____/ / / ___ / / / ___ /\ /____ / /
-- / /\____\/ / /__/ / / / /__/ / / \___/ / /
-- /_/ / /______/ / /______/ / /_/ /
-- \_\/ \______\/ \______\/ \_\/
-- v1.0
-- Program Description Based Programming Library
-- author Luc Duponcheel 2020 - ...
-- I started writing code in Scala (presented it at several conferences).
-- I encountered issues with the fact that lazyness is not the default
evaluation strategy.
-- I switched to Haskell.
-- In short: the library is about pointfree categorical programming
-- (you may wish to have a look at (
https://www.youtube.com/watch?v=23VEcabMk7k (warning low sound volume))
-- below is some code with comments (you can load the code in ghci)
-- it works fine but I want to get rid of the extra type class parameters x
and w
-- I tried to get rid of x and w in two ways
-- . using forall
-- . using a GADT
--
-- both approaches failed
--
-- the relevant code changes that I tried are commented out
-- they are underneath the code that follows
-- the code
-- specifies parallelism
-- and
-- implements it using a dummy version of the hakka library
-- (see
https://hackage.haskell.org/package/hakka-0.2.0/docs/src/Hakka-Actor.html)
-- first I need some language extensions
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE GADTs #-}
-- next I need some imports
import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import Control.Monad.Trans.State.Strict
import Control.Monad.Trans.Cont
-- next some useful generic code
infixr `c`
infixr `d`
f `c` g = f . g
(f `d` g) h = f `c` g h
--
-- parallel specification
--
-- note the extra type class parameters x and w
--
type z && y = (z, y)
class Parallel x w to where
par :: (z `to` x) -> (y `to` w) -> (z && y) `to` (x && w)
--
-- parallel implementation
--
-- o msg stands for message
-- o mnd stands for monad
-- o rst stands for result
--
--
-- three actors involved
--
-- o reactor
-- - reacts by using a continuation cont when both
-- . an x result (at left)
-- . a w result (at right)
-- have been received
--
-- o leftActor
-- - acts to send an x result (at left) to reactor
--
-- o rightActor
-- - acts to send a w result (at right) to reactor
--
-- reactor sends both leftActor and rightActor a message to let them act
--
data ActorRef = ActorRef
newtype ActorContext msg = ActorContext msg
newtype ActorT msg mnd z = ActorT { runActorT :: StateT (ActorContext msg)
mnd z }
deriving (Functor, Applicative, Monad, MonadFail, MonadTrans, MonadIO)
actor :: String -> (msg -> ActorT msg IO ()) -> ActorT msg IO ActorRef
actor name messageHandler = undefined
become :: (msg -> ActorT msg IO ()) -> ActorT msg IO ()
become messageHandler = undefined
(!) :: ActorRef -> msg -> ActorT msg IO ()
actorRef ! message = undefined
newtype ReactiveT msg rst mnd z = ReactiveT { runReactiveT :: ContT rst
(ActorT msg mnd) z }
deriving (Functor, Applicative, Monad, MonadFail, MonadIO)
newtype KleisliT mnd z y = KleisliT { runKleisliT :: z -> mnd y }
type ReactiveParallelT msg rst mnd = KleisliT (ReactiveT msg rst mnd)
data Message x w = LeftReact x | RightReact w | LeftAct | RightAct
type ReactiveActorBasedParallelT x w = ReactiveParallelT (Message x w) () IO
runReactiveActorBasedParallelT = runContT `d` runReactiveT `d` runKleisliT
instance Parallel x w (ReactiveActorBasedParallelT x w) where
par z2x y2w = KleisliT
(\case
(z, y) -> ReactiveT
(ContT
(\cont ->
actor
"reactor"
(\case
LeftReact x -> become
(\case
RightReact w -> cont (x, w)
)
RightReact w -> become
(\case
LeftReact x -> cont (x, w)
)
)
>>= \reactorRef ->
actor
"leftActor"
(\case
LeftAct -> runReactiveActorBasedParallelT
z2x
z
(\x -> reactorRef ! LeftReact x)
)
>>= \leftActorRef ->
actor
"rightActor"
(\case
RightAct -> runReactiveActorBasedParallelT
y2w
y
(\w -> reactorRef ! RightReact w)
)
>>= \rightActorRef ->
leftActorRef
! LeftAct
>> rightActorRef
! RightAct
)
)
)
-- class Parallel to where
-- data Message = forall x. LeftReact x | forall w. RightReact w | LeftAct
| RightAct
-- data Message where
-- LeftReact :: x -> Message
-- RightReact :: w -> Message
-- LeftAct :: Message
-- RightAct :: Message
-- type ReactiveActorBasedParallelT = ReactiveParallelT Message () IO
-- instance Parallel (ReactiveActorBasedParallelT IO) where
--
__~O
-\ <,
(*)/ (*)
reality goes far beyond imagination
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/haskell-cafe/attachments/20200910/d427bfd1/attachment.html>
More information about the Haskell-Cafe
mailing list