{-# OPTIONS_GHC -Wno-redundant-constraints #-}
{-# LANGUAGE FlexibleInstances, TypeFamilies, DerivingVia, InstanceSigs, BangPatterns #-}

-- | 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(..)
  , Direction(..)
  , ContainsInputFact
  , ContainsOutputFact
  , Handle
  , SouffleM
  , MonadSouffle(..)
  , MonadSouffleFileIO(..)
  , 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.Array as A
import qualified Data.Array.IO as A
import qualified Data.Array.Unsafe as A
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 (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
  deriving (b -> SouffleM a -> SouffleM a
NonEmpty (SouffleM a) -> SouffleM a
SouffleM a -> SouffleM a -> SouffleM a
(SouffleM a -> SouffleM a -> SouffleM a)
-> (NonEmpty (SouffleM a) -> SouffleM a)
-> (forall b. Integral b => b -> SouffleM a -> SouffleM a)
-> Semigroup (SouffleM a)
forall b. Integral b => b -> SouffleM a -> SouffleM a
forall a. Semigroup a => NonEmpty (SouffleM a) -> SouffleM a
forall a. Semigroup a => SouffleM a -> SouffleM a -> SouffleM a
forall a b.
(Semigroup a, Integral b) =>
b -> SouffleM a -> SouffleM a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> SouffleM a -> SouffleM a
$cstimes :: forall a b.
(Semigroup a, Integral b) =>
b -> SouffleM a -> SouffleM a
sconcat :: NonEmpty (SouffleM a) -> SouffleM a
$csconcat :: forall a. Semigroup a => NonEmpty (SouffleM a) -> SouffleM a
<> :: SouffleM a -> SouffleM a -> SouffleM a
$c<> :: forall a. Semigroup a => SouffleM a -> SouffleM a -> SouffleM a
Semigroup, Semigroup (SouffleM a)
SouffleM a
Semigroup (SouffleM a) =>
SouffleM a
-> (SouffleM a -> SouffleM a -> SouffleM a)
-> ([SouffleM a] -> SouffleM a)
-> Monoid (SouffleM a)
[SouffleM a] -> SouffleM a
SouffleM a -> SouffleM a -> SouffleM a
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. Monoid a => Semigroup (SouffleM a)
forall a. Monoid a => SouffleM a
forall a. Monoid a => [SouffleM a] -> SouffleM a
forall a. Monoid a => SouffleM a -> SouffleM a -> SouffleM a
mconcat :: [SouffleM a] -> SouffleM a
$cmconcat :: forall a. Monoid a => [SouffleM a] -> SouffleM a
mappend :: SouffleM a -> SouffleM a -> SouffleM a
$cmappend :: forall a. Monoid a => SouffleM a -> SouffleM a -> SouffleM a
mempty :: SouffleM a
$cmempty :: forall a. Monoid a => SouffleM a
$cp1Monoid :: forall a. Monoid a => Semigroup (SouffleM a)
Monoid) via (IO a)

{- | Initializes and runs a Souffle program.

     The 2nd argument is passed in a handle after initialization of the
     Souffle program. The handle will contain 'Nothing' if it failed to
     load the Souffle C++ program. In the successful case it will contain
     a handle that can be used for performing Souffle related actions
     using the other functions in this module.
-}
runSouffle :: forall prog a. Program prog
           => prog -> (Maybe (Handle prog) -> SouffleM a) -> IO a
runSouffle :: prog -> (Maybe (Handle prog) -> SouffleM a) -> IO a
runSouffle prog :: prog
prog action :: Maybe (Handle prog) -> SouffleM a
action =
  let progName :: String
progName = prog -> String
forall a. Program a => a -> String
programName prog
prog
      (SouffleM result :: IO a
result) = do
        Maybe (Handle prog)
handle <- (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))
-> SouffleM (Maybe (ForeignPtr Souffle))
-> SouffleM (Maybe (Handle prog))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe (ForeignPtr Souffle))
-> SouffleM (Maybe (ForeignPtr Souffle))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO (Maybe (ForeignPtr Souffle))
Internal.init String
progName)
        Maybe (Handle prog) -> SouffleM a
