{-# OPTIONS_GHC -Wno-redundant-constraints #-}
{-# LANGUAGE TypeFamilies, TypeOperators, DerivingVia, InstanceSigs, BangPatterns #-}
{-# LANGUAGE DataKinds, FlexibleContexts #-}
module Language.Souffle.Compiled
( Program(..)
, Fact(..)
, Marshal(..)
, Handle
, SouffleM
, MonadSouffle(..)
, runSouffle
) where
import Prelude hiding ( init )
import Control.Monad.Except
import Control.Monad.RWS.Strict
import Control.Monad.Reader
import Data.Foldable ( traverse_ )
import Data.Proxy
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as MV
import Foreign.ForeignPtr
import Foreign.Ptr
import Language.Souffle.Class
import qualified Language.Souffle.Internal as Internal
import Language.Souffle.Marshal
newtype Handle prog = Handle (ForeignPtr Internal.Souffle)
newtype SouffleM a
= SouffleM
{ SouffleM a -> IO a
runSouffle :: IO a
} deriving ( a -> SouffleM b -> SouffleM a
(a -> b) -> SouffleM a -> SouffleM b
(forall a b. (a -> b) -> SouffleM a -> SouffleM b)
-> (forall a b. a -> SouffleM b -> SouffleM a) -> Functor SouffleM
forall a b. a -> SouffleM b -> SouffleM a
forall a b. (a -> b) -> SouffleM a -> SouffleM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> SouffleM b -> SouffleM a
$c<$ :: forall a b. a -> SouffleM b -> SouffleM a
fmap :: (a -> b) -> SouffleM a -> SouffleM b
$cfmap :: forall a b. (a -> b) -> SouffleM a -> SouffleM b
Functor, Functor SouffleM
a -> SouffleM a
Functor SouffleM =>
(forall a. a -> SouffleM a)
-> (forall a b. SouffleM (a -> b) -> SouffleM a -> SouffleM b)
-> (forall a b c.
(a -> b -> c) -> SouffleM a -> SouffleM b -> SouffleM c)
-> (forall a b. SouffleM a -> SouffleM b -> SouffleM b)
-> (forall a b. SouffleM a -> SouffleM b -> SouffleM a)
-> Applicative SouffleM
SouffleM a -> SouffleM b -> SouffleM b
SouffleM a -> SouffleM b -> SouffleM a
SouffleM (a -> b) -> SouffleM a -> SouffleM b
(a -> b -> c) -> SouffleM a -> SouffleM b -> SouffleM c
forall a. a -> SouffleM a
forall a b. SouffleM a -> SouffleM b -> SouffleM a
forall a b. SouffleM a -> SouffleM b -> SouffleM b
forall a b. SouffleM (a -> b) -> SouffleM a -> SouffleM b
forall a b c.
(a -> b -> c) -> SouffleM a -> SouffleM b -> SouffleM c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: SouffleM a -> SouffleM b -> SouffleM a
$c<* :: forall a b. SouffleM a -> SouffleM b -> SouffleM a
*> :: SouffleM a -> SouffleM b -> SouffleM b
$c*> :: forall a b. SouffleM a -> SouffleM b -> SouffleM b
liftA2 :: (a -> b -> c) -> SouffleM a -> SouffleM b -> SouffleM c
$cliftA2 :: forall a b c.
(a -> b -> c) -> SouffleM a -> SouffleM b -> SouffleM c
<*> :: SouffleM (a -> b) -> SouffleM a -> SouffleM b
$c<*> :: forall a b. SouffleM (a -> b) -> SouffleM a -> SouffleM b
pure :: a -> SouffleM a
$cpure :: forall a. a -> SouffleM a
$cp1Applicative :: Functor SouffleM
Applicative, Applicative SouffleM
a -> SouffleM a
Applicative SouffleM =>
(forall a b. SouffleM a -> (a -> SouffleM b) -> SouffleM b)
-> (forall a b. SouffleM a -> SouffleM b -> SouffleM b)
-> (forall a. a -> SouffleM a)
-> Monad SouffleM
SouffleM a -> (a -> SouffleM b) -> SouffleM b
SouffleM a -> SouffleM b -> SouffleM b
forall a. a -> SouffleM a
forall a b. SouffleM a -> SouffleM b -> SouffleM b
forall a b. SouffleM a -> (a -> SouffleM b) -> SouffleM b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> SouffleM a
$creturn :: forall a. a -> SouffleM a
>> :: SouffleM a -> SouffleM b -> SouffleM b
$c>> :: forall a b. SouffleM a -> SouffleM b -> SouffleM b
>>= :: SouffleM a -> (a -> SouffleM b) -> SouffleM b
$c>>= :: forall a b. SouffleM a -> (a -> SouffleM b) -> SouffleM b
$cp1Monad :: Applicative SouffleM
Monad, Monad SouffleM
Monad SouffleM =>
(forall a. IO a -> SouffleM a) -> MonadIO SouffleM
IO a -> SouffleM a
forall a. IO a -> SouffleM a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> SouffleM a
$cliftIO :: forall a. IO a -> SouffleM a
$cp1MonadIO :: Monad SouffleM
MonadIO ) via IO
type Tuple = Ptr Internal.Tuple
newtype MarshalT m a = MarshalT (ReaderT Tuple m a)
deriving ( a -> MarshalT m b -> MarshalT m a
(a -> b) -> MarshalT m a -> MarshalT m b
(forall a b. (a -> b) -> MarshalT m a -> MarshalT m b)
-> (forall a b. a -> MarshalT m b -> MarshalT m a)
-> Functor (MarshalT m)
forall a b. a -> MarshalT m b -> MarshalT m a
forall a b. (a -> b) -> MarshalT m a -> MarshalT m b
forall (m :: * -> *) a b.
Functor m =>
a -> MarshalT m b -> MarshalT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> MarshalT m a -> MarshalT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> MarshalT m b -> MarshalT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> MarshalT m b -> MarshalT m a
fmap :: (a -> b) -> MarshalT m a -> MarshalT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> MarshalT m a -> MarshalT m b
Functor, Functor (MarshalT m)
a -> MarshalT m a
Functor (MarshalT m) =>
(forall a. a -> MarshalT m a)
-> (forall a b.
MarshalT m (a -> b) -> MarshalT m a -> MarshalT m b)
-> (forall a b c.
(a -> b -> c) -> MarshalT m a -> MarshalT m b -> MarshalT m c)
-> (forall a b. MarshalT m a -> MarshalT m b -> MarshalT m b)
-> (forall a b. MarshalT m a -> MarshalT m b -> MarshalT m a)
-> Applicative (MarshalT m)
MarshalT m a -> MarshalT m b -> MarshalT m b
MarshalT m a -> MarshalT m b -> MarshalT m a
MarshalT m (a -> b) -> MarshalT m a -> MarshalT m b
(a -> b -> c) -> MarshalT m a -> MarshalT m b -> MarshalT m c
forall a. a -> MarshalT m a
forall a b. MarshalT m a -> MarshalT m b -> MarshalT m a
forall a b. MarshalT m a -> MarshalT m b -> MarshalT m b
forall a b. MarshalT m (a -> b) -> MarshalT m a -> MarshalT m b
forall a b c.
(a -> b -> c) -> MarshalT m a -> MarshalT m b -> MarshalT m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: * -> *). Applicative m => Functor (MarshalT m)
forall (m :: * -> *) a. Applicative m => a -> MarshalT m a
forall (m :: * -> *) a b.
Applicative m =>
MarshalT m a -> MarshalT m b -> MarshalT m a
forall (m :: * -> *) a b.
Applicative m =>
MarshalT m a -> MarshalT m b -> MarshalT m b
forall (m :: * -> *) a b.
Applicative m =>
MarshalT m (a -> b) -> MarshalT m a -> MarshalT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> MarshalT m a -> MarshalT m b -> MarshalT m c
<* :: MarshalT m a -> MarshalT m b -> MarshalT m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
MarshalT m a -> MarshalT m b -> MarshalT m a
*> :: MarshalT m a -> MarshalT m b -> MarshalT m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
MarshalT m a -> MarshalT m b -> MarshalT m b
liftA2 :: (a -> b -> c) -> MarshalT m a -> MarshalT m b -> MarshalT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> MarshalT m a -> MarshalT m b -> MarshalT m c
<*> :: MarshalT m (a -> b) -> MarshalT m a -> MarshalT m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
MarshalT m (a -> b) -> MarshalT m a -> MarshalT m b
pure :: a -> MarshalT m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> MarshalT m a
$cp1Applicative :: forall (m :: * -> *). Applicative m => Functor (MarshalT m)
Applicative, Applicative (MarshalT m)
a -> MarshalT m a
Applicative (MarshalT m) =>
(forall a b. MarshalT m a -> (a -> MarshalT m b) -> MarshalT m b)
-> (forall a b. MarshalT m a -> MarshalT m b -> MarshalT m b)
-> (forall a. a -> MarshalT m a)
-> Monad (MarshalT m)
MarshalT m a -> (a -> MarshalT m b) -> MarshalT m b
MarshalT m a -> MarshalT m b -> MarshalT m b
forall a. a -> MarshalT m a
forall a b. MarshalT m a -> MarshalT m b -> MarshalT m b
forall a b. MarshalT m a -> (a -> MarshalT m b) -> MarshalT m b
forall (m :: * -> *). Monad m => Applicative (MarshalT m)
forall (m :: * -> *) a. Monad m => a -> MarshalT m a
forall (m :: * -> *) a b.
Monad m =>
MarshalT m a -> MarshalT m b -> MarshalT m b
forall (m :: * -> *) a b.
Monad m =>
MarshalT m a -> (a -> MarshalT m b) -> MarshalT m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> MarshalT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> MarshalT m a
>> :: MarshalT m a -> MarshalT m b -> MarshalT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
MarshalT m a -> MarshalT m b -> MarshalT m b
>>= :: MarshalT m a -> (a -> MarshalT m b) -> MarshalT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
MarshalT m a -> (a -> MarshalT m b) -> MarshalT m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (MarshalT m)
Monad
, Monad (MarshalT m)
Monad (MarshalT m) =>
(forall a. IO a -> MarshalT m a) -> MonadIO (MarshalT m)
IO a -> MarshalT m a
forall a. IO a -> MarshalT m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (MarshalT m)
forall (m :: * -> *) a. MonadIO m => IO a -> MarshalT m a
liftIO :: IO a -> MarshalT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> MarshalT m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (MarshalT m)
MonadIO, MonadReader Tuple, MonadWriter w
, MonadState s, MonadRWS Tuple w s, MonadError e )
via ( ReaderT Tuple m )
deriving m a -> MarshalT m a
(forall (m :: * -> *) a. Monad m => m a -> MarshalT m a)
-> MonadTrans MarshalT
forall (m :: * -> *) a. Monad m => m a -> MarshalT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> MarshalT m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> MarshalT m a
MonadTrans via (ReaderT Tuple)
runM :: Monad m => MarshalT m a -> Tuple -> m a
runM :: MarshalT m a -> Tuple -> m a
runM (MarshalT m :: ReaderT Tuple m a
m) = ReaderT Tuple m a -> Tuple -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT Tuple m a
m
{-# INLINABLE runM #-}
runPushT :: MonadIO m => MarshalM PushF a -> Tuple -> m a
runPushT :: MarshalM PushF a -> Tuple -> m a
runPushT = MarshalT m a -> Tuple -> m a
forall (m :: * -> *) a. Monad m => MarshalT m a -> Tuple -> m a
runM (MarshalT m a -> Tuple -> m a)
-> (MarshalM PushF a -> MarshalT m a)
-> MarshalM PushF a
-> Tuple
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x. PushF x -> MarshalT m x)
-> MarshalM PushF a -> MarshalT m a
forall (m :: * -> *) (f :: * -> *) a.
Monad m =>
(forall x. f x -> m x) -> MarshalM f a -> m a
interpret forall x. PushF x -> MarshalT m x
forall (m :: * -> *) a.
(MonadReader Tuple m, MonadIO m) =>
PushF a -> m a
pushAlgM where
pushAlgM :: PushF a -> m a
pushAlgM (PushInt int :: Int32
int v :: a
v) = do
Tuple
tuple <- m Tuple
forall r (m :: * -> *). MonadReader r m => m r
ask
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Tuple -> Int32 -> IO ()
Internal.tuplePushInt Tuple
tuple Int32
int
a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v
pushAlgM (PushStr str :: String
str v :: a
v) = do
Tuple
tuple <- m Tuple
forall r (m :: * -> *). MonadReader r m => m r
ask
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Tuple -> String -> IO ()
Internal.tuplePushString Tuple
tuple String
str
a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v
{-# INLINABLE runPushT #-}
runPopT :: MonadIO m => MarshalM PopF a -> Tuple -> m a
runPopT :: MarshalM PopF a -> Tuple -> m a
runPopT = MarshalT m a -> Tuple -> m a
forall (m :: * -> *) a. Monad m => MarshalT m a -> Tuple -> m a
runM (MarshalT m a -> Tuple -> m a)
-> (MarshalM PopF a -> MarshalT m a)
-> MarshalM PopF a
-> Tuple
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x. PopF x -> MarshalT m x)
-> MarshalM PopF a -> MarshalT m a
forall (m :: * -> *) (f :: * -> *) a.
Monad m =>
(forall x. f x -> m x) -> MarshalM f a -> m a
interpret forall x. PopF x -> MarshalT m x
forall (m :: * -> *) a. MonadIO m => PopF a -> MarshalT m a
popAlgM where
popAlgM :: PopF a -> MarshalT m a
popAlgM (PopStr f :: String -> a
f) = ReaderT Tuple m a -> MarshalT m a
forall (m :: * -> *) a. ReaderT Tuple m a -> MarshalT m a
MarshalT (ReaderT Tuple m a -> MarshalT m a)
-> ReaderT Tuple m a -> MarshalT m a
forall a b. (a -> b) -> a -> b
$ do
Tuple
tuple <- ReaderT Tuple m Tuple
forall r (m :: * -> *). MonadReader r m => m r
ask
String
str <- IO String -> ReaderT Tuple m String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> ReaderT Tuple m String)
-> IO String -> ReaderT Tuple m String
forall a b. (a -> b) -> a -> b
$ Tuple -> IO String
Internal.tuplePopString Tuple
tuple
a -> ReaderT Tuple m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> ReaderT Tuple m a) -> a -> ReaderT Tuple m a
forall a b. (a -> b) -> a -> b
$ String -> a
f String
str
popAlgM (PopInt f :: Int32 -> a
f) = ReaderT Tuple m a -> MarshalT m a
forall (m :: * -> *) a. ReaderT Tuple m a -> MarshalT m a
MarshalT (ReaderT Tuple m a -> MarshalT m a)
-> ReaderT Tuple m a -> MarshalT m a
forall a b. (a -> b) -> a -> b
$ do
Tuple
tuple <- ReaderT Tuple m Tuple
forall r (m :: * -> *). MonadReader r m => m r
ask
Int32
int <- IO Int32 -> ReaderT Tuple m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> ReaderT Tuple m Int32)
-> IO Int32 -> ReaderT Tuple m Int32
forall a b. (a -> b) -> a -> b
$ Tuple -> IO Int32
Internal.tuplePopInt Tuple
tuple
a -> ReaderT Tuple m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> ReaderT Tuple m a) -> a -> ReaderT Tuple m a
forall a b. (a -> b) -> a -> b
$ Int32 -> a
f Int32
int
{-# INLINABLE runPopT #-}
class Collect c where
collect :: Marshal a => Int -> ForeignPtr Internal.RelationIterator -> IO (c a)
instance Collect [] where
collect :: Int -> ForeignPtr RelationIterator -> IO [a]
collect factCount :: Int
factCount = Int -> Int -> [a] -> ForeignPtr RelationIterator -> IO [a]
forall t a.
(Eq t, Marshal a, Num t) =>
t -> t -> [a] -> ForeignPtr RelationIterator -> IO [a]
go 0 Int
factCount []
where
go :: t -> t -> [a] -> ForeignPtr RelationIterator -> IO [a]
go idx :: t
idx count :: t
count acc :: [a]
acc _ | t
idx t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
count = [a] -> IO [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [a]
acc
go idx :: t
idx count :: t
count ![a]
acc !ForeignPtr RelationIterator
it = do
Tuple
tuple <- ForeignPtr RelationIterator -> IO Tuple
Internal.relationIteratorNext ForeignPtr RelationIterator
it
a
result <- MarshalM PopF a -> Tuple -> IO a
forall (m :: * -> *) a.
MonadIO m =>
MarshalM PopF a -> Tuple -> m a
runPopT MarshalM PopF a
forall a. Marshal a => MarshalM PopF a
pop Tuple
tuple
t -> t -> [a] -> ForeignPtr RelationIterator -> IO [a]
go (t
idx t -> t -> t
forall a. Num a => a -> a -> a
+ 1) t
count (a
result a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
acc) ForeignPtr RelationIterator
it
{-# INLINABLE collect #-}
instance Collect V.Vector where
collect :: Int -> ForeignPtr RelationIterator -> IO (Vector a)
collect factCount :: Int
factCount iterator :: ForeignPtr RelationIterator
iterator = do
MVector RealWorld a
vec <- Int -> IO (MVector (PrimState IO) a)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> m (MVector (PrimState m) a)
MV.unsafeNew Int
factCount
MVector RealWorld a
-> Int -> Int -> ForeignPtr RelationIterator -> IO (Vector a)
forall a.
Marshal a =>
MVector RealWorld a
-> Int -> Int -> ForeignPtr RelationIterator -> IO (Vector a)
go MVector RealWorld a
vec 0 Int
factCount ForeignPtr RelationIterator
iterator
where
go :: MVector RealWorld a
-> Int -> Int -> ForeignPtr RelationIterator -> IO (Vector a)
go vec :: MVector RealWorld a
vec idx :: Int
idx count :: Int
count _ | Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
count = MVector (PrimState IO) a -> IO (Vector a)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
V.unsafeFreeze MVector RealWorld a
MVector (PrimState IO) a
vec
go vec :: MVector RealWorld a
vec idx :: Int
idx count :: Int
count it :: ForeignPtr RelationIterator
it = do
Tuple
tuple <- ForeignPtr RelationIterator -> IO Tuple
Internal.relationIteratorNext ForeignPtr RelationIterator
it
a
result <- MarshalM PopF a -> Tuple -> IO a
forall (m :: * -> *) a.
MonadIO m =>
MarshalM PopF a -> Tuple -> m a
runPopT MarshalM PopF a
forall a. Marshal a => MarshalM PopF a
pop Tuple
tuple
MVector (PrimState IO) a -> Int -> a -> IO ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.unsafeWrite MVector RealWorld a
MVector (PrimState IO) a
vec Int
idx a
result
MVector RealWorld a
-> Int -> Int -> ForeignPtr RelationIterator -> IO (Vector a)
go MVector RealWorld a
vec (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) Int
count ForeignPtr RelationIterator
it
{-# INLINABLE collect #-}
instance MonadSouffle SouffleM where
type Handler SouffleM = Handle
type CollectFacts SouffleM c = Collect c
init :: forall prog. Program prog
=> prog -> SouffleM (Maybe (Handle prog))
init :: prog -> SouffleM (Maybe (Handle prog))
init _ =
let progName :: String
progName = Proxy prog -> String
forall a. Program a => Proxy a -> String
programName (Proxy prog
forall k (t :: k). Proxy t
Proxy :: Proxy prog)
in IO (Maybe (Handle prog)) -> SouffleM (Maybe (Handle prog))
forall a. IO a -> SouffleM a
SouffleM (IO (Maybe (Handle prog)) -> SouffleM (Maybe (Handle prog)))
-> IO (Maybe (Handle prog)) -> SouffleM (Maybe (Handle prog))
forall a b. (a -> b) -> a -> b
$ (ForeignPtr Souffle -> Handle prog)
-> Maybe (ForeignPtr Souffle) -> Maybe (Handle prog)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ForeignPtr Souffle -> Handle prog
forall prog. ForeignPtr Souffle -> Handle prog
Handle (Maybe (ForeignPtr Souffle) -> Maybe (Handle prog))
-> IO (Maybe (ForeignPtr Souffle)) -> IO (Maybe (Handle prog))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe (ForeignPtr Souffle))
Internal.init String
progName
{-# INLINABLE init #-}
run :: Handler SouffleM prog -> SouffleM ()
run (Handle prog) = IO () -> SouffleM ()
forall a. IO a -> SouffleM a
SouffleM (IO () -> SouffleM ()) -> IO () -> SouffleM ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr Souffle -> IO ()
Internal.run ForeignPtr Souffle
prog
{-# INLINABLE run #-}
setNumThreads :: Handler SouffleM prog -> Word64 -> SouffleM ()
setNumThreads (Handle prog) numCores :: Word64
numCores =
IO () -> SouffleM ()
forall a. IO a -> SouffleM a
SouffleM (IO () -> SouffleM ()) -> IO () -> SouffleM ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr Souffle -> Word64 -> IO ()
Internal.setNumThreads ForeignPtr Souffle
prog Word64
numCores
{-# INLINABLE setNumThreads #-}
getNumThreads :: Handler SouffleM prog -> SouffleM Word64
getNumThreads (Handle prog) =
IO Word64 -> SouffleM Word64
forall a. IO a -> SouffleM a
SouffleM (IO Word64 -> SouffleM Word64) -> IO Word64 -> SouffleM Word64
forall a b. (a -> b) -> a -> b
$ ForeignPtr Souffle -> IO Word64
Internal.getNumThreads ForeignPtr Souffle
prog
{-# INLINABLE getNumThreads #-}
addFact :: forall a prog. (Fact a, ContainsFact prog a)
=> Handle prog -> a -> SouffleM ()
addFact :: Handle prog -> a -> SouffleM ()
addFact (Handle prog :: ForeignPtr Souffle
prog) fact :: a
fact = IO () -> SouffleM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> SouffleM ()) -> IO () -> SouffleM ()
forall a b. (a -> b) -> a -> b
$ do
let relationName :: String
relationName = Proxy a -> String
forall a. Fact a => Proxy a -> String
factName (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
Ptr Relation
relation <- ForeignPtr Souffle -> String -> IO (Ptr Relation)
Internal.getRelation ForeignPtr Souffle
prog String
relationName
Ptr Relation -> a -> IO ()
forall a. Fact a => Ptr Relation -> a -> IO ()
addFact' Ptr Relation
relation a
fact
{-# INLINABLE addFact #-}
addFacts :: forall t a prog . (Foldable t, Fact a, ContainsFact prog a)
=> Handle prog -> t a -> SouffleM ()
addFacts :: Handle prog -> t a -> SouffleM ()
addFacts (Handle prog :: ForeignPtr Souffle
prog) facts :: t a
facts = IO () -> SouffleM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> SouffleM ()) -> IO () -> SouffleM ()
forall a b. (a -> b) -> a -> b
$ do
let relationName :: String
relationName = Proxy a -> String
forall a. Fact a => Proxy a -> String
factName (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
Ptr Relation
relation <- ForeignPtr Souffle -> String -> IO (Ptr Relation)
Internal.getRelation ForeignPtr Souffle
prog String
relationName
(a -> IO ()) -> t a -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Ptr Relation -> a -> IO ()
forall a. Fact a => Ptr Relation -> a -> IO ()
addFact' Ptr Relation
relation) t a
facts
{-# INLINABLE addFacts #-}
getFacts :: forall a c prog. (Fact a, ContainsFact prog a, Collect c)
=> Handle prog -> SouffleM (c a)
getFacts :: Handle prog -> SouffleM (c a)
getFacts (Handle prog :: ForeignPtr Souffle
prog) = IO (c a) -> SouffleM (c a)
forall a. IO a -> SouffleM a
SouffleM (IO (c a) -> SouffleM (c a)) -> IO (c a) -> SouffleM (c a)
forall a b. (a -> b) -> a -> b
$ do
let relationName :: String
relationName = Proxy a -> String
forall a. Fact a => Proxy a -> String
factName (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
Ptr Relation
relation <- ForeignPtr Souffle -> String -> IO (Ptr Relation)
Internal.getRelation ForeignPtr Souffle
prog String
relationName
Int
factCount <- Ptr Relation -> IO Int
Internal.countFacts Ptr Relation
relation
Ptr Relation -> IO (ForeignPtr RelationIterator)
Internal.getRelationIterator Ptr Relation
relation IO (ForeignPtr RelationIterator)
-> (ForeignPtr RelationIterator -> IO (c a)) -> IO (c a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> ForeignPtr RelationIterator -> IO (c a)
forall (c :: * -> *) a.
(Collect c, Marshal a) =>
Int -> ForeignPtr RelationIterator -> IO (c a)
collect Int
factCount
{-# INLINABLE getFacts #-}
findFact :: forall a prog. (Fact a, ContainsFact prog a)
=> Handle prog -> a -> SouffleM (Maybe a)
findFact :: Handle prog -> a -> SouffleM (Maybe a)
findFact (Handle prog :: ForeignPtr Souffle
prog) a :: a
a = IO (Maybe a) -> SouffleM (Maybe a)
forall a. IO a -> SouffleM a
SouffleM (IO (Maybe a) -> SouffleM (Maybe a))
-> IO (Maybe a) -> SouffleM (Maybe a)
forall a b. (a -> b) -> a -> b
$ do
let relationName :: String
relationName = Proxy a -> String
forall a. Fact a => Proxy a -> String
factName (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
Ptr Relation
relation <- ForeignPtr Souffle -> String -> IO (Ptr Relation)
Internal.getRelation ForeignPtr Souffle
prog String
relationName
ForeignPtr Tuple
tuple <- Ptr Relation -> IO (ForeignPtr Tuple)
Internal.allocTuple Ptr Relation
relation
ForeignPtr Tuple -> (Tuple -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Tuple
tuple ((Tuple -> IO ()) -> IO ()) -> (Tuple -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ MarshalM PushF () -> Tuple -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
MarshalM PushF a -> Tuple -> m a
runPushT (a -> MarshalM PushF ()
forall a. Marshal a => a -> MarshalM PushF ()
push a
a)
Bool
found <- Ptr Relation -> ForeignPtr Tuple -> IO Bool
Internal.containsTuple Ptr Relation
relation ForeignPtr Tuple
tuple
Maybe a -> IO (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> IO (Maybe a)) -> Maybe a -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ if Bool
found then a -> Maybe a
forall a. a -> Maybe a
Just a
a else Maybe a
forall a. Maybe a
Nothing
{-# INLINABLE findFact #-}
addFact' :: Fact a => Ptr Internal.Relation -> a -> IO ()
addFact' :: Ptr Relation -> a -> IO ()
addFact' relation :: Ptr Relation
relation fact :: a
fact = do
ForeignPtr Tuple
tuple <- Ptr Relation -> IO (ForeignPtr Tuple)
Internal.allocTuple Ptr Relation
relation
ForeignPtr Tuple -> (Tuple -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Tuple
tuple ((Tuple -> IO ()) -> IO ()) -> (Tuple -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ MarshalM PushF () -> Tuple -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
MarshalM PushF a -> Tuple -> m a
runPushT (a -> MarshalM PushF ()
forall a. Marshal a => a -> MarshalM PushF ()
push a
fact)
Ptr Relation -> ForeignPtr Tuple -> IO ()
Internal.addTuple Ptr Relation
relation ForeignPtr Tuple
tuple
{-# INLINABLE addFact' #-}
instance MonadSouffleFileIO SouffleM where
loadFiles :: Handler SouffleM prog -> String -> SouffleM ()
loadFiles (Handle prog) = IO () -> SouffleM ()
forall a. IO a -> SouffleM a
SouffleM (IO () -> SouffleM ())
-> (String -> IO ()) -> String -> SouffleM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignPtr Souffle -> String -> IO ()
Internal.loadAll ForeignPtr Souffle
prog
{-# INLINABLE loadFiles #-}
writeFiles :: Handler SouffleM prog -> SouffleM ()
writeFiles (Handle prog) = IO () -> SouffleM ()
forall a. IO a -> SouffleM a
SouffleM (IO () -> SouffleM ()) -> IO () -> SouffleM ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr Souffle -> IO ()
Internal.printAll ForeignPtr Souffle
prog
{-# INLINABLE writeFiles #-}