{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE Rank2Types #-}
{- |
This is an approach with no pre-defined direction of type dependencies.
-}
module LLVM.DSL.Render.Run (
   T(Cons, decons),
   postmapPlain,
   premapDSL,
   Creator,
   run,
   (*->),
   ) where

import qualified LLVM.DSL.Render.Argument as Arg
import qualified LLVM.DSL.Expression as Expr
import LLVM.DSL.Render.Argument (Creator)
import LLVM.DSL.Expression (Exp)

import qualified LLVM.Extra.Multi.Value.Marshal as Marshal

import Prelude2010
import Prelude ()



{-
Type order of 'f' and 'fdsl' is consistent with 'run',
but inconsistent with 'Arg.T'.
-}
newtype T m p fdsl f =
   Cons {forall (m :: * -> *) p fdsl f.
T m p fdsl f -> (Exp p -> fdsl) -> m (Creator p -> f)
decons :: (Exp p -> fdsl) -> m (Creator p -> f)}

{-
We could turn this into an 'Functor'/'fmap' instance,
however this is less descriptive and
would require to keep the current type parameter order.
-}
postmapPlain :: Functor m => (f -> g) -> T m p fdsl f -> T m p fdsl g
postmapPlain :: forall (m :: * -> *) f g p fdsl.
Functor m =>
(f -> g) -> T m p fdsl f -> T m p fdsl g
postmapPlain f -> g
f T m p fdsl f
build = ((Exp p -> fdsl) -> m (Creator p -> g)) -> T m p fdsl g
forall (m :: * -> *) p fdsl f.
((Exp p -> fdsl) -> m (Creator p -> f)) -> T m p fdsl f
Cons (((Exp p -> fdsl) -> m (Creator p -> g)) -> T m p fdsl g)
-> ((Exp p -> fdsl) -> m (Creator p -> g)) -> T m p fdsl g
forall a b. (a -> b) -> a -> b
$ ((Creator p -> f) -> Creator p -> g)
-> m (Creator p -> f) -> m (Creator p -> g)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (f -> g
f (f -> g) -> (Creator p -> f) -> Creator p -> g
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) (m (Creator p -> f) -> m (Creator p -> g))
-> ((Exp p -> fdsl) -> m (Creator p -> f))
-> (Exp p -> fdsl)
-> m (Creator p -> g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T m p fdsl f -> (Exp p -> fdsl) -> m (Creator p -> f)
forall (m :: * -> *) p fdsl f.
T m p fdsl f -> (Exp p -> fdsl) -> m (Creator p -> f)
decons T m p fdsl f
build

premapDSL :: (gdsl -> fdsl) -> T m p fdsl f -> T m p gdsl f
premapDSL :: forall gdsl fdsl (m :: * -> *) p f.
(gdsl -> fdsl) -> T m p fdsl f -> T m p gdsl f
premapDSL gdsl -> fdsl
f T m p fdsl f
build = ((Exp p -> gdsl) -> m (Creator p -> f)) -> T m p gdsl f
forall (m :: * -> *) p fdsl f.
((Exp p -> fdsl) -> m (Creator p -> f)) -> T m p fdsl f
Cons (((Exp p -> gdsl) -> m (Creator p -> f)) -> T m p gdsl f)
-> ((Exp p -> gdsl) -> m (Creator p -> f)) -> T m p gdsl f
forall a b. (a -> b) -> a -> b
$ T m p fdsl f -> (Exp p -> fdsl) -> m (Creator p -> f)
forall (m :: * -> *) p fdsl f.
T m p fdsl f -> (Exp p -> fdsl) -> m (Creator p -> f)
decons T m p fdsl f
build ((Exp p -> fdsl) -> m (Creator p -> f))
-> ((Exp p -> gdsl) -> Exp p -> fdsl)
-> (Exp p -> gdsl)
-> m (Creator p -> f)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (gdsl -> fdsl) -> (Exp p -> gdsl) -> Exp p -> fdsl
forall a b. (a -> b) -> (Exp p -> a) -> Exp p -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap gdsl -> fdsl
f


-- ToDo: duplicate of Argument
primitiveCreator :: a -> Creator a
primitiveCreator :: forall a. a -> Creator a
primitiveCreator a
a = (a, IO ()) -> IO (a, IO ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())

run :: (Functor m) => T m () fdsl f -> fdsl -> m f
run :: forall (m :: * -> *) fdsl f.
Functor m =>
T m () fdsl f -> fdsl -> m f
run (Cons (Exp () -> fdsl) -> m (Creator () -> f)
build) fdsl
f = ((Creator () -> f) -> f) -> m (Creator () -> f) -> m f
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Creator () -> f) -> Creator () -> f
forall a b. (a -> b) -> a -> b
$ () -> Creator ()
forall a. a -> Creator a
primitiveCreator ()) (m (Creator () -> f) -> m f) -> m (Creator () -> f) -> m f
forall a b. (a -> b) -> a -> b
$ (Exp () -> fdsl) -> m (Creator () -> f)
build ((Exp () -> fdsl) -> m (Creator () -> f))
-> (Exp () -> fdsl) -> m (Creator () -> f)
forall a b. (a -> b) -> a -> b
$ fdsl -> Exp () -> fdsl
forall a b. a -> b -> a
const fdsl
f