action Maybe (Handle prog)
handle
   in IO a
result

type Tuple = Ptr Internal.Tuple

-- | A monad used solely for marshalling and unmarshalling
--   between Haskell and Souffle Datalog.
newtype CMarshal a = CMarshal (ReaderT Tuple IO a)
  deriving (a -> CMarshal b -> CMarshal a
(a -> b) -> CMarshal a -> CMarshal b
(forall a b. (a -> b) -> CMarshal a -> CMarshal b)
-> (forall a b. a -> CMarshal b -> CMarshal a) -> Functor CMarshal
forall a b. a -> CMarshal b -> CMarshal a
forall a b. (a -> b) -> CMarshal a -> CMarshal b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> CMarshal b -> CMarshal a
$c<$ :: forall a b. a -> CMarshal b -> CMarshal a
fmap :: (a -> b) -> CMarshal a -> CMarshal b
$cfmap :: forall a b. (a -> b) -> CMarshal a -> CMarshal b
Functor, Functor CMarshal
a -> CMarshal a
Functor CMarshal =>
(forall a. a -> CMarshal a)
-> (forall a b. CMarshal (a -> b) -> CMarshal a -> CMarshal b)
-> (forall a b c.
    (a -> b -> c) -> CMarshal a -> CMarshal b -> CMarshal c)
-> (forall a b. CMarshal a -> CMarshal b -> CMarshal b)
-> (forall a b. CMarshal a -> CMarshal b -> CMarshal a)
-> Applicative CMarshal
CMarshal a -> CMarshal b -> CMarshal b
CMarshal a -> CMarshal b -> CMarshal a
CMarshal (a -> b) -> CMarshal a -> CMarshal b
(a -> b -> c) -> CMarshal a -> CMarshal b -> CMarshal c
forall a. a -> CMarshal a
forall a b. CMarshal a -> CMarshal b -> CMarshal a
forall a b. CMarshal a -> CMarshal b -> CMarshal b
forall a b. CMarshal (a -> b) -> CMarshal a -> CMarshal b
forall a b c.
(a -> b -> c) -> CMarshal a -> CMarshal b -> CMarshal 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
<* :: CMarshal a -> CMarshal b -> CMarshal a
$c<* :: forall a b. CMarshal a -> CMarshal b -> CMarshal a
*> :: CMarshal a -> CMarshal b -> CMarshal b
$c*> :: forall a b. CMarshal a -> CMarshal b -> CMarshal b
liftA2 :: (a -> b -> c) -> CMarshal a -> CMarshal b -> CMarshal c
$cliftA2 :: forall a b c.
(a -> b -> c) -> CMarshal a -> CMarshal b -> CMarshal c
<*> :: CMarshal (a -> b) -> CMarshal a -> CMarshal b
$c<*> :: forall a b. CMarshal (a -> b) -> CMarshal a -> CMarshal b
pure :: a -> CMarshal a
$cpure :: forall a. a -> CMarshal a
$cp1Applicative :: Functor CMarshal
Applicative, Applicative CMarshal
a -> CMarshal a
Applicative CMarshal =>
(forall a b. CMarshal a -> (a -> CMarshal b) -> CMarshal b)
-> (forall a b. CMarshal a -> CMarshal b -> CMarshal b)
-> (forall a. a -> CMarshal a)
-> Monad CMarshal
CMarshal a -> (a -> CMarshal b) -> CMarshal b
CMarshal a -> CMarshal b -> CMarshal b
forall a. a -> CMarshal a
forall a b. CMarshal a -> CMarshal b -> CMarshal b
forall a b. CMarshal a -> (a -> CMarshal b) -> CMarshal 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 -> CMarshal a
$creturn :: forall a. a -> CMarshal a
>> :: CMarshal a -> CMarshal b -> CMarshal b
$c>> :: forall a b. CMarshal a -> CMarshal b -> CMarshal b
>>= :: CMarshal a -> (a -> CMarshal b) -> CMarshal b
$c>>= :: forall a b. CMarshal a -> (a -> CMarshal b) -> CMarshal b
$cp1Monad :: Applicative CMarshal
Monad, Monad CMarshal
Monad CMarshal =>
(forall a. IO a -> CMarshal a) -> MonadIO CMarshal
IO a -> CMarshal a
forall a. IO a -> CMarshal a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> CMarshal a
$cliftIO :: forall a. IO a -> CMarshal a
$cp1MonadIO :: Monad CMarshal
MonadIO, MonadReader Tuple)
  via ( ReaderT Tuple IO )

