[Haskell-cafe] Implementing parallelism using actors. How to improve the code.
Luc Duponcheel
luc.duponcheel at gmail.com
Thu Sep 10 16:08:51 UTC 2020
It works!
you are my hero!
On Thu, Sep 10, 2020 at 5:55 PM <leesteken at pm.me> wrote:
> How about using {-# LANGUAGE TypeFamilies #-} ?
>
> class Parallel to where
> type X to
> type W to
> par :: (z `to` X to) -> (y `to` W to) -> (z && y) `to` (X to && W to)
>
> instance Parallel (ReactiveActorBasedParallelT x w) where
> type X (ReactiveActorBasedParallelT x w) = x
> type W (ReactiveActorBasedParallelT x w) = w
> par z2x y2w = {- the same very long expression as before -}
>
> ‐‐‐‐‐‐‐ Original Message ‐‐‐‐‐‐‐
> On Thursday, September 10, 2020 5:01 PM, Luc Duponcheel <
> luc.duponcheel at gmail.com> wrote:
>
> > -- 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
>
--
__~O
-\ <,
(*)/ (*)
reality goes far beyond imagination
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/haskell-cafe/attachments/20200910/2501bd49/attachment-0001.html>
More information about the Haskell-Cafe
mailing list