{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE Rank2Types #-}
module Synthesizer.LLVM.Causal.Parameterized where

import qualified Synthesizer.LLVM.Causal.Private as Causal

import LLVM.DSL.Expression (Exp(Exp))

import qualified LLVM.Extra.Multi.Value.Marshal as Marshal
import qualified LLVM.Extra.Multi.Value as MultiValue
import qualified LLVM.Extra.Memory as Memory
import qualified LLVM.Extra.MaybeContinuation as MaybeCont
import qualified LLVM.Extra.Tuple as Tuple

import qualified LLVM.Core as LLVM

import Control.Monad.IO.Class (liftIO)

import Data.IORef (IORef, newIORef, readIORef, writeIORef)


data T p a b =
   forall global local state.
      (Memory.C global, LLVM.IsSized local, Memory.C state) =>
      Cons (forall r c.
            (Tuple.Phi c) =>
            p -> global -> LLVM.Value (LLVM.Ptr local) ->
            a -> state -> MaybeCont.T r c (b, state))
           (forall r. p -> LLVM.CodeGenFunction r (global, state))
           (forall r. p -> global -> LLVM.CodeGenFunction r ())


fromProcess :: String -> (Exp p -> Causal.T a b) -> IO (T (MultiValue.T p) a b)
fromProcess :: forall p a b. String -> (Exp p -> T a b) -> IO (T (T p) a b)
fromProcess String
name Exp p -> T a b
f = do
   IORef (T p)
ref <- T p -> IO (IORef (T p))
forall a. a -> IO (IORef a)
newIORef (T p -> IO (IORef (T p))) -> T p -> IO (IORef (T p))
forall a b. (a -> b) -> a -> b
$ String -> T p
forall a. HasCallStack => String -> a
error (String -> T p) -> String -> T p
forall a b. (a -> b) -> a -> b
$ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": uninitialized parameter reference"
   T (T p) a b -> IO (T (T p) a b)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (T (T p) a b -> IO (T (T p) a b))
-> T (T p) a b -> IO (T (T p) a b)
forall a b. (a -> b) -> a -> b
$
      case Exp p -> T a b
f ((forall r. CodeGenFunction r (T p)) -> Exp p
forall a. (forall r. CodeGenFunction r (T a)) -> Exp a
Exp (IO (T p) -> CodeGenFunction r (T p)
forall a. IO a -> CodeGenFunction r a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef (T p) -> IO (T p)
forall a. IORef a -> IO a
readIORef IORef (T p)
ref))) of
         Causal.Cons forall r c.
Phi c =>
global -> Value (Ptr local) -> a -> state -> T r c (b, state)
next forall r. CodeGenFunction r (global, state)
start forall r. global -> CodeGenFunction r ()
stop ->
            (forall r c.
 Phi c =>
 T p
 -> global -> Value (Ptr local) -> a -> state -> T r c (b, state))
-> (forall r. T p -> CodeGenFunction r (global, state))
-> (forall r. T p -> global -> CodeGenFunction r ())
-> T (T p) a b
forall p a b global local state.
(C global, IsSized local, C state) =>
(forall r c.
 Phi c =>
 p -> global -> Value (Ptr local) -> a -> state -> T r c (b, state))
-> (forall r. p -> CodeGenFunction r (global, state))
-> (forall r. p -> global -> CodeGenFunction r ())
-> T p a b
Cons
               (\T p
p global
global Value (Ptr local)
local a
a state
state ->
                  IO () -> T r c ()
forall a. IO a -> T r c a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef (T p) -> T p -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (T p)
ref T p
p) T r c () -> T r c (b, state) -> T r c (b, state)
forall a b. T r c a -> T r c b -> T r c b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> global -> Value (Ptr local) -> a -> state -> T r c (b, state)
forall r c.
Phi c =>
global -> Value (Ptr local) -> a -> state -> T r c (b, state)
next global
global Value (Ptr local)
local a
a state
state)
               (\T p
p -> IO () -> CodeGenFunction r ()
forall a. IO a -> CodeGenFunction r a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef (T p) -> T p -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (T p)
ref T p
p) CodeGenFunction r ()
-> CodeGenFunction r (global, state)
-> CodeGenFunction r (global, state)
forall a b.
CodeGenFunction r a -> CodeGenFunction r b -> CodeGenFunction r b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CodeGenFunction r (global, state)
forall r. CodeGenFunction r (global, state)
start)
               (\T p
p global
global -> IO () -> CodeGenFunction r ()
forall a. IO a -> CodeGenFunction r a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef (T p) -> T p -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (T p)
ref T p
p) CodeGenFunction r ()
-> CodeGenFunction r () -> CodeGenFunction r ()
forall a b.
CodeGenFunction r a -> CodeGenFunction r b -> CodeGenFunction r b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> global -> CodeGenFunction r ()
forall r. global -> CodeGenFunction r ()
stop global
global)


fromProcessPtr ::
   (Marshal.C p) =>
   String -> (Exp p -> Causal.T a b) ->
   IO (T (LLVM.Value (LLVM.Ptr (Marshal.Struct p))) a b)
fromProcessPtr :: forall p a b.
C p =>
String -> (Exp p -> T a b) -> IO (T (Value (Ptr (Struct p))) a b)
fromProcessPtr String
name Exp p -> T a b
f = do
   IORef (T p)
