[Haskell-cafe] Implementing parallelism using actors. How to improve the code.
leesteken at pm.me
leesteken at pm.me
Thu Sep 10 15:55:17 UTC 2020
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
More information about the Haskell-Cafe
mailing list