<div dir="ltr">It works! <br><div><br></div><div>you are my hero!</div></div><br><div class="gmail_quote"><div dir="ltr" class="gmail_attr">On Thu, Sep 10, 2020 at 5:55 PM <<a href="mailto:leesteken@pm.me">leesteken@pm.me</a>> wrote:<br></div><blockquote class="gmail_quote" style="margin:0px 0px 0px 0.8ex;border-left:1px solid rgb(204,204,204);padding-left:1ex">How about using {-# LANGUAGE TypeFamilies #-} ?<br>
<br>
class Parallel to where<br>
  type X to<br>
  type W to<br>
  par :: (z `to` X to) -> (y `to` W to) -> (z && y) `to` (X to && W to)<br>
<br>
instance Parallel (ReactiveActorBasedParallelT x w) where<br>
  type X (ReactiveActorBasedParallelT x w) = x<br>
  type W (ReactiveActorBasedParallelT x w) = w<br>
  par z2x y2w = {- the same very long expression as before -}<br>
<br>
‐‐‐‐‐‐‐ Original Message ‐‐‐‐‐‐‐<br>
On Thursday, September 10, 2020 5:01 PM, Luc Duponcheel <<a href="mailto:luc.duponcheel@gmail.com" target="_blank">luc.duponcheel@gmail.com</a>> wrote:<br>
<br>
> -- Hello, I am Luc Duponcheel.<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>
> -- I am working on a library<br>
> --       _______         __    __        _______<br>
> --      / ___  /\       / /\  / /\      / ___  /\<br>
> --     / /__/ / / _____/ / / / /_/__   / /__/ / /<br>
> --    / _____/ / / ___  / / / ___  /\ /____  / /<br>
> --   / /\____\/ / /__/ / / / /__/ / / \___/ / /<br>
> --  /_/ /      /______/ / /______/ /     /_/ /<br>
> --  \_\/       \______\/  \______\/      \_\/<br>
> --                                           v1.0<br>
> --  Program Description Based Programming Library<br>
> --  author        Luc Duponcheel       2020 - ...<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>
> -- 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" rel="noreferrer" target="_blank">https://www.youtube.com/watch?v=23VEcabMk7k</a> (warning low sound volume))<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-- they are underneath the code that follows<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" rel="noreferrer" target="_blank">https://hackage.haskell.org/package/hakka-0.2.0/docs/src/Hakka-Actor.html</a>)<br>
> -- first I need some language extensions<br>
> {-# LANGUAGE TypeOperators #-}<br>
> {-# LANGUAGE MultiParamTypeClasses #-}<br>
> {-# LANGUAGE GeneralizedNewtypeDeriving #-}<br>
> {-# LANGUAGE FlexibleInstances #-}<br>
> {-# LANGUAGE InstanceSigs #-}<br>
> {-# LANGUAGE LambdaCase #-}<br>
> {-# LANGUAGE GADTs #-}<br>
> -- next I need some imports<br>
> import           Control.Monad.IO.Class<br>
> import           Control.Monad.Trans.Class<br>
> import           Control.Monad.Trans.State.Strict<br>
> import           Control.Monad.Trans.Cont<br>
> -- next some useful generic code<br>
> infixr `c`<br>
> infixr `d`<br>
> f `c` g = f . g<br>
> (f `d` g) h = f `c` g h<br>
> --<br>
> -- parallel specification<br>
> --<br>
> -- note the extra type class parameters x and w<br>
> --<br>
> type z && y = (z, y)<br>
> class Parallel x w to where<br>
>     par :: (z `to` x) -> (y `to` w) -> (z && y) `to` (x && w)<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>
> data ActorRef = ActorRef<br>
> newtype ActorContext msg = ActorContext msg<br>
> newtype ActorT msg mnd z = ActorT { runActorT :: StateT (ActorContext msg) mnd z }<br>
>   deriving (Functor, Applicative, Monad, MonadFail, MonadTrans, MonadIO)<br>
> actor :: String -> (msg -> ActorT msg IO ()) -> ActorT msg IO ActorRef<br>
> actor name messageHandler = undefined<br>
> become :: (msg -> ActorT msg IO ()) -> ActorT msg IO ()<br>
> become messageHandler = undefined<br>
> (!) :: ActorRef -> msg -> ActorT msg IO ()<br>
> actorRef ! message = undefined<br>
> newtype ReactiveT msg rst mnd z = ReactiveT { runReactiveT :: ContT rst (ActorT msg mnd) z }<br>
>   deriving (Functor, Applicative, Monad, MonadFail, MonadIO)<br>
> newtype KleisliT mnd z y = KleisliT { runKleisliT :: z -> mnd y }<br>
> type ReactiveParallelT msg rst mnd = KleisliT (ReactiveT msg rst mnd)<br>
> data Message x w = LeftReact x | RightReact w | LeftAct | RightAct<br>
> type ReactiveActorBasedParallelT x w = ReactiveParallelT (Message x w) () IO<br>
> runReactiveActorBasedParallelT = runContT `d` runReactiveT `d` runKleisliT<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>
> -- class Parallel to where<br>
> -- data Message = forall x. LeftReact x | forall w. RightReact w | LeftAct | RightAct<br>
> -- data Message where<br>
> --   LeftReact :: x -> Message<br>
> --   RightReact :: w -> Message<br>
> --   LeftAct :: Message<br>
> --   RightAct :: Message<br>
> -- type ReactiveActorBasedParallelT = ReactiveParallelT Message () IO<br>
> -- instance Parallel (ReactiveActorBasedParallelT IO) where<br>
> --<br>
>    __~O<br>
>   -\ <,<br>
> (*)/ (*)<br>
><br>
> reality goes far beyond imagination<br>
</blockquote></div><br clear="all"><div><br></div>-- <br><div dir="ltr" class="gmail_signature">   __~O<br>  -\ <,<br>(*)/ (*)<br><br>reality goes far beyond imagination<br></div>