ref <- T p -> IO (IORef (T p))
forall a. a -> IO (IORef a)
newIORef (T p -> IO (IORef (T p))) -> T p -> IO (IORef (T p))
forall a b. (a -> b) -> a -> b
$ String -> T p
forall a. HasCallStack => String -> a
error (String -> T p) -> String -> T p
forall a b. (a -> b) -> a -> b
$ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": uninitialized parameter reference"
   T (Value (Ptr (Struct p))) a b
-> IO (T (Value (Ptr (Struct p))) a b)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (T (Value (Ptr (Struct p))) a b
 -> IO (T (Value (Ptr (Struct p))) a b))
-> T (Value (Ptr (Struct p))) a b
-> IO (T (Value (Ptr (Struct p))) a b)
forall a b. (a -> b) -> a -> b
$
      case Exp p -> T a b
f ((forall r. CodeGenFunction r (T p)) -> Exp p
forall a. (forall r. CodeGenFunction r (T a)) -> Exp a
Exp (IO (T p) -> CodeGenFunction r (T p)
forall a. IO a -> CodeGenFunction r a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef (T p) -> IO (T p)
forall a. IORef a -> IO a
readIORef IORef (T p)
ref))) of
         Causal.Cons forall r c.
Phi c =>
global -> Value (Ptr local) -> a -> state -> T r c (b, state)
next forall r. CodeGenFunction r (global, state)
start forall r. global -> CodeGenFunction r ()
stop ->
            (forall r c.
 Phi c =>
 Value (Ptr (Struct p))
 -> global -> Value (Ptr local) -> a -> state -> T r c (b, state))
-> (forall r.
    Value (Ptr (Struct p)) -> CodeGenFunction r (global, state))
-> (forall r.
    Value (Ptr (Struct p)) -> global -> CodeGenFunction r ())
-> T (Value (Ptr (Struct p))) a b
forall p a b global local state.
(C global, IsSized local, C state) =>
(forall r c.
 Phi c =>
 p -> global -> Value (Ptr local) -> a -> state -> T r c (b, state))
-> (forall r. p -> CodeGenFunction r (global, state))
-> (forall r. p -> global -> CodeGenFunction r ())
-> T p a b
Cons
               (\Value (Ptr (Struct p))
p global
global Value (Ptr local)
local a
a state
state ->
                  CodeGenFunction r () -> T r c ()
forall r a z. CodeGenFunction r a -> T r z a
MaybeCont.lift (IORef (T p) -> Value (Ptr (Struct p)) -> CodeGenFunction r ()
forall param r.
C param =>
IORef (T param)
-> Value (Ptr (Struct param)) -> CodeGenFunction r ()
loadParam IORef (T p)
ref Value (Ptr (Struct p))
p) T r c () -> T r c (b, state) -> T r c (b, state)
forall a b. T r c a -> T r c b -> T r c b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> global -> Value (Ptr local) -> a -> state -> T r c (b, state)
forall r c.
Phi c =>
global -> Value (Ptr local) -> a -> state -> T r c (b, state)
next global
global Value (Ptr local)
local a
a state
state)
               (\Value (Ptr (Struct p))
p -> IORef (T p) -> Value (Ptr (Struct p)) -> CodeGenFunction r ()
forall param r.
C param =>
IORef (T param)
-> Value (Ptr (Struct param)) -> CodeGenFunction r ()
loadParam IORef (T p)
ref Value (Ptr (Struct p))
p CodeGenFunction r ()
-> CodeGenFunction r (global, state)
-> CodeGenFunction r (global, state)
forall a b.
CodeGenFunction r a -> CodeGenFunction r b -> CodeGenFunction r b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CodeGenFunction r (global, state)
forall r. CodeGenFunction r (global, state)
start)
               (\Value (Ptr (Struct p))
p global
global -> IORef (T p) -> Value (Ptr (Struct p)) -> CodeGenFunction r ()
forall param r.
C param =>
IORef (T param)
-> Value (Ptr (Struct param)) -> CodeGenFunction r ()
loadParam IORef (T p)
ref Value (Ptr (Struct p))
p CodeGenFunction r ()
-> CodeGenFunction r () -> CodeGenFunction r ()
forall a b.
CodeGenFunction r a -> CodeGenFunction r b -> CodeGenFunction r b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> global -> CodeGenFunction r ()
forall r. global -> CodeGenFunction r ()
stop global
global)

loadParam ::
   (Marshal.C param) =>
   IORef (MultiValue.T param) ->
   LLVM.Value (LLVM.Ptr (Marshal.Struct param)) ->
   LLVM.CodeGenFunction r ()
loadParam :: forall param r.
C param =>
IORef (T param)
-> Value (Ptr (Struct param)) -> CodeGenFunction r ()
loadParam IORef (T param)
ref Value (Ptr (Struct (Repr param)))
ptr = IO () -> CodeGenFunction r ()
forall a. IO a -> CodeGenFunction r a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CodeGenFunction r ())
-> (T param -> IO ()) -> T param -> CodeGenFunction r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef (T param) -> T param -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (T param)
ref (T param -> CodeGenFunction r ())
-> CodeGenFunction r (T param) -> CodeGenFunction r ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value (Ptr (Struct (T param))) -> CodeGenFunction r (T param)
forall llvmValue r.
C llvmValue =>
Value (Ptr (Struct llvmValue)) -> CodeGenFunction r llvmValue
forall r.
Value (Ptr (Struct (T param))) -> CodeGenFunction r (T param)
Memory.load Value (Ptr (Struct (Repr param)))
Value (Ptr (Struct (T param)))
ptr