runM :: CMarshal a -> Tuple -> IO a
runM :: CMarshal a -> Tuple -> IO a
runM (CMarshal m :: ReaderT Tuple IO a
m) = ReaderT Tuple IO a -> Tuple -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT Tuple IO a
m
{-# INLINABLE runM #-}

instance MonadPush CMarshal where
  pushInt32 :: Int32 -> CMarshal ()
pushInt32 int :: Int32
int = do
    Tuple
tuple <- CMarshal Tuple
forall r (m :: * -> *). MonadReader r m => m r
ask
    IO () -> CMarshal ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CMarshal ()) -> IO () -> CMarshal ()
forall a b. (a -> b) -> a -> b
$ Tuple -> Int32 -> IO ()
Internal.tuplePushInt32 Tuple
tuple Int32
int
  {-# INLINABLE pushInt32 #-}

  pushUInt32 :: Word32 -> CMarshal ()
pushUInt32 int :: Word32
int = do
    Tuple
tuple <- CMarshal Tuple
forall r (m :: * -> *). MonadReader r m => m r
ask
    IO () -> CMarshal ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CMarshal ()) -> IO () -> CMarshal ()
forall a b. (a -> b) -> a -> b
$ Tuple -> Word32 -> IO ()
Internal.tuplePushUInt32 Tuple
tuple Word32
int
  {-# INLINABLE pushUInt32 #-}

  pushFloat :: Float -> CMarshal ()
pushFloat float :: Float
float = do
    Tuple
tuple <- CMarshal Tuple
forall r (m :: * -> *). MonadReader r m => m r
ask
    IO () -> CMarshal ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CMarshal ()) -> IO () -> CMarshal ()
forall a b. (a -> b) -> a -> b
$ Tuple -> Float -> IO ()
Internal.tuplePushFloat Tuple
tuple Float
float
  {-# INLINABLE pushFloat #-}

  pushString :: String -> CMarshal ()
pushString str :: String
str = do
    Tuple
tuple <- CMarshal Tuple
forall r (m :: * -> *). MonadReader r m => m r
ask
    IO () -> CMarshal ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CMarshal ()) -> IO () -> CMarshal ()
forall a b. (a -> b) -> a -> b
$ Tuple -> String -> IO ()
Internal.tuplePushString Tuple
tuple String
str
  {-# INLINABLE pushString #-}

instance MonadPop CMarshal where
  popInt32 :: CMarshal Int32
popInt32 = do
    Tuple
tuple <- CMarshal Tuple
forall r (m :: * -> *). MonadReader r m => m r
ask
    IO Int32 -> CMarshal Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> CMarshal Int32) -> IO Int32 -> CMarshal Int32
forall a b. (a -> b) -> a -> b
$ Tuple -> IO Int32
Internal.tuplePopInt32 Tuple
tuple
  {-# INLINABLE popInt32 #-}

  popUInt32 :: CMarshal Word32
popUInt32 = do
    Tuple
tuple <- CMarshal Tuple
forall r (m :: * -> *). MonadReader r m => m r
ask
    IO Word32 -> CMarshal Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> CMarshal Word32) -> IO Word32 -> CMarshal Word32
forall a b. (a -> b) -> a -> b
$ Tuple -> IO Word32
Internal.tuplePopUInt32 Tuple
tuple
  {-# INLINABLE popUInt32 #-}

  popFloat :: CMarshal Float
popFloat = do
    Tuple
tuple <- CMarshal Tuple
forall r (m :: * -> *). MonadReader r m => m r
ask
    IO Float -> CMarshal Float
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Float -> CMarshal Float) -> IO Float -> CMarshal Float
forall a b. (a -> b) -> a -> b
$ Tuple -> IO Float
Internal.tuplePopFloat Tuple
tuple
  {-# INLINABLE popFloat #-}

  popString :: CMarshal String
popString = do
    Tuple
tuple <- CMarshal Tuple
forall r (m :: * -> *). MonadReader r m => m r
ask
    IO String -> CMarshal String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> CMarshal String) -> IO String -> CMarshal String
