{-# 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