-- precedence like Applicative.<*>, but different associativity
infixr 4 *->

(*->) ::
   (Functor m) =>
   Arg.T a adsl ->
   (forall al. Marshal.C al => T m (p, al) fdsl f) ->
   T m p (adsl -> fdsl) (a -> f)
*-> :: forall (m :: * -> *) a adsl p fdsl f.
Functor m =>
T a adsl
-> (forall al. C al => T m (p, al) fdsl f)
-> T m p (adsl -> fdsl) (a -> f)
(*->) T a adsl
arg forall al. C al => T m (p, al) fdsl f
build = ((Exp p -> adsl -> fdsl) -> m (Creator p -> a -> f))
-> T m p (adsl -> fdsl) (a -> f)
forall (m :: * -> *) p fdsl f.
((Exp p -> fdsl) -> m (Creator p -> f)) -> T m p fdsl f
Cons (((Exp p -> adsl -> fdsl) -> m (Creator p -> a -> f))
 -> T m p (adsl -> fdsl) (a -> f))
-> ((Exp p -> adsl -> fdsl) -> m (Creator p -> a -> f))
-> T m p (adsl -> fdsl) (a -> f)
forall a b. (a -> b) -> a -> b
$ \Exp p -> adsl -> fdsl
f ->
   case T a adsl
arg of
      Arg.Cons Exp al -> adsl
pass a -> Creator al
createA ->
         ((IO ((p, al), IO ()) -> f) -> Creator p -> a -> f)
-> m (IO ((p, al), IO ()) -> f) -> m (Creator p -> a -> f)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
            (\IO ((p, al), IO ()) -> f
g Creator p
createP a
av ->
               IO ((p, al), IO ()) -> f
g (do (p
p,IO ()
finalP) <- Creator p
createP
                     (al
pa,IO ()
finalA) <- a -> Creator al
createA a
av
                     ((p, al), IO ()) -> IO ((p, al), IO ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((p
p,al
pa), IO ()
finalA IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
finalP)))
            (T m (p, al) fdsl f
-> (Exp (p, al) -> fdsl) -> m (IO ((p, al), IO ()) -> f)
forall (m :: * -> *) p fdsl f.
T m p fdsl f -> (Exp p -> fdsl) -> m (Creator p -> f)
decons T m (p, al) fdsl f
forall al. C al => T m (p, al) fdsl f
build ((Exp p -> Exp al -> fdsl) -> Exp (p, al) -> fdsl
forall a b c. (Exp a -> Exp b -> c) -> Exp (a, b) -> c
Expr.uncurry ((Exp p -> Exp al -> fdsl) -> Exp (p, al) -> fdsl)
-> (Exp p -> Exp al -> fdsl) -> Exp (p, al) -> fdsl
forall a b. (a -> b) -> a -> b
$ \Exp p
p -> Exp p -> adsl -> fdsl
f Exp p
p (adsl -> fdsl) -> (Exp al -> adsl) -> Exp al -> fdsl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp al -> adsl
pass))