forall a b. (a -> b) -> a -> b
$ Tuple -> IO String
Internal.tuplePopString Tuple
tuple
  {-# INLINABLE popString #-}

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 <- CMarshal a -> Tuple -> IO a
forall a. CMarshal a -> Tuple -> IO a
runM CMarshal a
forall a (m :: * -> *). (Marshal a, MonadPop m) => m 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 <- CMarshal a -> Tuple -> IO a
forall a. CMarshal a -> Tuple -> IO a
runM CMarshal a
forall a (m :: * -> *). (Marshal a, MonadPop m) => m 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 Collect (A.Array Int) where
  collect :: Int -> ForeignPtr RelationIterator -> IO (Array Int a)
collect factCount :: Int
factCount iterator :: ForeignPtr RelationIterator
iterator = do
    IOArray Int a
array <- (Int, Int) -> IO (IOArray Int a)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> m (a i e)
A.newArray_ (0, Int
factCount Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
    IOArray Int a
-> Int -> Int -> ForeignPtr RelationIterator -> IO (Array Int a)
forall a.
Marshal a =>
IOArray Int a
-> Int -> Int -> ForeignPtr RelationIterator -> IO (Array Int a)
go IOArray Int a
array 0 Int
factCount ForeignPtr RelationIterator
iterator
    where
      go :: Marshal a
         => A.IOArray Int a
         -> Int
         -> Int
         -> ForeignPtr Internal.RelationIterator
         -> IO (A.Array Int a)
      go :: IOArray Int a
-> Int -> Int -> ForeignPtr RelationIterator -> IO (Array Int a)
go array :: IOArray Int a
array idx :: Int
idx count :: Int
count _ | Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
count = IOArray Int a -> IO (Array Int a)
forall i (a :: * -> * -> *) e (m :: * -> *) (b :: * -> * -> *).
(Ix i, MArray a e m, IArray b e) =>
a i e -> m (b i e)
A.unsafeFreeze IOArray Int a
array
      go array :: IOArray Int a
array idx :: Int
idx count :: Int
count it :: ForeignPtr RelationIterator
it = do
        Tuple
tuple <- ForeignPtr RelationIterator -> IO Tuple
Internal.relationIteratorNext ForeignPtr RelationIterator
it
        a
result <- CMarshal a -> Tuple -> IO a
forall a. CMarshal a -> Tuple -> IO a
runM CMarshal a
forall a (m :: * -> *). (Marshal a, MonadPop m) => m a
pop Tuple
tuple
        IOArray Int a -> Int -> a -> IO ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
A.writeArray IOArray Int a
array Int
idx a
result
        IOArray Int a
-> Int -> Int -> ForeignPtr RelationIterator -> IO (Array Int a)
forall a.
Marshal a =>
IOArray Int a
-> Int -> Int -> ForeignPtr RelationIterator -> IO (Array Int a)
go IOArray Int a
array (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

  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, ContainsInputFact 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, ContainsInputFact 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, ContainsOutputFact 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, ContainsOutputFact prog a)
           => Handle prog -> a -> SouffleM (Maybe a)
  findFact :: Handle prog -> a -> SouffleM (Maybe a)
findFact (Handle prog :: ForeignPtr Souffle
prog) fact :: a
fact = 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
$ CMarshal () -> Tuple -> IO ()
forall a. CMarshal a -> Tuple -> IO a
runM (a -> CMarshal ()
forall a (m :: * -> *). (Marshal a, MonadPush m) => a -> m ()
push a
fact)
    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
fact 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
$ CMarshal () -> Tuple -> IO ()
forall a. CMarshal a -> Tuple -> IO a
runM (a -> CMarshal ()
forall a (m :: * -> *). (Marshal a, MonadPush m) => a -> m ()
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 -> String -> SouffleM ()
writeFiles (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.printAll ForeignPtr Souffle
prog
  {-# INLINABLE writeFiles #-}