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