{-# OPTIONS_GHC -Wno-redundant-constraints #-}
{-# LANGUAGE TypeFamilies, TypeOperators, DerivingVia, InstanceSigs, BangPatterns #-}
{-# LANGUAGE DataKinds, FlexibleContexts #-}

-- | This module provides an implementation for the typeclasses defined in
--   "Language.Souffle.Class".
--   It makes use of the low level Souffle C++ API to offer a much more
--   performant alternative implementation to the implementation in
--   "Language.Souffle.Interpreted".
--
--   This module is mainly intended to be used after the prototyping phase is
--   over since the iteration cycle is slower due to the additional
--   C++ compilation times.
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


-- | A datatype representing a handle to a datalog program.
--   The type parameter is used for keeping track of which program
--   type the handle belongs to for additional type safety.
newtype Handle prog = Handle (ForeignPtr Internal.Souffle)

-- | A monad for executing Souffle-related actions in.
newtype SouffleM a
  = SouffleM
  { SouffleM a -> IO a
runSouffle :: IO a  -- ^ Returns the underlying IO action.
  } 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

-- | A monad transformer, used solely for marshalling and unmarshalling
--   between Haskell and Souffle Datalog.
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 #-}

-- | Execute the monad transformer and return the result.
--   The tuple that is passed in will be used to marshal the data back and forth.
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 #-}

-- | Execute the monad transformer and return the result.
--   The tuple that is passed in will be used to marshal the data back and forth.
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 #-}