packages feed

souffle-haskell 2.1.0 → 3.0.0

raw patch · 21 files changed

+3170/−3006 lines, 21 filesdep +bytestringdep +criteriondep +text-shortPVP ok

version bump matches the API change (PVP)

Dependencies added: bytestring, criterion, text-short

API changes (from Hackage documentation)

- Language.Souffle.Compiled: instance Control.Monad.IO.Class.MonadIO Language.Souffle.Compiled.CMarshal
- Language.Souffle.Compiled: instance Control.Monad.Reader.Class.MonadReader Language.Souffle.Compiled.Tuple Language.Souffle.Compiled.CMarshal
- Language.Souffle.Compiled: instance GHC.Base.Applicative Language.Souffle.Compiled.CMarshal
- Language.Souffle.Compiled: instance GHC.Base.Functor Language.Souffle.Compiled.CMarshal
- Language.Souffle.Compiled: instance GHC.Base.Monad Language.Souffle.Compiled.CMarshal
- Language.Souffle.Compiled: instance Language.Souffle.Marshal.MonadPop Language.Souffle.Compiled.CMarshal
- Language.Souffle.Compiled: instance Language.Souffle.Marshal.MonadPush Language.Souffle.Compiled.CMarshal
- Language.Souffle.Experimental: (.!=) :: Term ctx ty -> Term ctx ty -> Body ctx ()
- Language.Souffle.Experimental: (.%) :: (Num ty, Integral ty) => Term ctx ty -> Term ctx ty -> Term ctx ty
- Language.Souffle.Experimental: (.<) :: Num ty => Term ctx ty -> Term ctx ty -> Body ctx ()
- Language.Souffle.Experimental: (.<=) :: Num ty => Term ctx ty -> Term ctx ty -> Body ctx ()
- Language.Souffle.Experimental: (.=) :: Term ctx ty -> Term ctx ty -> Body ctx ()
- Language.Souffle.Experimental: (.>) :: Num ty => Term ctx ty -> Term ctx ty -> Body ctx ()
- Language.Souffle.Experimental: (.>=) :: Num ty => Term ctx ty -> Term ctx ty -> Body ctx ()
- Language.Souffle.Experimental: (.^) :: Num ty => Term ctx ty -> Term ctx ty -> Term ctx ty
- Language.Souffle.Experimental: (\/) :: Body ctx () -> Body ctx () -> Body ctx ()
- Language.Souffle.Experimental: (|-) :: Head 'Relation a -> Body 'Relation () -> DSL prog 'Definition ()
- Language.Souffle.Experimental: Definition :: UsageContext
- Language.Souffle.Experimental: Input :: Direction
- Language.Souffle.Experimental: InputOutput :: Direction
- Language.Souffle.Experimental: Internal :: Direction
- Language.Souffle.Experimental: Metadata :: StructureOpt a -> InlineOpt (FactDirection a) -> Metadata a
- Language.Souffle.Experimental: Output :: Direction
- Language.Souffle.Experimental: Predicate :: (forall f ctx. Fragment f ctx => Tuple ctx (Structure a) -> f ctx ()) -> Predicate a
- Language.Souffle.Experimental: Relation :: UsageContext
- Language.Souffle.Experimental: [Automatic] :: StructureOpt a
- Language.Souffle.Experimental: [BTree] :: StructureOpt a
- Language.Souffle.Experimental: [Brie] :: StructureOpt a
- Language.Souffle.Experimental: [EqRel] :: (IsBinaryRelation a, Structure a ~ '[t, t]) => StructureOpt a
- Language.Souffle.Experimental: [Inline] :: InlineOpt 'Internal
- Language.Souffle.Experimental: [NoInline] :: InlineOpt d
- Language.Souffle.Experimental: __ :: Term ctx ty
- Language.Souffle.Experimental: band :: (Num ty, Integral ty) => Term ctx ty -> Term ctx ty -> Term ctx ty
- Language.Souffle.Experimental: bor :: (Num ty, Integral ty) => Term ctx ty -> Term ctx ty -> Term ctx ty
- Language.Souffle.Experimental: bxor :: (Num ty, Integral ty) => Term ctx ty -> Term ctx ty -> Term ctx ty
- Language.Souffle.Experimental: cat :: ToString ty => Term ctx ty -> Term ctx ty -> Term ctx ty
- Language.Souffle.Experimental: class (Fact a, SimpleProduct a) => FactMetadata a
- Language.Souffle.Experimental: class Fragment f ctx
- Language.Souffle.Experimental: class Num ty => SupportsArithmetic ty
- Language.Souffle.Experimental: contains :: ToString ty => Term ctx ty -> Term ctx ty -> Body ctx ()
- Language.Souffle.Experimental: data Body ctx a
- Language.Souffle.Experimental: data DSL prog ctx a
- Language.Souffle.Experimental: data Direction
- Language.Souffle.Experimental: data Head ctx unused
- Language.Souffle.Experimental: data InlineOpt (d :: Direction)
- Language.Souffle.Experimental: data Metadata a
- Language.Souffle.Experimental: data StructureOpt (a :: Type)
- Language.Souffle.Experimental: data Term ctx ty
- Language.Souffle.Experimental: data UsageContext
- Language.Souffle.Experimental: embedProgram :: Program prog => prog -> DSL prog 'Definition () -> Q [Dec]
- Language.Souffle.Experimental: factOpts :: FactMetadata a => Proxy a -> Metadata a
- Language.Souffle.Experimental: infix 1 .!=
- Language.Souffle.Experimental: infixl 0 |-
- Language.Souffle.Experimental: instance (GHC.TypeLits.KnownSymbol s, Language.Souffle.Experimental.KnownSymbols symbols) => Language.Souffle.Experimental.KnownSymbols (s : symbols)
- Language.Souffle.Experimental: instance (Language.Souffle.Experimental.KnownDLType t, Language.Souffle.Experimental.KnownDLTypes ts) => Language.Souffle.Experimental.KnownDLTypes (t : ts)
- Language.Souffle.Experimental: instance (Language.Souffle.Experimental.SupportsArithmetic ty, GHC.Num.Num ty) => GHC.Num.Num (Language.Souffle.Experimental.Term ctx ty)
- Language.Souffle.Experimental: instance Data.String.IsString (Language.Souffle.Experimental.Term ctx Data.Text.Internal.Lazy.Text)
- Language.Souffle.Experimental: instance Data.String.IsString (Language.Souffle.Experimental.Term ctx Data.Text.Internal.Text)
- Language.Souffle.Experimental: instance Data.String.IsString (Language.Souffle.Experimental.Term ctx GHC.Base.String)
- Language.Souffle.Experimental: instance GHC.Real.Fractional (Language.Souffle.Experimental.Term ctx GHC.Types.Float)
- Language.Souffle.Experimental: instance Language.Souffle.Experimental.Fragment Language.Souffle.Experimental.Body 'Language.Souffle.Experimental.Relation
- Language.Souffle.Experimental: instance Language.Souffle.Experimental.Fragment Language.Souffle.Experimental.Head 'Language.Souffle.Experimental.Relation
- Language.Souffle.Experimental: instance Language.Souffle.Experimental.KnownDLType Data.Text.Internal.Lazy.Text
- Language.Souffle.Experimental: instance Language.Souffle.Experimental.KnownDLType Data.Text.Internal.Text
- Language.Souffle.Experimental: instance Language.Souffle.Experimental.KnownDLType GHC.Base.String
- Language.Souffle.Experimental: instance Language.Souffle.Experimental.KnownDLType GHC.Int.Int32
- Language.Souffle.Experimental: instance Language.Souffle.Experimental.KnownDLType GHC.Types.Float
- Language.Souffle.Experimental: instance Language.Souffle.Experimental.KnownDLType GHC.Word.Word32
- Language.Souffle.Experimental: instance Language.Souffle.Experimental.KnownDLTypes '[]
- Language.Souffle.Experimental: instance Language.Souffle.Experimental.KnownDirection 'Language.Souffle.Class.Input
- Language.Souffle.Experimental: instance Language.Souffle.Experimental.KnownDirection 'Language.Souffle.Class.InputOutput
- Language.Souffle.Experimental: instance Language.Souffle.Experimental.KnownDirection 'Language.Souffle.Class.Internal
- Language.Souffle.Experimental: instance Language.Souffle.Experimental.KnownDirection 'Language.Souffle.Class.Output
- Language.Souffle.Experimental: instance Language.Souffle.Experimental.KnownSymbols '[]
- Language.Souffle.Experimental: instance Language.Souffle.Experimental.SupportsArithmetic GHC.Int.Int32
- Language.Souffle.Experimental: instance Language.Souffle.Experimental.SupportsArithmetic GHC.Types.Float
- Language.Souffle.Experimental: instance Language.Souffle.Experimental.SupportsArithmetic GHC.Word.Word32
- Language.Souffle.Experimental: instance Language.Souffle.Experimental.ToString Data.Text.Internal.Lazy.Text
- Language.Souffle.Experimental: instance Language.Souffle.Experimental.ToString Data.Text.Internal.Text
- Language.Souffle.Experimental: instance Language.Souffle.Experimental.ToString GHC.Base.String
- Language.Souffle.Experimental: instance Language.Souffle.Experimental.ToTerms '[t1, t2, t3, t4, t5, t6, t7, t8, t9, t10]
- Language.Souffle.Experimental: instance Language.Souffle.Experimental.ToTerms '[t1, t2, t3, t4, t5, t6, t7, t8, t9]
- Language.Souffle.Experimental: instance Language.Souffle.Experimental.ToTerms '[t1, t2, t3, t4, t5, t6, t7, t8]
- Language.Souffle.Experimental: instance Language.Souffle.Experimental.ToTerms '[t1, t2, t3, t4, t5, t6, t7]
- Language.Souffle.Experimental: instance Language.Souffle.Experimental.ToTerms '[t1, t2, t3, t4, t5, t6]
- Language.Souffle.Experimental: instance Language.Souffle.Experimental.ToTerms '[t1, t2, t3, t4, t5]
- Language.Souffle.Experimental: instance Language.Souffle.Experimental.ToTerms '[t1, t2, t3, t4]
- Language.Souffle.Experimental: instance Language.Souffle.Experimental.ToTerms '[t1, t2, t3]
- Language.Souffle.Experimental: instance Language.Souffle.Experimental.ToTerms '[t1, t2]
- Language.Souffle.Experimental: instance Language.Souffle.Experimental.ToTerms '[t]
- Language.Souffle.Experimental: instance forall k (ctx :: k). Control.Monad.Writer.Class.MonadWriter [Language.Souffle.Experimental.AST] (Language.Souffle.Experimental.Body ctx)
- Language.Souffle.Experimental: instance forall k (ctx :: k). GHC.Base.Applicative (Language.Souffle.Experimental.Body ctx)
- Language.Souffle.Experimental: instance forall k (ctx :: k). GHC.Base.Functor (Language.Souffle.Experimental.Body ctx)
- Language.Souffle.Experimental: instance forall k (ctx :: k). GHC.Base.Monad (Language.Souffle.Experimental.Body ctx)
- Language.Souffle.Experimental: instance forall k (prog :: k). Language.Souffle.Experimental.Fragment (Language.Souffle.Experimental.DSL prog) 'Language.Souffle.Experimental.Definition
- Language.Souffle.Experimental: instance forall k1 (prog :: k1) k2 (ctx :: k2). Control.Monad.State.Class.MonadState Language.Souffle.Experimental.VarMap (Language.Souffle.Experimental.DSL prog ctx)
- Language.Souffle.Experimental: instance forall k1 (prog :: k1) k2 (ctx :: k2). Control.Monad.Writer.Class.MonadWriter [Language.Souffle.Experimental.AST] (Language.Souffle.Experimental.DSL prog ctx)
- Language.Souffle.Experimental: instance forall k1 (prog :: k1) k2 (ctx :: k2). GHC.Base.Applicative (Language.Souffle.Experimental.DSL prog ctx)
- Language.Souffle.Experimental: instance forall k1 (prog :: k1) k2 (ctx :: k2). GHC.Base.Functor (Language.Souffle.Experimental.DSL prog ctx)
- Language.Souffle.Experimental: instance forall k1 (prog :: k1) k2 (ctx :: k2). GHC.Base.Monad (Language.Souffle.Experimental.DSL prog ctx)
- Language.Souffle.Experimental: land :: (Num ty, Integral ty) => Term ctx ty -> Term ctx ty -> Term ctx ty
- Language.Souffle.Experimental: lor :: (Num ty, Integral ty) => Term ctx ty -> Term ctx ty -> Term ctx ty
- Language.Souffle.Experimental: match :: ToString ty => Term ctx ty -> Term ctx ty -> Body ctx ()
- Language.Souffle.Experimental: max' :: Num ty => Term ctx ty -> Term ctx ty -> Term ctx ty
- Language.Souffle.Experimental: min' :: Num ty => Term ctx ty -> Term ctx ty -> Term ctx ty
- Language.Souffle.Experimental: newtype Predicate a
- Language.Souffle.Experimental: not' :: Body ctx a -> Body ctx ()
- Language.Souffle.Experimental: ord :: ToString ty => Term ctx ty -> Term ctx Int32
- Language.Souffle.Experimental: predicateFor :: forall a prog. ToPredicate prog a => DSL prog 'Definition (Predicate a)
- Language.Souffle.Experimental: render :: Program prog => prog -> DSL prog 'Definition () -> Text
- Language.Souffle.Experimental: renderIO :: Program prog => prog -> FilePath -> DSL prog 'Definition () -> IO ()
- Language.Souffle.Experimental: runSouffleInterpreted :: (MonadIO m, Program prog) => prog -> DSL prog 'Definition () -> (Maybe (Handle prog) -> SouffleM a) -> m a
- Language.Souffle.Experimental: runSouffleInterpretedWith :: (MonadIO m, Program prog) => Config -> prog -> DSL prog 'Definition () -> (Maybe (Handle prog) -> SouffleM a) -> m a
- Language.Souffle.Experimental: strlen :: ToString ty => Term ctx ty -> Term ctx Int32
- Language.Souffle.Experimental: substr :: ToString ty => Term ctx ty -> Term ctx Int32 -> Term ctx Int32 -> Term ctx ty
- Language.Souffle.Experimental: to_number :: ToString ty => Term ctx ty -> Term ctx Int32
- Language.Souffle.Experimental: to_string :: ToString ty => Term ctx Int32 -> Term ctx ty
- Language.Souffle.Experimental: type ToPredicate prog a = (Fact a, FactMetadata a, ContainsFact prog a, SimpleProduct a, Assert (Length (Structure a) <=? 10) BigTupleError, KnownDLTypes (Structure a), KnownDirection (FactDirection a), KnownSymbols (AccessorNames a), ToTerms (Structure a))
- Language.Souffle.Experimental: type Tuple ctx ts = TupleOf (MapType (Term ctx) ts)
- Language.Souffle.Experimental: type VarName = Text
- Language.Souffle.Experimental: type family NoVarsInAtom (ctx :: UsageContext) :: Constraint
- Language.Souffle.Experimental: underscore :: Term ctx ty
- Language.Souffle.Experimental: var :: NoVarsInAtom ctx => VarName -> DSL prog ctx' (Term ctx ty)
- Language.Souffle.Internal: addTuple :: Ptr Relation -> ForeignPtr Tuple -> IO ()
- Language.Souffle.Internal: allocTuple :: Ptr Relation -> IO (ForeignPtr Tuple)
- Language.Souffle.Internal: containsTuple :: Ptr Relation -> ForeignPtr Tuple -> IO Bool
- Language.Souffle.Internal: countFacts :: Ptr Relation -> IO Int
- Language.Souffle.Internal: data RelationIterator
- Language.Souffle.Internal: data Tuple
- Language.Souffle.Internal: getRelationIterator :: Ptr Relation -> IO (ForeignPtr RelationIterator)
- Language.Souffle.Internal: relationIteratorNext :: ForeignPtr RelationIterator -> IO (Ptr Tuple)
- Language.Souffle.Internal: tuplePopFloat :: Ptr Tuple -> IO Float
- Language.Souffle.Internal: tuplePopInt32 :: Ptr Tuple -> IO Int32
- Language.Souffle.Internal: tuplePopString :: Ptr Tuple -> IO String
- Language.Souffle.Internal: tuplePopUInt32 :: Ptr Tuple -> IO Word32
- Language.Souffle.Internal: tuplePushFloat :: Ptr Tuple -> Float -> IO ()
- Language.Souffle.Internal: tuplePushInt32 :: Ptr Tuple -> Int32 -> IO ()
- Language.Souffle.Internal: tuplePushString :: Ptr Tuple -> String -> IO ()
- Language.Souffle.Internal: tuplePushUInt32 :: Ptr Tuple -> Word32 -> IO ()
- Language.Souffle.Internal.Bindings: addTuple :: Ptr Relation -> Ptr Tuple -> IO ()
- Language.Souffle.Internal.Bindings: allocTuple :: Ptr Relation -> IO (Ptr Tuple)
- Language.Souffle.Internal.Bindings: data RelationIterator
- Language.Souffle.Internal.Bindings: data Tuple
- Language.Souffle.Internal.Bindings: freeRelationIterator :: FunPtr (Ptr RelationIterator -> IO ())
- Language.Souffle.Internal.Bindings: freeTuple :: FunPtr (Ptr Tuple -> IO ())
- Language.Souffle.Internal.Bindings: getRelationIterator :: Ptr Relation -> IO (Ptr RelationIterator)
- Language.Souffle.Internal.Bindings: getTupleCount :: Ptr Relation -> IO CSize
- Language.Souffle.Internal.Bindings: relationIteratorNext :: Ptr RelationIterator -> IO (Ptr Tuple)
- Language.Souffle.Internal.Bindings: tuplePopFloat :: Ptr Tuple -> Ptr CFloat -> IO ()
- Language.Souffle.Internal.Bindings: tuplePopInt32 :: Ptr Tuple -> Ptr CInt -> IO ()
- Language.Souffle.Internal.Bindings: tuplePopString :: Ptr Tuple -> Ptr CString -> IO ()
- Language.Souffle.Internal.Bindings: tuplePopUInt32 :: Ptr Tuple -> Ptr CUInt -> IO ()
- Language.Souffle.Internal.Bindings: tuplePushFloat :: Ptr Tuple -> CFloat -> IO ()
- Language.Souffle.Internal.Bindings: tuplePushInt32 :: Ptr Tuple -> CInt -> IO ()
- Language.Souffle.Internal.Bindings: tuplePushString :: Ptr Tuple -> CString -> IO ()
- Language.Souffle.Internal.Bindings: tuplePushUInt32 :: Ptr Tuple -> CUInt -> IO ()
+ Language.Souffle.Class: -- Souffle. Only used internally.
+ Language.Souffle.Compiled: -- Souffle. Only used internally.
+ Language.Souffle.Compiled: instance Control.Monad.IO.Class.MonadIO Language.Souffle.Compiled.CMarshalFast
+ Language.Souffle.Compiled: instance Control.Monad.IO.Class.MonadIO Language.Souffle.Compiled.CMarshalSlow
+ Language.Souffle.Compiled: instance Control.Monad.State.Class.MonadState (GHC.Ptr.Ptr Language.Souffle.Compiled.ByteBuf) Language.Souffle.Compiled.CMarshalFast
+ Language.Souffle.Compiled: instance Control.Monad.State.Class.MonadState Language.Souffle.Compiled.MarshalState Language.Souffle.Compiled.CMarshalSlow
+ Language.Souffle.Compiled: instance GHC.Base.Applicative Language.Souffle.Compiled.CMarshalFast
+ Language.Souffle.Compiled: instance GHC.Base.Applicative Language.Souffle.Compiled.CMarshalSlow
+ Language.Souffle.Compiled: instance GHC.Base.Functor Language.Souffle.Compiled.CMarshalFast
+ Language.Souffle.Compiled: instance GHC.Base.Functor Language.Souffle.Compiled.CMarshalSlow
+ Language.Souffle.Compiled: instance GHC.Base.Monad Language.Souffle.Compiled.CMarshalFast
+ Language.Souffle.Compiled: instance GHC.Base.Monad Language.Souffle.Compiled.CMarshalSlow
+ Language.Souffle.Compiled: instance GHC.Base.Semigroup Language.Souffle.Compiled.ByteSize
+ Language.Souffle.Compiled: instance Language.Souffle.Compiled.ToByteSize Data.Text.Internal.Lazy.Text
+ Language.Souffle.Compiled: instance Language.Souffle.Compiled.ToByteSize Data.Text.Internal.Text
+ Language.Souffle.Compiled: instance Language.Souffle.Compiled.ToByteSize Data.Text.Short.Internal.ShortText
+ Language.Souffle.Compiled: instance Language.Souffle.Compiled.ToByteSize GHC.Base.String
+ Language.Souffle.Compiled: instance Language.Souffle.Compiled.ToByteSize GHC.Int.Int32
+ Language.Souffle.Compiled: instance Language.Souffle.Compiled.ToByteSize GHC.Types.Float
+ Language.Souffle.Compiled: instance Language.Souffle.Compiled.ToByteSize GHC.Word.Word32
+ Language.Souffle.Compiled: instance Language.Souffle.Compiled.ToByteSize a => Language.Souffle.Compiled.ToByteSize (GHC.Generics.K1 i a)
+ Language.Souffle.Compiled: instance Language.Souffle.Marshal.MonadPop Language.Souffle.Compiled.CMarshalFast
+ Language.Souffle.Compiled: instance Language.Souffle.Marshal.MonadPush Language.Souffle.Compiled.CMarshalFast
+ Language.Souffle.Compiled: instance Language.Souffle.Marshal.MonadPush Language.Souffle.Compiled.CMarshalSlow
+ Language.Souffle.Compiled: instance forall k (a :: k -> *) i (c :: GHC.Generics.Meta). Language.Souffle.Compiled.ToByteSize a => Language.Souffle.Compiled.ToByteSize (GHC.Generics.M1 i c a)
+ Language.Souffle.Compiled: instance forall k (f :: k -> *) (g :: k -> *). (Language.Souffle.Compiled.ToByteSize f, Language.Souffle.Compiled.ToByteSize g) => Language.Souffle.Compiled.ToByteSize (f GHC.Generics.:*: g)
+ Language.Souffle.Compiled: type Submit a = ToByteSize (Rep a)
+ Language.Souffle.Internal: containsFact :: Ptr Relation -> Ptr ByteBuf -> IO Bool
+ Language.Souffle.Internal: data ByteBuf
+ Language.Souffle.Internal: popFacts :: Ptr Souffle -> Ptr Relation -> IO (Ptr ByteBuf)
+ Language.Souffle.Internal: pushFacts :: Ptr Relation -> Ptr ByteBuf -> Word64 -> IO ()
+ Language.Souffle.Internal.Bindings: data ByteBuf
+ Language.Souffle.Internal.Bindings: popByteBuf :: Ptr Souffle -> Ptr Relation -> IO (Ptr ByteBuf)
+ Language.Souffle.Internal.Bindings: pushByteBuf :: Ptr Relation -> Ptr ByteBuf -> CSize -> IO ()
+ Language.Souffle.Interpreted: -- Souffle. Only used internally.
+ Language.Souffle.Marshal: instance Language.Souffle.Marshal.Marshal Data.Text.Short.Internal.ShortText
+ Language.Souffle.Marshal: popText :: MonadPop m => m ShortText
+ Language.Souffle.Marshal: popTextUtf16 :: MonadPop m => m Text
+ Language.Souffle.Marshal: pushText :: MonadPush m => ShortText -> m ()
+ Language.Souffle.Marshal: pushTextUtf16 :: MonadPush m => Text -> m ()
- Language.Souffle.Class: -- | Helper associated type constraint that allows collecting facts from
+ Language.Souffle.Class: -- | Helper associated type constraint that allows submitting facts to
- Language.Souffle.Class: addFact :: (MonadSouffle m, Fact a, ContainsInputFact prog a) => Handler m prog -> a -> m ()
+ Language.Souffle.Class: addFact :: (MonadSouffle m, Fact a, ContainsInputFact prog a, SubmitFacts m a) => Handler m prog -> a -> m ()
- Language.Souffle.Class: addFacts :: (MonadSouffle m, Foldable t, Fact a, ContainsInputFact prog a) => Handler m prog -> t a -> m ()
+ Language.Souffle.Class: addFacts :: (MonadSouffle m, Foldable t, Fact a, ContainsInputFact prog a, SubmitFacts m a) => Handler m prog -> t a -> m ()
- Language.Souffle.Class: findFact :: (MonadSouffle m, Fact a, ContainsOutputFact prog a, Eq a) => Handler m prog -> a -> m (Maybe a)
+ Language.Souffle.Class: findFact :: (MonadSouffle m, Fact a, ContainsOutputFact prog a, Eq a, SubmitFacts m a) => Handler m prog -> a -> m (Maybe a)
- Language.Souffle.Class: type family CollectFacts m (c :: Type -> Type) :: Constraint;
+ Language.Souffle.Class: type family SubmitFacts m (a :: Type) :: Constraint;
- Language.Souffle.Compiled: -- | Helper associated type constraint that allows collecting facts from
+ Language.Souffle.Compiled: -- | Helper associated type constraint that allows submitting facts to
- Language.Souffle.Compiled: addFact :: (MonadSouffle m, Fact a, ContainsInputFact prog a) => Handler m prog -> a -> m ()
+ Language.Souffle.Compiled: addFact :: (MonadSouffle m, Fact a, ContainsInputFact prog a, SubmitFacts m a) => Handler m prog -> a -> m ()
- Language.Souffle.Compiled: addFacts :: (MonadSouffle m, Foldable t, Fact a, ContainsInputFact prog a) => Handler m prog -> t a -> m ()
+ Language.Souffle.Compiled: addFacts :: (MonadSouffle m, Foldable t, Fact a, ContainsInputFact prog a, SubmitFacts m a) => Handler m prog -> t a -> m ()
- Language.Souffle.Compiled: findFact :: (MonadSouffle m, Fact a, ContainsOutputFact prog a, Eq a) => Handler m prog -> a -> m (Maybe a)
+ Language.Souffle.Compiled: findFact :: (MonadSouffle m, Fact a, ContainsOutputFact prog a, Eq a, SubmitFacts m a) => Handler m prog -> a -> m (Maybe a)
- Language.Souffle.Compiled: type family CollectFacts m (c :: Type -> Type) :: Constraint;
+ Language.Souffle.Compiled: type family SubmitFacts m (a :: Type) :: Constraint;
- Language.Souffle.Internal.Bindings: containsTuple :: Ptr Relation -> Ptr Tuple -> IO CBool
+ Language.Souffle.Internal.Bindings: containsTuple :: Ptr Relation -> Ptr ByteBuf -> IO CBool
- Language.Souffle.Interpreted: -- | Helper associated type constraint that allows collecting facts from
+ Language.Souffle.Interpreted: -- | Helper associated type constraint that allows submitting facts to
- Language.Souffle.Interpreted: addFact :: (MonadSouffle m, Fact a, ContainsInputFact prog a) => Handler m prog -> a -> m ()
+ Language.Souffle.Interpreted: addFact :: (MonadSouffle m, Fact a, ContainsInputFact prog a, SubmitFacts m a) => Handler m prog -> a -> m ()
- Language.Souffle.Interpreted: addFacts :: (MonadSouffle m, Foldable t, Fact a, ContainsInputFact prog a) => Handler m prog -> t a -> m ()
+ Language.Souffle.Interpreted: addFacts :: (MonadSouffle m, Foldable t, Fact a, ContainsInputFact prog a, SubmitFacts m a) => Handler m prog -> t a -> m ()
- Language.Souffle.Interpreted: findFact :: (MonadSouffle m, Fact a, ContainsOutputFact prog a, Eq a) => Handler m prog -> a -> m (Maybe a)
+ Language.Souffle.Interpreted: findFact :: (MonadSouffle m, Fact a, ContainsOutputFact prog a, Eq a, SubmitFacts m a) => Handler m prog -> a -> m (Maybe a)
- Language.Souffle.Interpreted: type family CollectFacts m (c :: Type -> Type) :: Constraint;
+ Language.Souffle.Interpreted: type family SubmitFacts m (a :: Type) :: Constraint;

Files

CHANGELOG.md view
@@ -3,12 +3,41 @@ All notable changes to this project (as seen by library users) will be documented in this file. The CHANGELOG is available on [Github](https://github.com/luc-tielen/souffle-haskell.git/CHANGELOG.md). +## [3.0.0] - 2021-05-03++### Changed++- Optimized the underlying way of transferring facts between Haskell and C++.+- Add an extra `Submit a` constraint on `addFacts`, `addFact` and `containsFact`+  when using compiled mode, similar to `Collect c` when using `getFacts`.++### Fixed++- Potential memory leak if an async exception occurred between the point of+  allocating a pointer and wrapping it in a `ForeignPtr`.++### Removed++- Souffle EDSL (this is now available in the+  [souffle-dsl](https://github.com/luc-tielen/souffle-dsl)+  package). This is mostly done to improve compile times of this package.+ ## [2.1.0] - 2021-01-03 -- souffle-haskell now supports Souffle version 2.0.2.-- Fix GHC 8.10 specific warnings and compile error.+### Added+ - Support Semigroup and Monoid instances for composing Souffle actions in   other ways.+- Add role annotations to handle types to avoid using `coerce` to change+  the type of a Souffle handle.++### Changed++- souffle-haskell now supports Souffle version 2.0.2.++### Fixed++- Fix GHC 8.10 specific warnings and compile error.  ## [2.0.1] - 2020-09-05 
README.md view
@@ -160,6 +160,12 @@   souffle-haskell: -optcxx-std=c++17 ``` +## Souffle EDSL++This package previously contained a Haskell EDSL for writing Souffle code+directly in Haskell. This has now been moved to a separate+[package](https://github.com/luc-tielen/souffle-dsl.git).+ ## Documentation  The documentation for the library can be found on
+ benchmarks/bench.hs view
@@ -0,0 +1,183 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE FlexibleContexts #-}+module Main ( main ) where++import Criterion.Main+import qualified Language.Souffle.Compiled as S+import qualified Data.Text as T+import qualified Data.Vector as V+import GHC.Generics+import Data.Word+import Data.Int+import Control.Monad+import Control.Monad.IO.Class+import Control.DeepSeq+++data Benchmarks = Benchmarks++data NumbersFact+  = NumbersFact Word32 Int32 Float+  deriving (Generic, NFData)++data StringsFact+  = StringsFact Word32 T.Text Int32 Float+  deriving (Generic, NFData)++newtype FromDatalogFact+  = FromDatalogFact Int32+  deriving (Generic, NFData)++data FromDatalogStringFact+  = FromDatalogStringFact Int32 T.Text+  deriving (Generic, NFData)++instance S.Program Benchmarks where+  type ProgramFacts Benchmarks =+      '[NumbersFact, StringsFact, FromDatalogFact, FromDatalogStringFact]+  programName = const "bench"++instance S.Fact NumbersFact where+  type FactDirection NumbersFact = 'S.InputOutput+  factName = const "numbers_fact"++instance S.Fact StringsFact where+  type FactDirection StringsFact = 'S.InputOutput+  factName = const "strings_fact"++instance S.Fact FromDatalogFact where+  type FactDirection FromDatalogFact = 'S.InputOutput+  factName = const "from_datalog_fact"++instance S.Fact FromDatalogStringFact where+  type FactDirection FromDatalogStringFact = 'S.InputOutput+  factName = const "from_datalog_string_fact"++instance S.Marshal NumbersFact+instance S.Marshal StringsFact+instance S.Marshal FromDatalogFact+instance S.Marshal FromDatalogStringFact+++-- TODO: fix cases with larger numbers (crashes due to large memory allocations?)+main :: IO ()+main = defaultMain+     $ roundTripBenchmarks+    ++ serializationBenchmarks+    ++ deserializationBenchmarks++roundTripBenchmarks :: [Benchmark]+roundTripBenchmarks =+  [ bgroup "round trip facts (without strings)"+    [ bench "1"      $ nfIO $ roundTrip $ mkVec 1+    , bench "10"     $ nfIO $ roundTrip $ mkVec 10+    , bench "100"    $ nfIO $ roundTrip $ mkVec 100+    , bench "1000"   $ nfIO $ roundTrip $ mkVec 1000+    , bench "10000"  $ nfIO $ roundTrip $ mkVec 10000+    --, bench "100000" $ nfIO $ roundTrip $ mkVec 100000+    ]+  , bgroup "round trip facts (with strings)"+    [ bench "1"      $ nfIO $ roundTrip $ mkVecStr 1+    , bench "10"     $ nfIO $ roundTrip $ mkVecStr 10+    , bench "100"    $ nfIO $ roundTrip $ mkVecStr 100+    , bench "1000"   $ nfIO $ roundTrip $ mkVecStr 1000+    --, bench "10000"  $ nfIO $ roundTrip $ mkVecStr 10000+    --, bench "100000" $ nfIO $ roundTrip $ mkVecStr 100000+    ]+  , bgroup "round trip facts (with long strings)"+    [ bench "1"      $ nfIO $ roundTrip $ mkVecLongStr 1+    , bench "10"     $ nfIO $ roundTrip $ mkVecLongStr 10+    , bench "100"    $ nfIO $ roundTrip $ mkVecLongStr 100+    --, bench "1000"   $ nfIO $ roundTrip $ mkVecLongStr 1000+    --, bench "10000"  $ nfIO $ roundTrip $ mkVecLongStr 10000+    --, bench "100000" $ nfIO $ roundTrip $ mkVecLongStr 100000+    ]+  ]+  where mkVec count = V.generate count $ \i -> NumbersFact (fromIntegral i) (-42) 3.14+        mkVecStr count = V.generate count $ \i -> StringsFact (fromIntegral i) "abcdef" (-42) 3.14+        mkVecLongStr count = V.generate count $ \i -> StringsFact (fromIntegral i) (T.replicate 10 "abcdef") (-42) 3.14++roundTrip :: (S.ContainsInputFact Benchmarks a, S.ContainsOutputFact Benchmarks a, S.Fact a, S.Submit a)+          => V.Vector a -> IO (V.Vector a)+roundTrip vec = S.runSouffle Benchmarks $ \case+  Nothing -> do+    liftIO $ print "Failed to load roundtrip benchmarks!"+    pure V.empty+  Just prog -> do+    S.addFacts prog vec+    -- No run needed+    S.getFacts prog+++serializeNumbers :: Int -> IO ()+serializeNumbers iterationCount = S.runSouffle Benchmarks $ \case+  Nothing -> liftIO $ print "Failed to load serialize benchmarks!"+  Just prog ->+    replicateM_ iterationCount $ S.addFacts prog vec+    -- No run needed+  where vec = V.generate 100 $ \i -> NumbersFact (fromIntegral i) (-42) 3.14++deserializeNumbers :: Int -> IO ()+deserializeNumbers iterationCount = S.runSouffle Benchmarks $ \case+  Nothing -> liftIO $ print "Failed to load deserialize benchmarks!"+  Just prog -> do+    S.run prog+    replicateM_ iterationCount $ do+      fs <- S.getFacts prog+      pure (fs :: V.Vector FromDatalogFact)++serializeWithStrings :: Int -> IO ()+serializeWithStrings iterationCount = S.runSouffle Benchmarks $ \case+  Nothing -> liftIO $ print "Failed to load serialize benchmarks!"+  Just prog ->+    replicateM_ iterationCount $ S.addFacts prog vec+    -- No run needed+  where vec = V.generate 100 $ \i -> StringsFact (fromIntegral i) "abcdef" (-42) 3.14++deserializeWithStrings :: Int -> IO ()+deserializeWithStrings iterationCount = S.runSouffle Benchmarks $ \case+  Nothing -> liftIO $ print "Failed to load deserialize benchmarks!"+  Just prog -> do+    S.run prog+    replicateM_ iterationCount $ do+      fs <- S.getFacts prog+      pure (fs :: V.Vector FromDatalogStringFact)++serializationBenchmarks :: [Benchmark]+serializationBenchmarks =+  [ bgroup "serializing facts (without strings)"+    [ bench "1"      $ nfIO $ serializeNumbers 1+    , bench "10"     $ nfIO $ serializeNumbers 10+    , bench "100"    $ nfIO $ serializeNumbers 100+    , bench "1000"   $ nfIO $ serializeNumbers 1000+    , bench "10000"  $ nfIO $ serializeNumbers 10000+    ]+  , bgroup "serializing facts (with strings)"+    [ bench "1"      $ nfIO $ serializeWithStrings 1+    , bench "10"     $ nfIO $ serializeWithStrings 10+    , bench "100"    $ nfIO $ serializeWithStrings 100+    , bench "1000"   $ nfIO $ serializeWithStrings 1000+    , bench "10000"  $ nfIO $ serializeWithStrings 10000+    ]+  ]++deserializationBenchmarks :: [Benchmark]+deserializationBenchmarks =+  [ bgroup "deserializing facts (without strings)"+    [ bench "1"      $ nfIO $ deserializeNumbers 1+    , bench "10"     $ nfIO $ deserializeNumbers 10+    , bench "100"    $ nfIO $ deserializeNumbers 100+    , bench "1000"   $ nfIO $ deserializeNumbers 1000+    , bench "10000"  $ nfIO $ deserializeNumbers 10000+    ]+  , bgroup "deserializing facts (with strings)"+    [ bench "1"      $ nfIO $ deserializeWithStrings 1+    , bench "10"     $ nfIO $ deserializeWithStrings 10+    , bench "100"    $ nfIO $ deserializeWithStrings 100+    , bench "1000"   $ nfIO $ deserializeWithStrings 1000+    , bench "10000"  $ nfIO $ deserializeWithStrings 10000+    ]+  ]
+ benchmarks/fixtures/bench.cpp view
@@ -0,0 +1,891 @@++#include "souffle/CompiledSouffle.h"++extern "C" {+}++namespace souffle {+static const RamDomain RAM_BIT_SHIFT_MASK = RAM_DOMAIN_SIZE - 1;+struct t_btree_u__0__2__1 {+using t_tuple = Tuple<RamDomain, 1>;+struct t_comparator_0{+ int operator()(const t_tuple& a, const t_tuple& b) const {+  return (ramBitCast<RamUnsigned>(a[0]) < ramBitCast<RamUnsigned>(b[0])) ? -1 : (ramBitCast<RamUnsigned>(a[0]) > ramBitCast<RamUnsigned>(b[0])) ? 1 :(0);+ }+bool less(const t_tuple& a, const t_tuple& b) const {+  return (ramBitCast<RamUnsigned>(a[0]) < ramBitCast<RamUnsigned>(b[0]));+ }+bool equal(const t_tuple& a, const t_tuple& b) const {+return (ramBitCast<RamUnsigned>(a[0]) == ramBitCast<RamUnsigned>(b[0]));+ }+};+using t_ind_0 = btree_set<t_tuple,t_comparator_0>;+t_ind_0 ind_0;+using iterator = t_ind_0::iterator;+struct context {+t_ind_0::operation_hints hints_0_lower;+t_ind_0::operation_hints hints_0_upper;+};+context createContext() { return context(); }+bool insert(const t_tuple& t) {+context h;+return insert(t, h);+}+bool insert(const t_tuple& t, context& h) {+if (ind_0.insert(t, h.hints_0_lower)) {+return true;+} else return false;+}+bool insert(const RamDomain* ramDomain) {+RamDomain data[1];+std::copy(ramDomain, ramDomain + 1, data);+const t_tuple& tuple = reinterpret_cast<const t_tuple&>(data);+context h;+return insert(tuple, h);+}+bool insert(RamDomain a0) {+RamDomain data[1] = {a0};+return insert(data);+}+bool contains(const t_tuple& t, context& h) const {+return ind_0.contains(t, h.hints_0_lower);+}+bool contains(const t_tuple& t) const {+context h;+return contains(t, h);+}+std::size_t size() const {+return ind_0.size();+}+iterator find(const t_tuple& t, context& h) const {+return ind_0.find(t, h.hints_0_lower);+}+iterator find(const t_tuple& t) const {+context h;+return find(t, h);+}+range<iterator> lowerUpperRange_0(const t_tuple& /* lower */, const t_tuple& /* upper */, context& /* h */) const {+return range<iterator>(ind_0.begin(),ind_0.end());+}+range<iterator> lowerUpperRange_0(const t_tuple& /* lower */, const t_tuple& /* upper */) const {+return range<iterator>(ind_0.begin(),ind_0.end());+}+range<t_ind_0::iterator> lowerUpperRange_2(const t_tuple& lower, const t_tuple& upper, context& h) const {+t_comparator_0 comparator;+int cmp = comparator(lower, upper);+if (cmp > 0) {+    return make_range(ind_0.end(), ind_0.end());+}+return make_range(ind_0.lower_bound(lower, h.hints_0_lower), ind_0.upper_bound(upper, h.hints_0_upper));+}+range<t_ind_0::iterator> lowerUpperRange_2(const t_tuple& lower, const t_tuple& upper) const {+context h;+return lowerUpperRange_2(lower,upper,h);+}+range<t_ind_0::iterator> lowerUpperRange_1(const t_tuple& lower, const t_tuple& upper, context& h) const {+t_comparator_0 comparator;+int cmp = comparator(lower, upper);+if (cmp == 0) {+    auto pos = ind_0.find(lower, h.hints_0_lower);+    auto fin = ind_0.end();+    if (pos != fin) {fin = pos; ++fin;}+    return make_range(pos, fin);+}+if (cmp > 0) {+    return make_range(ind_0.end(), ind_0.end());+}+return make_range(ind_0.lower_bound(lower, h.hints_0_lower), ind_0.upper_bound(upper, h.hints_0_upper));+}+range<t_ind_0::iterator> lowerUpperRange_1(const t_tuple& lower, const t_tuple& upper) const {+context h;+return lowerUpperRange_1(lower,upper,h);+}+bool empty() const {+return ind_0.empty();+}+std::vector<range<iterator>> partition() const {+return ind_0.getChunks(400);+}+void purge() {+ind_0.clear();+}+iterator begin() const {+return ind_0.begin();+}+iterator end() const {+return ind_0.end();+}+void printStatistics(std::ostream& o) const {+o << " arity 1 direct b-tree index 0 lex-order [0]\n";+ind_0.printStats(o);+}+};+struct t_btree_u__0__1 {+using t_tuple = Tuple<RamDomain, 1>;+struct t_comparator_0{+ int operator()(const t_tuple& a, const t_tuple& b) const {+  return (ramBitCast<RamUnsigned>(a[0]) < ramBitCast<RamUnsigned>(b[0])) ? -1 : (ramBitCast<RamUnsigned>(a[0]) > ramBitCast<RamUnsigned>(b[0])) ? 1 :(0);+ }+bool less(const t_tuple& a, const t_tuple& b) const {+  return (ramBitCast<RamUnsigned>(a[0]) < ramBitCast<RamUnsigned>(b[0]));+ }+bool equal(const t_tuple& a, const t_tuple& b) const {+return (ramBitCast<RamUnsigned>(a[0]) == ramBitCast<RamUnsigned>(b[0]));+ }+};+using t_ind_0 = btree_set<t_tuple,t_comparator_0>;+t_ind_0 ind_0;+using iterator = t_ind_0::iterator;+struct context {+t_ind_0::operation_hints hints_0_lower;+t_ind_0::operation_hints hints_0_upper;+};+context createContext() { return context(); }+bool insert(const t_tuple& t) {+context h;+return insert(t, h);+}+bool insert(const t_tuple& t, context& h) {+if (ind_0.insert(t, h.hints_0_lower)) {+return true;+} else return false;+}+bool insert(const RamDomain* ramDomain) {+RamDomain data[1];+std::copy(ramDomain, ramDomain + 1, data);+const t_tuple& tuple = reinterpret_cast<const t_tuple&>(data);+context h;+return insert(tuple, h);+}+bool insert(RamDomain a0) {+RamDomain data[1] = {a0};+return insert(data);+}+bool contains(const t_tuple& t, context& h) const {+return ind_0.contains(t, h.hints_0_lower);+}+bool contains(const t_tuple& t) const {+context h;+return contains(t, h);+}+std::size_t size() const {+return ind_0.size();+}+iterator find(const t_tuple& t, context& h) const {+return ind_0.find(t, h.hints_0_lower);+}+iterator find(const t_tuple& t) const {+context h;+return find(t, h);+}+range<iterator> lowerUpperRange_0(const t_tuple& /* lower */, const t_tuple& /* upper */, context& /* h */) const {+return range<iterator>(ind_0.begin(),ind_0.end());+}+range<iterator> lowerUpperRange_0(const t_tuple& /* lower */, const t_tuple& /* upper */) const {+return range<iterator>(ind_0.begin(),ind_0.end());+}+range<t_ind_0::iterator> lowerUpperRange_1(const t_tuple& lower, const t_tuple& upper, context& h) const {+t_comparator_0 comparator;+int cmp = comparator(lower, upper);+if (cmp == 0) {+    auto pos = ind_0.find(lower, h.hints_0_lower);+    auto fin = ind_0.end();+    if (pos != fin) {fin = pos; ++fin;}+    return make_range(pos, fin);+}+if (cmp > 0) {+    return make_range(ind_0.end(), ind_0.end());+}+return make_range(ind_0.lower_bound(lower, h.hints_0_lower), ind_0.upper_bound(upper, h.hints_0_upper));+}+range<t_ind_0::iterator> lowerUpperRange_1(const t_tuple& lower, const t_tuple& upper) const {+context h;+return lowerUpperRange_1(lower,upper,h);+}+bool empty() const {+return ind_0.empty();+}+std::vector<range<iterator>> partition() const {+return ind_0.getChunks(400);+}+void purge() {+ind_0.clear();+}+iterator begin() const {+return ind_0.begin();+}+iterator end() const {+return ind_0.end();+}+void printStatistics(std::ostream& o) const {+o << " arity 1 direct b-tree index 0 lex-order [0]\n";+ind_0.printStats(o);+}+};+struct t_btree_ui__0_1__11 {+using t_tuple = Tuple<RamDomain, 2>;+struct t_comparator_0{+ int operator()(const t_tuple& a, const t_tuple& b) const {+  return (ramBitCast<RamUnsigned>(a[0]) < ramBitCast<RamUnsigned>(b[0])) ? -1 : (ramBitCast<RamUnsigned>(a[0]) > ramBitCast<RamUnsigned>(b[0])) ? 1 :((ramBitCast<RamSigned>(a[1]) < ramBitCast<RamSigned>(b[1])) ? -1 : (ramBitCast<RamSigned>(a[1]) > ramBitCast<RamSigned>(b[1])) ? 1 :(0));+ }+bool less(const t_tuple& a, const t_tuple& b) const {+  return (ramBitCast<RamUnsigned>(a[0]) < ramBitCast<RamUnsigned>(b[0]))|| (ramBitCast<RamUnsigned>(a[0]) == ramBitCast<RamUnsigned>(b[0])) && ((ramBitCast<RamSigned>(a[1]) < ramBitCast<RamSigned>(b[1])));+ }+bool equal(const t_tuple& a, const t_tuple& b) const {+return (ramBitCast<RamUnsigned>(a[0]) == ramBitCast<RamUnsigned>(b[0]))&&(ramBitCast<RamSigned>(a[1]) == ramBitCast<RamSigned>(b[1]));+ }+};+using t_ind_0 = btree_set<t_tuple,t_comparator_0>;+t_ind_0 ind_0;+using iterator = t_ind_0::iterator;+struct context {+t_ind_0::operation_hints hints_0_lower;+t_ind_0::operation_hints hints_0_upper;+};+context createContext() { return context(); }+bool insert(const t_tuple& t) {+context h;+return insert(t, h);+}+bool insert(const t_tuple& t, context& h) {+if (ind_0.insert(t, h.hints_0_lower)) {+return true;+} else return false;+}+bool insert(const RamDomain* ramDomain) {+RamDomain data[2];+std::copy(ramDomain, ramDomain + 2, data);+const t_tuple& tuple = reinterpret_cast<const t_tuple&>(data);+context h;+return insert(tuple, h);+}+bool insert(RamDomain a0,RamDomain a1) {+RamDomain data[2] = {a0,a1};+return insert(data);+}+bool contains(const t_tuple& t, context& h) const {+return ind_0.contains(t, h.hints_0_lower);+}+bool contains(const t_tuple& t) const {+context h;+return contains(t, h);+}+std::size_t size() const {+return ind_0.size();+}+iterator find(const t_tuple& t, context& h) const {+return ind_0.find(t, h.hints_0_lower);+}+iterator find(const t_tuple& t) const {+context h;+return find(t, h);+}+range<iterator> lowerUpperRange_00(const t_tuple& /* lower */, const t_tuple& /* upper */, context& /* h */) const {+return range<iterator>(ind_0.begin(),ind_0.end());+}+range<iterator> lowerUpperRange_00(const t_tuple& /* lower */, const t_tuple& /* upper */) const {+return range<iterator>(ind_0.begin(),ind_0.end());+}+range<t_ind_0::iterator> lowerUpperRange_11(const t_tuple& lower, const t_tuple& upper, context& h) const {+t_comparator_0 comparator;+int cmp = comparator(lower, upper);+if (cmp == 0) {+    auto pos = ind_0.find(lower, h.hints_0_lower);+    auto fin = ind_0.end();+    if (pos != fin) {fin = pos; ++fin;}+    return make_range(pos, fin);+}+if (cmp > 0) {+    return make_range(ind_0.end(), ind_0.end());+}+return make_range(ind_0.lower_bound(lower, h.hints_0_lower), ind_0.upper_bound(upper, h.hints_0_upper));+}+range<t_ind_0::iterator> lowerUpperRange_11(const t_tuple& lower, const t_tuple& upper) const {+context h;+return lowerUpperRange_11(lower,upper,h);+}+bool empty() const {+return ind_0.empty();+}+std::vector<range<iterator>> partition() const {+return ind_0.getChunks(400);+}+void purge() {+ind_0.clear();+}+iterator begin() const {+return ind_0.begin();+}+iterator end() const {+return ind_0.end();+}+void printStatistics(std::ostream& o) const {+o << " arity 2 direct b-tree index 0 lex-order [0,1]\n";+ind_0.printStats(o);+}+};+struct t_btree_uif__0_1_2__111 {+using t_tuple = Tuple<RamDomain, 3>;+struct t_comparator_0{+ int operator()(const t_tuple& a, const t_tuple& b) const {+  return (ramBitCast<RamUnsigned>(a[0]) < ramBitCast<RamUnsigned>(b[0])) ? -1 : (ramBitCast<RamUnsigned>(a[0]) > ramBitCast<RamUnsigned>(b[0])) ? 1 :((ramBitCast<RamSigned>(a[1]) < ramBitCast<RamSigned>(b[1])) ? -1 : (ramBitCast<RamSigned>(a[1]) > ramBitCast<RamSigned>(b[1])) ? 1 :((ramBitCast<RamFloat>(a[2]) < ramBitCast<RamFloat>(b[2])) ? -1 : (ramBitCast<RamFloat>(a[2]) > ramBitCast<RamFloat>(b[2])) ? 1 :(0)));+ }+bool less(const t_tuple& a, const t_tuple& b) const {+  return (ramBitCast<RamUnsigned>(a[0]) < ramBitCast<RamUnsigned>(b[0]))|| (ramBitCast<RamUnsigned>(a[0]) == ramBitCast<RamUnsigned>(b[0])) && ((ramBitCast<RamSigned>(a[1]) < ramBitCast<RamSigned>(b[1]))|| (ramBitCast<RamSigned>(a[1]) == ramBitCast<RamSigned>(b[1])) && ((ramBitCast<RamFloat>(a[2]) < ramBitCast<RamFloat>(b[2]))));+ }+bool equal(const t_tuple& a, const t_tuple& b) const {+return (ramBitCast<RamUnsigned>(a[0]) == ramBitCast<RamUnsigned>(b[0]))&&(ramBitCast<RamSigned>(a[1]) == ramBitCast<RamSigned>(b[1]))&&(ramBitCast<RamFloat>(a[2]) == ramBitCast<RamFloat>(b[2]));+ }+};+using t_ind_0 = btree_set<t_tuple,t_comparator_0>;+t_ind_0 ind_0;+using iterator = t_ind_0::iterator;+struct context {+t_ind_0::operation_hints hints_0_lower;+t_ind_0::operation_hints hints_0_upper;+};+context createContext() { return context(); }+bool insert(const t_tuple& t) {+context h;+return insert(t, h);+}+bool insert(const t_tuple& t, context& h) {+if (ind_0.insert(t, h.hints_0_lower)) {+return true;+} else return false;+}+bool insert(const RamDomain* ramDomain) {+RamDomain data[3];+std::copy(ramDomain, ramDomain + 3, data);+const t_tuple& tuple = reinterpret_cast<const t_tuple&>(data);+context h;+return insert(tuple, h);+}+bool insert(RamDomain a0,RamDomain a1,RamDomain a2) {+RamDomain data[3] = {a0,a1,a2};+return insert(data);+}+bool contains(const t_tuple& t, context& h) const {+return ind_0.contains(t, h.hints_0_lower);+}+bool contains(const t_tuple& t) const {+context h;+return contains(t, h);+}+std::size_t size() const {+return ind_0.size();+}+iterator find(const t_tuple& t, context& h) const {+return ind_0.find(t, h.hints_0_lower);+}+iterator find(const t_tuple& t) const {+context h;+return find(t, h);+}+range<iterator> lowerUpperRange_000(const t_tuple& /* lower */, const t_tuple& /* upper */, context& /* h */) const {+return range<iterator>(ind_0.begin(),ind_0.end());+}+range<iterator> lowerUpperRange_000(const t_tuple& /* lower */, const t_tuple& /* upper */) const {+return range<iterator>(ind_0.begin(),ind_0.end());+}+range<t_ind_0::iterator> lowerUpperRange_111(const t_tuple& lower, const t_tuple& upper, context& h) const {+t_comparator_0 comparator;+int cmp = comparator(lower, upper);+if (cmp == 0) {+    auto pos = ind_0.find(lower, h.hints_0_lower);+    auto fin = ind_0.end();+    if (pos != fin) {fin = pos; ++fin;}+    return make_range(pos, fin);+}+if (cmp > 0) {+    return make_range(ind_0.end(), ind_0.end());+}+return make_range(ind_0.lower_bound(lower, h.hints_0_lower), ind_0.upper_bound(upper, h.hints_0_upper));+}+range<t_ind_0::iterator> lowerUpperRange_111(const t_tuple& lower, const t_tuple& upper) const {+context h;+return lowerUpperRange_111(lower,upper,h);+}+bool empty() const {+return ind_0.empty();+}+std::vector<range<iterator>> partition() const {+return ind_0.getChunks(400);+}+void purge() {+ind_0.clear();+}+iterator begin() const {+return ind_0.begin();+}+iterator end() const {+return ind_0.end();+}+void printStatistics(std::ostream& o) const {+o << " arity 3 direct b-tree index 0 lex-order [0,1,2]\n";+ind_0.printStats(o);+}+};+struct t_btree_uiif__0_1_2_3__1111 {+using t_tuple = Tuple<RamDomain, 4>;+struct t_comparator_0{+ int operator()(const t_tuple& a, const t_tuple& b) const {+  return (ramBitCast<RamUnsigned>(a[0]) < ramBitCast<RamUnsigned>(b[0])) ? -1 : (ramBitCast<RamUnsigned>(a[0]) > ramBitCast<RamUnsigned>(b[0])) ? 1 :((ramBitCast<RamSigned>(a[1]) < ramBitCast<RamSigned>(b[1])) ? -1 : (ramBitCast<RamSigned>(a[1]) > ramBitCast<RamSigned>(b[1])) ? 1 :((ramBitCast<RamSigned>(a[2]) < ramBitCast<RamSigned>(b[2])) ? -1 : (ramBitCast<RamSigned>(a[2]) > ramBitCast<RamSigned>(b[2])) ? 1 :((ramBitCast<RamFloat>(a[3]) < ramBitCast<RamFloat>(b[3])) ? -1 : (ramBitCast<RamFloat>(a[3]) > ramBitCast<RamFloat>(b[3])) ? 1 :(0))));+ }+bool less(const t_tuple& a, const t_tuple& b) const {+  return (ramBitCast<RamUnsigned>(a[0]) < ramBitCast<RamUnsigned>(b[0]))|| (ramBitCast<RamUnsigned>(a[0]) == ramBitCast<RamUnsigned>(b[0])) && ((ramBitCast<RamSigned>(a[1]) < ramBitCast<RamSigned>(b[1]))|| (ramBitCast<RamSigned>(a[1]) == ramBitCast<RamSigned>(b[1])) && ((ramBitCast<RamSigned>(a[2]) < ramBitCast<RamSigned>(b[2]))|| (ramBitCast<RamSigned>(a[2]) == ramBitCast<RamSigned>(b[2])) && ((ramBitCast<RamFloat>(a[3]) < ramBitCast<RamFloat>(b[3])))));+ }+bool equal(const t_tuple& a, const t_tuple& b) const {+return (ramBitCast<RamUnsigned>(a[0]) == ramBitCast<RamUnsigned>(b[0]))&&(ramBitCast<RamSigned>(a[1]) == ramBitCast<RamSigned>(b[1]))&&(ramBitCast<RamSigned>(a[2]) == ramBitCast<RamSigned>(b[2]))&&(ramBitCast<RamFloat>(a[3]) == ramBitCast<RamFloat>(b[3]));+ }+};+using t_ind_0 = btree_set<t_tuple,t_comparator_0>;+t_ind_0 ind_0;+using iterator = t_ind_0::iterator;+struct context {+t_ind_0::operation_hints hints_0_lower;+t_ind_0::operation_hints hints_0_upper;+};+context createContext() { return context(); }+bool insert(const t_tuple& t) {+context h;+return insert(t, h);+}+bool insert(const t_tuple& t, context& h) {+if (ind_0.insert(t, h.hints_0_lower)) {+return true;+} else return false;+}+bool insert(const RamDomain* ramDomain) {+RamDomain data[4];+std::copy(ramDomain, ramDomain + 4, data);+const t_tuple& tuple = reinterpret_cast<const t_tuple&>(data);+context h;+return insert(tuple, h);+}+bool insert(RamDomain a0,RamDomain a1,RamDomain a2,RamDomain a3) {+RamDomain data[4] = {a0,a1,a2,a3};+return insert(data);+}+bool contains(const t_tuple& t, context& h) const {+return ind_0.contains(t, h.hints_0_lower);+}+bool contains(const t_tuple& t) const {+context h;+return contains(t, h);+}+std::size_t size() const {+return ind_0.size();+}+iterator find(const t_tuple& t, context& h) const {+return ind_0.find(t, h.hints_0_lower);+}+iterator find(const t_tuple& t) const {+context h;+return find(t, h);+}+range<iterator> lowerUpperRange_0000(const t_tuple& /* lower */, const t_tuple& /* upper */, context& /* h */) const {+return range<iterator>(ind_0.begin(),ind_0.end());+}+range<iterator> lowerUpperRange_0000(const t_tuple& /* lower */, const t_tuple& /* upper */) const {+return range<iterator>(ind_0.begin(),ind_0.end());+}+range<t_ind_0::iterator> lowerUpperRange_1111(const t_tuple& lower, const t_tuple& upper, context& h) const {+t_comparator_0 comparator;+int cmp = comparator(lower, upper);+if (cmp == 0) {+    auto pos = ind_0.find(lower, h.hints_0_lower);+    auto fin = ind_0.end();+    if (pos != fin) {fin = pos; ++fin;}+    return make_range(pos, fin);+}+if (cmp > 0) {+    return make_range(ind_0.end(), ind_0.end());+}+return make_range(ind_0.lower_bound(lower, h.hints_0_lower), ind_0.upper_bound(upper, h.hints_0_upper));+}+range<t_ind_0::iterator> lowerUpperRange_1111(const t_tuple& lower, const t_tuple& upper) const {+context h;+return lowerUpperRange_1111(lower,upper,h);+}+bool empty() const {+return ind_0.empty();+}+std::vector<range<iterator>> partition() const {+return ind_0.getChunks(400);+}+void purge() {+ind_0.clear();+}+iterator begin() const {+return ind_0.begin();+}+iterator end() const {+return ind_0.end();+}+void printStatistics(std::ostream& o) const {+o << " arity 4 direct b-tree index 0 lex-order [0,1,2,3]\n";+ind_0.printStats(o);+}+};++class Sf_bench : public SouffleProgram {+private:+static inline bool regex_wrapper(const std::string& pattern, const std::string& text) {+   bool result = false; +   try { result = std::regex_match(text, std::regex(pattern)); } catch(...) { +     std::cerr << "warning: wrong pattern provided for match(\"" << pattern << "\",\"" << text << "\").\n";+}+   return result;+}+private:+static inline std::string substr_wrapper(const std::string& str, size_t idx, size_t len) {+   std::string result; +   try { result = str.substr(idx,len); } catch(...) { +     std::cerr << "warning: wrong index position provided by substr(\"";+     std::cerr << str << "\"," << (int32_t)idx << "," << (int32_t)len << ") functor.\n";+   } return result;+}+public:+// -- initialize symbol table --+SymbolTable symTable{+	R"_(abcdef)_",+};// -- initialize record table --+RecordTable recordTable;+// -- Table: @delta_from_datalog_fact+Own<t_btree_u__0__2__1> rel_1_delta_from_datalog_fact = mk<t_btree_u__0__2__1>();+// -- Table: @new_from_datalog_fact+Own<t_btree_u__0__2__1> rel_2_new_from_datalog_fact = mk<t_btree_u__0__2__1>();+// -- Table: from_datalog_fact+Own<t_btree_u__0__1> rel_3_from_datalog_fact = mk<t_btree_u__0__1>();+souffle::RelationWrapper<0,t_btree_u__0__1,Tuple<RamDomain,1>,1,0> wrapper_rel_3_from_datalog_fact;+// -- Table: from_datalog_string_fact+Own<t_btree_ui__0_1__11> rel_4_from_datalog_string_fact = mk<t_btree_ui__0_1__11>();+souffle::RelationWrapper<1,t_btree_ui__0_1__11,Tuple<RamDomain,2>,2,0> wrapper_rel_4_from_datalog_string_fact;+// -- Table: numbers_fact+Own<t_btree_uif__0_1_2__111> rel_5_numbers_fact = mk<t_btree_uif__0_1_2__111>();+souffle::RelationWrapper<2,t_btree_uif__0_1_2__111,Tuple<RamDomain,3>,3,0> wrapper_rel_5_numbers_fact;+// -- Table: strings_fact+Own<t_btree_uiif__0_1_2_3__1111> rel_6_strings_fact = mk<t_btree_uiif__0_1_2_3__1111>();+souffle::RelationWrapper<3,t_btree_uiif__0_1_2_3__1111,Tuple<RamDomain,4>,4,0> wrapper_rel_6_strings_fact;+public:+Sf_bench() : +wrapper_rel_3_from_datalog_fact(*rel_3_from_datalog_fact,symTable,"from_datalog_fact",std::array<const char *,1>{{"u:unsigned"}},std::array<const char *,1>{{"u"}}),++wrapper_rel_4_from_datalog_string_fact(*rel_4_from_datalog_string_fact,symTable,"from_datalog_string_fact",std::array<const char *,2>{{"u:unsigned","s:symbol"}},std::array<const char *,2>{{"u","s"}}),++wrapper_rel_5_numbers_fact(*rel_5_numbers_fact,symTable,"numbers_fact",std::array<const char *,3>{{"u:unsigned","i:number","f:float"}},std::array<const char *,3>{{"u","n","f"}}),++wrapper_rel_6_strings_fact(*rel_6_strings_fact,symTable,"strings_fact",std::array<const char *,4>{{"u:unsigned","s:symbol","i:number","f:float"}},std::array<const char *,4>{{"u","s","n","f"}}){+addRelation("from_datalog_fact",&wrapper_rel_3_from_datalog_fact,false,true);+addRelation("from_datalog_string_fact",&wrapper_rel_4_from_datalog_string_fact,false,true);+addRelation("numbers_fact",&wrapper_rel_5_numbers_fact,true,true);+addRelation("strings_fact",&wrapper_rel_6_strings_fact,true,true);+}+~Sf_bench() {+}+private:+std::string inputDirectory;+std::string outputDirectory;+bool performIO;+std::atomic<RamDomain> ctr{};++std::atomic<size_t> iter{};+void runFunction(std::string inputDirectoryArg = "", std::string outputDirectoryArg = "", bool performIOArg = false) {+this->inputDirectory = inputDirectoryArg;+this->outputDirectory = outputDirectoryArg;+this->performIO = performIOArg;+SignalHandler::instance()->set();+#if defined(_OPENMP)+if (getNumThreads() > 0) {omp_set_num_threads(getNumThreads());}+#endif++// -- query evaluation --+{+ std::vector<RamDomain> args, ret;+subroutine_0(args, ret);+}+{+ std::vector<RamDomain> args, ret;+subroutine_1(args, ret);+}+{+ std::vector<RamDomain> args, ret;+subroutine_2(args, ret);+}+{+ std::vector<RamDomain> args, ret;+subroutine_3(args, ret);+}++// -- relation hint statistics --+SignalHandler::instance()->reset();+}+public:+void run() override { runFunction("", "", false); }+public:+void runAll(std::string inputDirectoryArg = "", std::string outputDirectoryArg = "") override { runFunction(inputDirectoryArg, outputDirectoryArg, true);+}+public:+void printAll(std::string outputDirectoryArg = "") override {+try {std::map<std::string, std::string> directiveMap({{"IO","file"},{"attributeNames","u"},{"name","from_datalog_fact"},{"operation","output"},{"output-dir","."},{"params","{\"records\": {}, \"relation\": {\"arity\": 1, \"auxArity\": 0, \"params\": [\"u\"]}}"},{"types","{\"ADTs\": {}, \"records\": {}, \"relation\": {\"arity\": 1, \"auxArity\": 0, \"types\": [\"u:unsigned\"]}}"}});+if (!outputDirectoryArg.empty()) {directiveMap["output-dir"] = outputDirectoryArg;}+IOSystem::getInstance().getWriter(directiveMap, symTable, recordTable)->writeAll(*rel_3_from_datalog_fact);+} catch (std::exception& e) {std::cerr << e.what();exit(1);}+try {std::map<std::string, std::string> directiveMap({{"IO","file"},{"attributeNames","u\tn\tf"},{"name","numbers_fact"},{"operation","output"},{"output-dir","."},{"params","{\"records\": {}, \"relation\": {\"arity\": 3, \"auxArity\": 0, \"params\": [\"u\", \"n\", \"f\"]}}"},{"types","{\"ADTs\": {}, \"records\": {}, \"relation\": {\"arity\": 3, \"auxArity\": 0, \"types\": [\"u:unsigned\", \"i:number\", \"f:float\"]}}"}});+if (!outputDirectoryArg.empty()) {directiveMap["output-dir"] = outputDirectoryArg;}+IOSystem::getInstance().getWriter(directiveMap, symTable, recordTable)->writeAll(*rel_5_numbers_fact);+} catch (std::exception& e) {std::cerr << e.what();exit(1);}+try {std::map<std::string, std::string> directiveMap({{"IO","file"},{"attributeNames","u\ts\tn\tf"},{"name","strings_fact"},{"operation","output"},{"output-dir","."},{"params","{\"records\": {}, \"relation\": {\"arity\": 4, \"auxArity\": 0, \"params\": [\"u\", \"s\", \"n\", \"f\"]}}"},{"types","{\"ADTs\": {}, \"records\": {}, \"relation\": {\"arity\": 4, \"auxArity\": 0, \"types\": [\"u:unsigned\", \"s:symbol\", \"i:number\", \"f:float\"]}}"}});+if (!outputDirectoryArg.empty()) {directiveMap["output-dir"] = outputDirectoryArg;}+IOSystem::getInstance().getWriter(directiveMap, symTable, recordTable)->writeAll(*rel_6_strings_fact);+} catch (std::exception& e) {std::cerr << e.what();exit(1);}+try {std::map<std::string, std::string> directiveMap({{"IO","file"},{"attributeNames","u\ts"},{"name","from_datalog_string_fact"},{"operation","output"},{"output-dir","."},{"params","{\"records\": {}, \"relation\": {\"arity\": 2, \"auxArity\": 0, \"params\": [\"u\", \"s\"]}}"},{"types","{\"ADTs\": {}, \"records\": {}, \"relation\": {\"arity\": 2, \"auxArity\": 0, \"types\": [\"u:unsigned\", \"s:symbol\"]}}"}});+if (!outputDirectoryArg.empty()) {directiveMap["output-dir"] = outputDirectoryArg;}+IOSystem::getInstance().getWriter(directiveMap, symTable, recordTable)->writeAll(*rel_4_from_datalog_string_fact);+} catch (std::exception& e) {std::cerr << e.what();exit(1);}+}+public:+void loadAll(std::string inputDirectoryArg = "") override {+try {std::map<std::string, std::string> directiveMap({{"IO","file"},{"attributeNames","u\tn\tf"},{"fact-dir","."},{"name","numbers_fact"},{"operation","input"},{"params","{\"records\": {}, \"relation\": {\"arity\": 3, \"auxArity\": 0, \"params\": [\"u\", \"n\", \"f\"]}}"},{"types","{\"ADTs\": {}, \"records\": {}, \"relation\": {\"arity\": 3, \"auxArity\": 0, \"types\": [\"u:unsigned\", \"i:number\", \"f:float\"]}}"}});+if (!inputDirectoryArg.empty()) {directiveMap["fact-dir"] = inputDirectoryArg;}+IOSystem::getInstance().getReader(directiveMap, symTable, recordTable)->readAll(*rel_5_numbers_fact);+} catch (std::exception& e) {std::cerr << "Error loading data: " << e.what() << '\n';}+try {std::map<std::string, std::string> directiveMap({{"IO","file"},{"attributeNames","u\ts\tn\tf"},{"fact-dir","."},{"name","strings_fact"},{"operation","input"},{"params","{\"records\": {}, \"relation\": {\"arity\": 4, \"auxArity\": 0, \"params\": [\"u\", \"s\", \"n\", \"f\"]}}"},{"types","{\"ADTs\": {}, \"records\": {}, \"relation\": {\"arity\": 4, \"auxArity\": 0, \"types\": [\"u:unsigned\", \"s:symbol\", \"i:number\", \"f:float\"]}}"}});+if (!inputDirectoryArg.empty()) {directiveMap["fact-dir"] = inputDirectoryArg;}+IOSystem::getInstance().getReader(directiveMap, symTable, recordTable)->readAll(*rel_6_strings_fact);+} catch (std::exception& e) {std::cerr << "Error loading data: " << e.what() << '\n';}+}+public:+void dumpInputs() override {+try {std::map<std::string, std::string> rwOperation;+rwOperation["IO"] = "stdout";+rwOperation["name"] = "numbers_fact";+rwOperation["types"] = "{\"relation\": {\"arity\": 3, \"auxArity\": 0, \"types\": [\"u:unsigned\", \"i:number\", \"f:float\"]}}";+IOSystem::getInstance().getWriter(rwOperation, symTable, recordTable)->writeAll(*rel_5_numbers_fact);+} catch (std::exception& e) {std::cerr << e.what();exit(1);}+try {std::map<std::string, std::string> rwOperation;+rwOperation["IO"] = "stdout";+rwOperation["name"] = "strings_fact";+rwOperation["types"] = "{\"relation\": {\"arity\": 4, \"auxArity\": 0, \"types\": [\"u:unsigned\", \"s:symbol\", \"i:number\", \"f:float\"]}}";+IOSystem::getInstance().getWriter(rwOperation, symTable, recordTable)->writeAll(*rel_6_strings_fact);+} catch (std::exception& e) {std::cerr << e.what();exit(1);}+}+public:+void dumpOutputs() override {+try {std::map<std::string, std::string> rwOperation;+rwOperation["IO"] = "stdout";+rwOperation["name"] = "from_datalog_fact";+rwOperation["types"] = "{\"relation\": {\"arity\": 1, \"auxArity\": 0, \"types\": [\"u:unsigned\"]}}";+IOSystem::getInstance().getWriter(rwOperation, symTable, recordTable)->writeAll(*rel_3_from_datalog_fact);+} catch (std::exception& e) {std::cerr << e.what();exit(1);}+try {std::map<std::string, std::string> rwOperation;+rwOperation["IO"] = "stdout";+rwOperation["name"] = "numbers_fact";+rwOperation["types"] = "{\"relation\": {\"arity\": 3, \"auxArity\": 0, \"types\": [\"u:unsigned\", \"i:number\", \"f:float\"]}}";+IOSystem::getInstance().getWriter(rwOperation, symTable, recordTable)->writeAll(*rel_5_numbers_fact);+} catch (std::exception& e) {std::cerr << e.what();exit(1);}+try {std::map<std::string, std::string> rwOperation;+rwOperation["IO"] = "stdout";+rwOperation["name"] = "strings_fact";+rwOperation["types"] = "{\"relation\": {\"arity\": 4, \"auxArity\": 0, \"types\": [\"u:unsigned\", \"s:symbol\", \"i:number\", \"f:float\"]}}";+IOSystem::getInstance().getWriter(rwOperation, symTable, recordTable)->writeAll(*rel_6_strings_fact);+} catch (std::exception& e) {std::cerr << e.what();exit(1);}+try {std::map<std::string, std::string> rwOperation;+rwOperation["IO"] = "stdout";+rwOperation["name"] = "from_datalog_string_fact";+rwOperation["types"] = "{\"relation\": {\"arity\": 2, \"auxArity\": 0, \"types\": [\"u:unsigned\", \"s:symbol\"]}}";+IOSystem::getInstance().getWriter(rwOperation, symTable, recordTable)->writeAll(*rel_4_from_datalog_string_fact);+} catch (std::exception& e) {std::cerr << e.what();exit(1);}+}+public:+SymbolTable& getSymbolTable() override {+return symTable;+}+void executeSubroutine(std::string name, const std::vector<RamDomain>& args, std::vector<RamDomain>& ret) override {+if (name == "stratum_0") {+subroutine_0(args, ret);+return;}+if (name == "stratum_1") {+subroutine_1(args, ret);+return;}+if (name == "stratum_2") {+subroutine_2(args, ret);+return;}+if (name == "stratum_3") {+subroutine_3(args, ret);+return;}+fatal("unknown subroutine");+}+#ifdef _MSC_VER+#pragma warning(disable: 4100)+#endif // _MSC_VER+void subroutine_0(const std::vector<RamDomain>& args, std::vector<RamDomain>& ret) {+if (performIO) {+try {std::map<std::string, std::string> directiveMap({{"IO","file"},{"attributeNames","u\tn\tf"},{"fact-dir","."},{"name","numbers_fact"},{"operation","input"},{"params","{\"records\": {}, \"relation\": {\"arity\": 3, \"auxArity\": 0, \"params\": [\"u\", \"n\", \"f\"]}}"},{"types","{\"ADTs\": {}, \"records\": {}, \"relation\": {\"arity\": 3, \"auxArity\": 0, \"types\": [\"u:unsigned\", \"i:number\", \"f:float\"]}}"}});+if (!inputDirectory.empty()) {directiveMap["fact-dir"] = inputDirectory;}+IOSystem::getInstance().getReader(directiveMap, symTable, recordTable)->readAll(*rel_5_numbers_fact);+} catch (std::exception& e) {std::cerr << "Error loading data: " << e.what() << '\n';}+}+if (performIO) {+try {std::map<std::string, std::string> directiveMap({{"IO","file"},{"attributeNames","u\tn\tf"},{"name","numbers_fact"},{"operation","output"},{"output-dir","."},{"params","{\"records\": {}, \"relation\": {\"arity\": 3, \"auxArity\": 0, \"params\": [\"u\", \"n\", \"f\"]}}"},{"types","{\"ADTs\": {}, \"records\": {}, \"relation\": {\"arity\": 3, \"auxArity\": 0, \"types\": [\"u:unsigned\", \"i:number\", \"f:float\"]}}"}});+if (!outputDirectory.empty()) {directiveMap["output-dir"] = outputDirectory;}+IOSystem::getInstance().getWriter(directiveMap, symTable, recordTable)->writeAll(*rel_5_numbers_fact);+} catch (std::exception& e) {std::cerr << e.what();exit(1);}+}+}+#ifdef _MSC_VER+#pragma warning(default: 4100)+#endif // _MSC_VER+#ifdef _MSC_VER+#pragma warning(disable: 4100)+#endif // _MSC_VER+void subroutine_1(const std::vector<RamDomain>& args, std::vector<RamDomain>& ret) {+if (performIO) {+try {std::map<std::string, std::string> directiveMap({{"IO","file"},{"attributeNames","u\ts\tn\tf"},{"fact-dir","."},{"name","strings_fact"},{"operation","input"},{"params","{\"records\": {}, \"relation\": {\"arity\": 4, \"auxArity\": 0, \"params\": [\"u\", \"s\", \"n\", \"f\"]}}"},{"types","{\"ADTs\": {}, \"records\": {}, \"relation\": {\"arity\": 4, \"auxArity\": 0, \"types\": [\"u:unsigned\", \"s:symbol\", \"i:number\", \"f:float\"]}}"}});+if (!inputDirectory.empty()) {directiveMap["fact-dir"] = inputDirectory;}+IOSystem::getInstance().getReader(directiveMap, symTable, recordTable)->readAll(*rel_6_strings_fact);+} catch (std::exception& e) {std::cerr << "Error loading data: " << e.what() << '\n';}+}+if (performIO) {+try {std::map<std::string, std::string> directiveMap({{"IO","file"},{"attributeNames","u\ts\tn\tf"},{"name","strings_fact"},{"operation","output"},{"output-dir","."},{"params","{\"records\": {}, \"relation\": {\"arity\": 4, \"auxArity\": 0, \"params\": [\"u\", \"s\", \"n\", \"f\"]}}"},{"types","{\"ADTs\": {}, \"records\": {}, \"relation\": {\"arity\": 4, \"auxArity\": 0, \"types\": [\"u:unsigned\", \"s:symbol\", \"i:number\", \"f:float\"]}}"}});+if (!outputDirectory.empty()) {directiveMap["output-dir"] = outputDirectory;}+IOSystem::getInstance().getWriter(directiveMap, symTable, recordTable)->writeAll(*rel_6_strings_fact);+} catch (std::exception& e) {std::cerr << e.what();exit(1);}+}+}+#ifdef _MSC_VER+#pragma warning(default: 4100)+#endif // _MSC_VER+#ifdef _MSC_VER+#pragma warning(disable: 4100)+#endif // _MSC_VER+void subroutine_2(const std::vector<RamDomain>& args, std::vector<RamDomain>& ret) {+SignalHandler::instance()->setMsg(R"_(from_datalog_fact(0).+in file /home/luc/souffle-haskell/benchmarks/fixtures/bench.dl [18:1-18:22])_");+[&](){+CREATE_OP_CONTEXT(rel_3_from_datalog_fact_op_ctxt,rel_3_from_datalog_fact->createContext());+Tuple<RamDomain,1> tuple{{ramBitCast(RamUnsigned(0))}};+rel_3_from_datalog_fact->insert(tuple,READ_OP_CONTEXT(rel_3_from_datalog_fact_op_ctxt));+}+();[&](){+CREATE_OP_CONTEXT(rel_3_from_datalog_fact_op_ctxt,rel_3_from_datalog_fact->createContext());+CREATE_OP_CONTEXT(rel_1_delta_from_datalog_fact_op_ctxt,rel_1_delta_from_datalog_fact->createContext());+for(const auto& env0 : *rel_3_from_datalog_fact) {+Tuple<RamDomain,1> tuple{{ramBitCast(env0[0])}};+rel_1_delta_from_datalog_fact->insert(tuple,READ_OP_CONTEXT(rel_1_delta_from_datalog_fact_op_ctxt));+}+}+();iter = 0;+for(;;) {+SignalHandler::instance()->setMsg(R"_(from_datalog_fact((x+1)) :- +   from_datalog_fact(x),+   x < 100.+in file /home/luc/souffle-haskell/benchmarks/fixtures/bench.dl [19:1-21:11])_");+if(!(rel_1_delta_from_datalog_fact->empty())) {+[&](){+CREATE_OP_CONTEXT(rel_3_from_datalog_fact_op_ctxt,rel_3_from_datalog_fact->createContext());+CREATE_OP_CONTEXT(rel_1_delta_from_datalog_fact_op_ctxt,rel_1_delta_from_datalog_fact->createContext());+CREATE_OP_CONTEXT(rel_2_new_from_datalog_fact_op_ctxt,rel_2_new_from_datalog_fact->createContext());+auto range = rel_1_delta_from_datalog_fact->lowerUpperRange_2(Tuple<RamDomain,1>{{ramBitCast<RamDomain>(MIN_RAM_UNSIGNED)}},Tuple<RamDomain,1>{{ramBitCast(RamUnsigned(100))}},READ_OP_CONTEXT(rel_1_delta_from_datalog_fact_op_ctxt));+for(const auto& env0 : range) {+if( (ramBitCast<RamDomain>(env0[0]) != ramBitCast<RamDomain>(RamUnsigned(100))) && !(rel_3_from_datalog_fact->contains(Tuple<RamDomain,1>{{ramBitCast((ramBitCast<RamUnsigned>(env0[0]) + ramBitCast<RamUnsigned>(RamUnsigned(1))))}},READ_OP_CONTEXT(rel_3_from_datalog_fact_op_ctxt)))) {+Tuple<RamDomain,1> tuple{{ramBitCast((ramBitCast<RamUnsigned>(env0[0]) + ramBitCast<RamUnsigned>(RamUnsigned(1))))}};+rel_2_new_from_datalog_fact->insert(tuple,READ_OP_CONTEXT(rel_2_new_from_datalog_fact_op_ctxt));+}+}+}+();}+if(rel_2_new_from_datalog_fact->empty()) break;+[&](){+CREATE_OP_CONTEXT(rel_3_from_datalog_fact_op_ctxt,rel_3_from_datalog_fact->createContext());+CREATE_OP_CONTEXT(rel_2_new_from_datalog_fact_op_ctxt,rel_2_new_from_datalog_fact->createContext());+for(const auto& env0 : *rel_2_new_from_datalog_fact) {+Tuple<RamDomain,1> tuple{{ramBitCast(env0[0])}};+rel_3_from_datalog_fact->insert(tuple,READ_OP_CONTEXT(rel_3_from_datalog_fact_op_ctxt));+}+}+();std::swap(rel_1_delta_from_datalog_fact, rel_2_new_from_datalog_fact);+rel_2_new_from_datalog_fact->purge();+iter++;+}+iter = 0;+rel_1_delta_from_datalog_fact->purge();+rel_2_new_from_datalog_fact->purge();+if (performIO) {+try {std::map<std::string, std::string> directiveMap({{"IO","file"},{"attributeNames","u"},{"name","from_datalog_fact"},{"operation","output"},{"output-dir","."},{"params","{\"records\": {}, \"relation\": {\"arity\": 1, \"auxArity\": 0, \"params\": [\"u\"]}}"},{"types","{\"ADTs\": {}, \"records\": {}, \"relation\": {\"arity\": 1, \"auxArity\": 0, \"types\": [\"u:unsigned\"]}}"}});+if (!outputDirectory.empty()) {directiveMap["output-dir"] = outputDirectory;}+IOSystem::getInstance().getWriter(directiveMap, symTable, recordTable)->writeAll(*rel_3_from_datalog_fact);+} catch (std::exception& e) {std::cerr << e.what();exit(1);}+}+}+#ifdef _MSC_VER+#pragma warning(default: 4100)+#endif // _MSC_VER+#ifdef _MSC_VER+#pragma warning(disable: 4100)+#endif // _MSC_VER+void subroutine_3(const std::vector<RamDomain>& args, std::vector<RamDomain>& ret) {+SignalHandler::instance()->setMsg(R"_(from_datalog_string_fact(x,"abcdef") :- +   from_datalog_fact(x).+in file /home/luc/souffle-haskell/benchmarks/fixtures/bench.dl [23:1-24:24])_");+if(!(rel_3_from_datalog_fact->empty())) {+[&](){+CREATE_OP_CONTEXT(rel_3_from_datalog_fact_op_ctxt,rel_3_from_datalog_fact->createContext());+CREATE_OP_CONTEXT(rel_4_from_datalog_string_fact_op_ctxt,rel_4_from_datalog_string_fact->createContext());+for(const auto& env0 : *rel_3_from_datalog_fact) {+Tuple<RamDomain,2> tuple{{ramBitCast(env0[0]),ramBitCast(RamSigned(0))}};+rel_4_from_datalog_string_fact->insert(tuple,READ_OP_CONTEXT(rel_4_from_datalog_string_fact_op_ctxt));+}+}+();}+if (performIO) {+try {std::map<std::string, std::string> directiveMap({{"IO","file"},{"attributeNames","u\ts"},{"name","from_datalog_string_fact"},{"operation","output"},{"output-dir","."},{"params","{\"records\": {}, \"relation\": {\"arity\": 2, \"auxArity\": 0, \"params\": [\"u\", \"s\"]}}"},{"types","{\"ADTs\": {}, \"records\": {}, \"relation\": {\"arity\": 2, \"auxArity\": 0, \"types\": [\"u:unsigned\", \"s:symbol\"]}}"}});+if (!outputDirectory.empty()) {directiveMap["output-dir"] = outputDirectory;}+IOSystem::getInstance().getWriter(directiveMap, symTable, recordTable)->writeAll(*rel_4_from_datalog_string_fact);+} catch (std::exception& e) {std::cerr << e.what();exit(1);}+}+if (performIO) rel_3_from_datalog_fact->purge();+}+#ifdef _MSC_VER+#pragma warning(default: 4100)+#endif // _MSC_VER+};+SouffleProgram *newInstance_bench(){return new Sf_bench;}+SymbolTable *getST_bench(SouffleProgram *p){return &reinterpret_cast<Sf_bench*>(p)->symTable;}++#ifdef __EMBEDDED_SOUFFLE__+class factory_Sf_bench: public souffle::ProgramFactory {+SouffleProgram *newInstance() {+return new Sf_bench();+};+public:+factory_Sf_bench() : ProgramFactory("bench"){}+};+extern "C" {+factory_Sf_bench __factory_Sf_bench_instance;+}+}+#else+}+int main(int argc, char** argv)+{+try{+souffle::CmdOptions opt(R"(bench.dl)",+R"()",+R"()",+false,+R"()",+1);+if (!opt.parse(argc,argv)) return 1;+souffle::Sf_bench obj;+#if defined(_OPENMP) +obj.setNumThreads(opt.getNumJobs());++#endif+obj.runAll(opt.getInputFileDir(), opt.getOutputFileDir());+return 0;+} catch(std::exception &e) { souffle::SignalHandler::instance()->error(e.what());}+}++#endif
cbits/souffle.cpp view
@@ -1,196 +1,504 @@ #include "souffle/SouffleInterface.h" #include "souffle.h"+#include <algorithm>+#include <string>+#include <unordered_map>+#include <vector>+#include <memory> +#ifndef ESTIMATED_AVERAGE_STRING_SIZE+#define ESTIMATED_AVERAGE_STRING_SIZE 32+#endif+#ifndef GROW_FACTOR+#define GROW_FACTOR 2+#endif++extern "C"+{++struct buf_data+{+private:+    std::unique_ptr<char[]> m_data;+    size_t m_size;++public:+    buf_data(size_t size)+        : m_data(std::make_unique<char[]>(size))+        , m_size(size)+    {+        assert(size);+    };++    void resize(size_t num_bytes)+    {+        m_data = std::make_unique<char[]>(num_bytes);+        m_size = num_bytes;+    }++    auto size() const+    {+        return m_size;+    }++    auto data() const+    {+        return m_data.get();+    }+};++struct souffle_interface+{+    std::unique_ptr<souffle::SouffleProgram> m_prog;+    buf_data m_buf;++    souffle_interface(souffle::SouffleProgram *prog)+        : m_prog(prog)+        , m_buf(4)+    {+        assert(prog);+    };++    char *get_buf(size_t num_bytes)+    {+        if (num_bytes > m_buf.size()) m_buf.resize(num_bytes);++        return m_buf.data();+    }+};++}++namespace helpers+{+inline auto parse_signature(const souffle::Relation& relation)+{+    const auto arity = relation.getArity();++    std::vector<char> types;+    types.reserve(arity);++    for (size_t i = 0; i < arity; ++i)+    {+        types.push_back(*relation.getAttrType(i));+    }++    return types;+}++inline bool relation_contains_strings(const souffle::Relation& relation)+{+    const auto types = parse_signature(relation);+    return std::any_of(types.begin(), types.end(), [](auto x) { return x == 's'; });+}++using offset_t = uint32_t;++using number_t = int32_t;+using unsigned_t = uint32_t;+using float_t = float;+ template <typename T>-void tuple_push_value(tuple_t *tuple, const T &value)+inline void serialize_value(souffle::tuple& tuple, char* buf, offset_t& offset) {-    auto t = reinterpret_cast<souffle::tuple *>(tuple);-    assert(t);-    *t << value;+    auto ptr = reinterpret_cast<T*>(buf);+    tuple >> *ptr;+    offset += sizeof(T); }  template <typename T>-void tuple_pop_value(tuple_t *tuple, T *result)+inline void deserialize_value(souffle::tuple& tuple, char* buf, offset_t& offset) {-    auto t = reinterpret_cast<souffle::tuple *>(tuple);-    assert(t);-    assert(result);-    *t >> *result;+    auto ptr = reinterpret_cast<T*>(buf);+    tuple << *ptr;+    offset += sizeof(T); } -extern "C"+inline void deserialize_symbol(souffle::tuple& tuple, char* buf, offset_t& offset) {-    souffle_t *souffle_init(const char *progName)-    {-        auto prog = souffle::ProgramFactory::newInstance(progName);-        return reinterpret_cast<souffle_t *>(prog);+    auto ptr = reinterpret_cast<uint32_t*>(buf);+    const auto num_bytes = *ptr;+    if (num_bytes == 0) {+        tuple << "";+        offset += sizeof(uint32_t);+        return;     } -    void souffle_free(souffle_t *program)+    auto string_ptr = reinterpret_cast<const char*>(buf) + sizeof(uint32_t);+    std::string str(string_ptr, num_bytes);+    tuple << str;+    offset += sizeof(uint32_t) + num_bytes;+}++using deserializer_t = void(*)(souffle::tuple&, char*, offset_t&);+using deserializer_map = std::unordered_map<char, deserializer_t>;++static const deserializer_map deserializers_map = {+    {'s', deserialize_symbol},+    {'i', deserialize_value<number_t>},+    {'u', deserialize_value<unsigned_t>},+    {'f', deserialize_value<float_t>}+};++using serializer_t = void(*)(souffle::tuple&, char*, offset_t&);+using serializer_map = std::unordered_map<char, serializer_t>;++static const serializer_map serializers_map = {+    {'i', serialize_value<number_t>},+    {'u', serialize_value<unsigned_t>},+    {'f', serialize_value<float_t>}+};++inline auto types_to_deserializer(const std::vector<char>& types)+{+    std::vector<deserializer_t> deserializers;+    deserializers.reserve(types.size());++    for (const auto& type: types)     {-        auto prog = reinterpret_cast<souffle::SouffleProgram *>(program);-        assert(prog);-        delete prog;+        const auto match = deserializers_map.find(type);+        assert(match != deserializers_map.end() &&+                ("Found unknown Souffle primitive type: " + match->first));+        deserializers.push_back(match->second);     } -    void souffle_set_num_threads(souffle_t *program, size_t num_cores)+    return [deserializers = std::move(deserializers)](souffle::tuple& tuple, char* buf, offset_t& offset)     {-        auto prog = reinterpret_cast<souffle::SouffleProgram *>(program);-        assert(prog);-        prog->setNumThreads(num_cores);+        for (const auto& deserializer : deserializers)+        {+            deserializer(tuple, buf + offset, offset);+        }+    };+}++inline auto types_to_serializer(const std::vector<char>& types)+{+    std::vector<serializer_t> serializers;+    serializers.reserve(types.size());++    for (const auto& type: types)+    {+        const auto match = serializers_map.find(type);+        assert(match != serializers_map.end() &&+                ("Found unknown Souffle primitive type: " + match->first));+        serializers.push_back(match->second);     } -    size_t souffle_get_num_threads(souffle_t *program)+    return [serializers = std::move(serializers)](souffle::tuple& tuple, char* buf, offset_t& offset)     {-        auto prog = reinterpret_cast<souffle::SouffleProgram *>(program);-        assert(prog);-        return prog->getNumThreads();+        for (const auto& serializer : serializers)+        {+            serializer(tuple, buf + offset, offset);+        }+    };+}++inline auto guess_tuple_size(const std::vector<char>& types)+{+    size_t size = 0;++    for (const auto& type : types)+    {+        size += type == 's'+             ? ESTIMATED_AVERAGE_STRING_SIZE+             : sizeof(number_t);     } -    void souffle_run(souffle_t *program)+    return size;+}++struct Serializer+{+public:+    inline Serializer(souffle_t *prog, const souffle::Relation& relation)+        : m_relation(relation)+        , m_types(parse_signature(relation))+        , m_buf(prog->m_buf)     {-        auto prog = reinterpret_cast<souffle::SouffleProgram *>(program);-        assert(prog);-        prog->run();+        auto tuple_size = guess_tuple_size(m_types);++        m_fact_count = relation.size();+        m_num_bytes = sizeof(uint32_t) + m_fact_count * tuple_size;+        m_offset = 0;++        // NOTE: we need to have atleast `m_num_bytes` large buffer, to make+        // memcpy later not write beyond the buffer.+        if (m_num_bytes > m_buf.size()) m_buf.resize(m_num_bytes);     } -    void souffle_load_all(souffle_t *program, const char *input_directory)+    inline const Serializer& serialize()     {-        auto prog = reinterpret_cast<souffle::SouffleProgram *>(program);-        assert(prog);-        assert(input_directory);-        prog->loadAll(input_directory);+        using serializer_t = void(*)(Serializer*, souffle::tuple&);+        using serializer_map_t = std::unordered_map<char, serializer_t>;++        serializer_t do_serialize_symbol = [](auto s, auto& t) {+            s->serialize_symbol(t);+        };+        serializer_t do_serialize_number = [](auto s, auto& t) {+            s->serialize_number(t);+        };+        serializer_t do_serialize_unsigned = [](auto s, auto& t) {+            s->serialize_unsigned(t);+        };+        serializer_t do_serialize_float = [](auto s, auto& t) {+            s->serialize_float(t);+        };++        static const serializer_map_t serializers_map = {+            {'s', do_serialize_symbol},+            {'i', do_serialize_number},+            {'u', do_serialize_unsigned},+            {'f', do_serialize_float},+        };++        std::vector<serializer_t> serializers;+        serializers.reserve(m_types.size());++        for (const auto& type: m_types)+        {+            const auto match = serializers_map.find(type);+            assert(match != serializers_map.end() &&+                    ("Found unknown Souffle primitive type: " + match->first));+            serializers.push_back(match->second);+        }++        const auto serialize = [this, serializers = std::move(serializers)](auto& tuple)+        {+            for (const auto& serializer : serializers)+            {+                serializer(this, tuple);+            }+        };++        auto buf = reinterpret_cast<uint32_t*>(m_buf.data());+        *buf = m_fact_count;+        m_offset += sizeof(uint32_t);++        for (auto& tuple: m_relation)+        {+            serialize(tuple);+        }++        return *this;     } -    void souffle_print_all(souffle_t *program, const char *output_directory)+    inline void serialize_number(souffle::tuple& tuple)     {-        auto prog = reinterpret_cast<souffle::SouffleProgram *>(program);-        assert(prog);-        assert(output_directory);-        prog->printAll(output_directory);+        constexpr auto byte_count = sizeof(number_t);+        if (!has_remaining_bytes(byte_count)) {+            resize_buf(byte_count);+        }++        serialize_value<number_t>(tuple, m_buf.data() + m_offset, m_offset);     } -    relation_t *souffle_relation(souffle_t *program, const char *relation_name)+    inline void serialize_unsigned(souffle::tuple& tuple)     {-        auto prog = reinterpret_cast<souffle::SouffleProgram *>(program);-        assert(prog);-        assert(relation_name);-        auto relation = prog->getRelation(relation_name);-        assert(relation);-        return reinterpret_cast<relation_t *>(relation);+        constexpr auto byte_count = sizeof(unsigned_t);+        if (!has_remaining_bytes(byte_count)) {+            resize_buf(byte_count);+        }++        serialize_value<unsigned_t>(tuple, m_buf.data() + m_offset, m_offset);     } -    size_t souffle_relation_tuple_count(relation_t *relation)+    inline void serialize_float(souffle::tuple& tuple)     {-        auto rel = reinterpret_cast<souffle::Relation *>(relation);-        assert(rel);-        return rel->size();+        constexpr auto byte_count = sizeof(float_t);+        if (!has_remaining_bytes(byte_count)) {+            resize_buf(byte_count);+        }++        serialize_value<float_t>(tuple, m_buf.data() + m_offset, m_offset);     } -    struct relation_iterator+    inline void serialize_symbol(souffle::tuple& tuple)     {-        using iterator_t = souffle::Relation::iterator;-        iterator_t iterator;+        std::string str;+        tuple >> str;+        const uint32_t num_bytes = str.length(); -        relation_iterator(const iterator_t &it)-            : iterator(it) {}-    };+        auto total_byte_count = sizeof(uint32_t) + num_bytes;+        if (!has_remaining_bytes(total_byte_count)) {+            resize_buf(total_byte_count);+        } -    relation_iterator_t *souffle_relation_iterator(relation_t *relation)+        auto buf = m_buf.data() + m_offset;+        auto ptr = reinterpret_cast<uint32_t*>(buf);+        *ptr = num_bytes;++        // TODO: check if we can directly write into byte buf?+        auto string_ptr = reinterpret_cast<char*>(buf) + sizeof(uint32_t);+        std::copy(str.begin(), str.end(), string_ptr);+        m_offset += sizeof(uint32_t) + num_bytes;+    }++    inline bool has_remaining_bytes(size_t count) const     {-        auto rel = reinterpret_cast<souffle::Relation *>(relation);-        assert(rel);-        relation_iterator_t *it = new relation_iterator_t(rel->begin());-        return it;+        return m_num_bytes >= m_offset + count;     } -    void souffle_relation_iterator_free(relation_iterator_t *iterator)+    inline void resize_buf(size_t byte_count)     {-        assert(iterator);-        delete iterator;+        size_t grow_factor = GROW_FACTOR;+        while (m_offset + byte_count > m_num_bytes * grow_factor) {+            grow_factor *= 2;+        }+        const auto new_num_bytes = m_num_bytes * grow_factor;+        m_num_bytes = new_num_bytes;++        buf_data new_buf(new_num_bytes);+        memcpy(new_buf.data(), m_buf.data(), m_offset);+        std::swap(m_buf, new_buf);     } -    tuple_t *souffle_relation_iterator_next(relation_iterator_t *iterator)+    inline byte_buf_t *to_buf() const     {-        assert(iterator);-        auto tuple = reinterpret_cast<tuple_t *>(&*iterator->iterator);-        ++iterator->iterator;-        return tuple;+        return reinterpret_cast<byte_buf_t*>(m_buf.data());     } -    bool souffle_contains_tuple(relation_t *relation, tuple_t *tuple)+private:+    const souffle::Relation& m_relation;+    std::vector<char> m_types;+    size_t m_fact_count;+    buf_data& m_buf;+    size_t m_num_bytes;+    offset_t m_offset;+};++inline byte_buf_t *serialize_slow(souffle_t *prog, const souffle::Relation& relation)+{+    Serializer s(prog, relation);+    return s.serialize().to_buf();+}++inline byte_buf_t *serialize_fast(souffle_t *prog, const souffle::Relation& relation)+{+    const auto types = parse_signature(relation);+    const auto serialize = types_to_serializer(types);++    const auto fact_count = relation.size();+    const auto tuple_size = guess_tuple_size(types);+    const auto num_bytes = sizeof(uint32_t) + fact_count * tuple_size;+    auto buf = prog->get_buf(num_bytes);+    const auto start_ptr = buf;++    offset_t offset = 0;++    auto ptr = reinterpret_cast<uint32_t*>(buf);+    *ptr = fact_count;+    offset += 4;++    for (auto& tuple: relation)     {-        auto rel = reinterpret_cast<souffle::Relation *>(relation);-        auto t = reinterpret_cast<souffle::tuple *>(tuple);-        assert(rel);-        assert(t);-        return rel->contains(*t);+        serialize(tuple, buf, offset);     } -    tuple_t *souffle_tuple_alloc(relation_t *relation)+    return reinterpret_cast<byte_buf_t*>(start_ptr);+}++}  // namespace helpers++extern "C"+{+    souffle_t *souffle_init(const char *progName)     {-        auto rel = reinterpret_cast<souffle::Relation *>(relation);-        assert(rel);-        auto tuple = new souffle::tuple(rel);-        return reinterpret_cast<tuple_t *>(tuple);+        auto prog = souffle::ProgramFactory::newInstance(progName);+        return prog ? new souffle_interface(prog) : nullptr;     } -    void souffle_tuple_free(tuple_t *tuple)+    void souffle_free(souffle_t *program)     {-        auto t = reinterpret_cast<souffle::tuple *>(tuple);-        assert(t);-        delete t;+        assert(program);+        delete program;     } -    void souffle_tuple_push_int32(tuple_t *tuple, int32_t value)+    void souffle_set_num_threads(souffle_t *program, size_t num_cores)     {-        tuple_push_value(tuple, value);+        assert(program);+        program->m_prog->setNumThreads(num_cores);     } -    void souffle_tuple_push_uint32(tuple_t *tuple, uint32_t value)+    size_t souffle_get_num_threads(souffle_t *program)     {-        tuple_push_value(tuple, value);+        assert(program);+        return program->m_prog->getNumThreads();     } -    void souffle_tuple_push_float(tuple_t *tuple, float value)+    void souffle_run(souffle_t *program)     {-        tuple_push_value(tuple, value);+        assert(program);+        program->m_prog->run();     } -    void souffle_tuple_push_string(tuple_t *tuple, const char *value)+    void souffle_load_all(souffle_t *program, const char *input_directory)     {-        tuple_push_value(tuple, value);+        assert(program);+        assert(input_directory);+        program->m_prog->loadAll(input_directory);     } -    void souffle_tuple_add(relation_t *relation, tuple_t *tuple)+    void souffle_print_all(souffle_t *program, const char *output_directory)     {-        auto rel = reinterpret_cast<souffle::Relation *>(relation);-        auto t = reinterpret_cast<souffle::tuple *>(tuple);-        assert(rel);-        assert(t);-        rel->insert(*t);+        assert(program);+        assert(output_directory);+        program->m_prog->printAll(output_directory);     } -    void souffle_tuple_pop_int32(tuple_t *tuple, int32_t *result)+    relation_t *souffle_relation(souffle_t *program, const char *relation_name)     {-        tuple_pop_value(tuple, result);+        assert(program);+        assert(relation_name);+        auto relation = program->m_prog->getRelation(relation_name);+        assert(relation);+        return reinterpret_cast<relation_t *>(relation);     } -    void souffle_tuple_pop_uint32(tuple_t *tuple, uint32_t *result)+    bool souffle_contains_tuple(relation_t *rel, byte_buf_t *buf)     {-        tuple_pop_value(tuple, result);+        auto relation = reinterpret_cast<souffle::Relation *>(rel);+        auto data = reinterpret_cast<char*>(buf);+        assert(relation && "Relation is NULL in souffle_contains_tuple");+        assert(data && "byte buf is NULL in souffle_contains_tuple");++        auto& r = *relation;+        const auto types = helpers::parse_signature(r);+        const auto deserialize_tuple = helpers::types_to_deserializer(types);++        souffle::tuple tuple(relation);+        helpers::offset_t offset = 0;+        deserialize_tuple(tuple, data, offset);+        return r.contains(tuple);     } -    void souffle_tuple_pop_float(tuple_t *tuple, float *result)+    void souffle_tuple_push_many(relation_t *rel, byte_buf_t *buf, size_t size)     {-        tuple_pop_value(tuple, result);+        auto relation = reinterpret_cast<souffle::Relation*>(rel);+        auto data = reinterpret_cast<char*>(buf);+        assert(data && "byte buf is NULL in souffle_tuple_push_many");+        assert(relation && "Relation is NULL in souffle_tuple_push_many");++        auto& r = *relation;+        const auto types = helpers::parse_signature(r);+        const auto deserialize_tuple = helpers::types_to_deserializer(types);++        helpers::offset_t offset = 0;+        for (size_t i = 0; i < size; ++i)+        {+            souffle::tuple tuple(relation);+            deserialize_tuple(tuple, data, offset);+            r.insert(tuple);+        }     } -    void souffle_tuple_pop_string(tuple_t *tuple, char **result)+    byte_buf_t *souffle_tuple_pop_many(souffle_t *prog, relation_t *rel)     {-        assert(result);-        std::string value;-        tuple_pop_value(tuple, &value);-        *result = strdup(value.c_str());+        auto relation = reinterpret_cast<souffle::Relation*>(rel);+        assert(prog && "Program is NULL in souffle_tuple_pop_many");+        assert(relation && "Relation is NULL in souffle_tuple_pop_many");+        auto& r = *relation;+        return helpers::relation_contains_strings(r)+            ? helpers::serialize_slow(prog, r)+            : helpers::serialize_fast(prog, r);     } }
cbits/souffle.h view
@@ -13,10 +13,8 @@     typedef struct souffle_interface souffle_t;     // Opaque struct representing a Souffle relation     typedef struct relation relation_t;-    // Opaque struct representing an iterator to a Souffle relation-    typedef struct relation_iterator relation_iterator_t;-    // Opaque struct representing a Souffle tuple (fact).-    typedef struct tuple tuple_t;+    // Opaque struct representing a byte array filled with data.+    typedef struct byte_buf byte_buf_t;      /*      * Initializes a Souffle program. The name of the program should be the@@ -84,159 +82,33 @@     relation_t *souffle_relation(souffle_t *program, const char *relation_name);      /*-     * Gets the amount of tuples found in a relation.-     * You need to check if the passed pointer is non-NULL before passing it-     * to this function. Not doing so results in undefined behavior.-     *-     * Returns the amount of tuples found in a relation.-     */-    size_t souffle_relation_tuple_count(relation_t *relation);--    /*-     * Create an iterator for iterating over the facts of a relation.-     * You need to check if the passed pointer is non-NULL before passing it-     * to this function. Not doing so results in undefined behavior.-     *-     * The returned pointer needs to be freed up with-     * "souffle_relation_iterator_free" after it is no longer needed.-     */-    relation_iterator_t *souffle_relation_iterator(relation_t *relation);--    /*-     * Frees a relation_iterator pointer.-     * You need to check if the passed pointer is non-NULL before passing it-     * to this function. Not doing so results in undefined behavior.-     */-    void souffle_relation_iterator_free(relation_iterator_t *iterator);--    /*-     * Advances the relation iterator by 1 position.-     * You need to check if the passed pointer is non-NULL before passing it-     * to this function. Not doing so results in undefined behavior.-     * Calling this function when there are no more tuples to be returned-     * will result in a crash.-     *-     * Returns a pointer to the next record. This pointer is not allowed to be freed.-     */-    tuple_t *souffle_relation_iterator_next(relation_iterator_t *iterator);--    /*      * Checks if a relation contains a certain tuple.      * You need to check if the passed pointers are non-NULL before passing it      * to this function. Not doing so results in undefined behavior.      *      * Returns true if the tuple was found in the relation; otherwise false.      */-    bool souffle_contains_tuple(relation_t *relation, tuple_t *tuple);--    /*-     * Allocates memory for a tuple to be added to a relation.-     * You need to check if the passed pointer is non-NULL before passing it-     * to this function. Not doing so results in undefined behavior.-     *-     * Returns a pointer to a new tuple. Use "souffle_tuple_free" when tuple-     * is no longer required.-     */-    tuple_t *souffle_tuple_alloc(relation_t *relation);--    /*-     * Frees memory of a tuple that was previously allocated.-     * You need to check if the passed pointer is non-NULL before passing it-     * to this function. Not doing so results in undefined behavior.-     */-    void souffle_tuple_free(tuple_t *tuple);--    /*-     * Adds a tuple to a relation.-     * You need to check if both passed pointers are non-NULL before passing it-     * to this function. Not doing so results in undefined behavior.-     */-    void souffle_tuple_add(relation_t *relation, tuple_t *tuple);--    /*-     * Pushes a 32 bit signed integer value into a tuple.-     * You need to check if the passed pointer is non-NULL before passing it-     * to this function. Not doing so results in undefined behavior.-     *-     * Pushing an integer value onto a tuple that expects another type results-     * in a crash.-     */-    void souffle_tuple_push_int32(tuple_t *tuple, int32_t value);--    /*-     * Pushes a 32 bit unsigned integer value into a tuple.-     * You need to check if the passed pointer is non-NULL before passing it-     * to this function. Not doing so results in undefined behavior.-     *-     * Pushing an integer value onto a tuple that expects another type results-     * in a crash.-     */-    void souffle_tuple_push_uint32(tuple_t *tuple, uint32_t value);--    /*-     * Pushes a float value into a tuple.-     * You need to check if the passed pointer is non-NULL before passing it-     * to this function. Not doing so results in undefined behavior.-     *-     * Pushing a float value onto a tuple that expects another type results-     * in a crash.-     */-    void souffle_tuple_push_float(tuple_t *tuple, float value);--    /*-     * Pushes a string value into a tuple.-     * You need to check if the passed pointer is non-NULL before passing it-     * to this function. Not doing so results in undefined behavior.-     *-     * Pushing a string value onto a tuple that expects another type results-     * in a crash.-     */-    void souffle_tuple_push_string(tuple_t *tuple, const char *value);--    /*-     * Extracts a 32 bit signed integer value from a tuple.-     * You need to check if the passed pointer is non-NULL before passing it-     * to this function. Not doing so results in undefined behavior.-     *-     * Extracting an integer value from a tuple that expects another type results-     * in a crash.-     * The popped integer will be stored in the result pointer.-     */-    void souffle_tuple_pop_int32(tuple_t *tuple, int32_t *result);--    /*-     * Extracts a 32 bit unsigned integer value from a tuple.-     * You need to check if the passed pointer is non-NULL before passing it-     * to this function. Not doing so results in undefined behavior.-     *-     * Extracting an integer value from a tuple that expects another type results-     * in a crash.-     * The popped integer will be stored in the result pointer.-     */-    void souffle_tuple_pop_uint32(tuple_t *tuple, uint32_t *result);+    bool souffle_contains_tuple(relation_t *relation, byte_buf_t *buf); -    /*-     * Extracts a float value from a tuple.-     * You need to check if the passed pointer is non-NULL before passing it+    /**+     * Pushes many Datalog facts from Haskell to Datalog.+     * You need to check if the passed pointers are non-NULL before passing it      * to this function. Not doing so results in undefined behavior.-     *-     * Extracting a float value from a tuple that expects another type results-     * in a crash.-     * The popped integer will be stored in the result pointer.+     * Passing in a different count of objects to what is actually inside the+     * byte buffer will crash.      */-    void souffle_tuple_pop_float(tuple_t *tuple, float *result);+    void souffle_tuple_push_many(relation_t *relation, byte_buf_t *buf, size_t size); -    /*-     * Extracts a string value from a tuple.-     * You need to check if the passed pointer is non-NULL before passing it+    /**+     * Pops many Datalog facts from Datalog to Haskell.+     * You need to check if the passed pointers are non-NULL before passing it      * to this function. Not doing so results in undefined behavior.      *-     * Extracting a string value from a tuple that expects another type results-     * in a crash.-     * The popped string will be stored in the result pointer.+     * Returns the byte buffer that contains the serialized Datalog facts.+     * This byte buffer is automatically managed by the C++ side and does not+     * need to be cleaned up.      */-    void souffle_tuple_pop_string(tuple_t *tuple, char **result);-+    byte_buf_t *souffle_tuple_pop_many(souffle_t *program, relation_t *relation); #ifdef __cplusplus } #endif
lib/Language/Souffle/Class.hs view
@@ -161,6 +161,9 @@   -- | Helper associated type constraint that allows collecting facts from   --   Souffle in a list or vector. Only used internally.   type CollectFacts m (c :: Type -> Type) :: Constraint+  -- | Helper associated type constraint that allows submitting facts to+  --   Souffle. Only used internally.+  type SubmitFacts m (a :: Type) :: Constraint    -- | Runs the Souffle program.   run :: Handler m prog -> m ()@@ -181,21 +184,22 @@   --   --   Conceptually equivalent to @List.find (== fact) \<$\> getFacts prog@,   --   but this operation can be implemented much faster.-  findFact :: (Fact a, ContainsOutputFact prog a, Eq a)+  findFact :: (Fact a, ContainsOutputFact prog a, Eq a, SubmitFacts m a)            => Handler m prog -> a -> m (Maybe a)    -- | Adds a fact to the program.-  addFact :: (Fact a, ContainsInputFact prog a)+  addFact :: (Fact a, ContainsInputFact prog a, SubmitFacts m a)           => Handler m prog -> a -> m ()    -- | Adds multiple facts to the program. This function could be implemented   --   in terms of 'addFact', but this is done as a minor optimization.-  addFacts :: (Foldable t, Fact a, ContainsInputFact prog a)+  addFacts :: (Foldable t, Fact a, ContainsInputFact prog a, SubmitFacts m a)            => Handler m prog -> t a -> m ()  instance MonadSouffle m => MonadSouffle (ReaderT r m) where   type Handler (ReaderT r m) = Handler m   type CollectFacts (ReaderT r m) c = CollectFacts m c+  type SubmitFacts (ReaderT r m) a = SubmitFacts m a    run = lift . run   {-# INLINABLE run #-}@@ -215,6 +219,7 @@ instance (Monoid w, MonadSouffle m) => MonadSouffle (WriterT w m) where   type Handler (WriterT w m) = Handler m   type CollectFacts (WriterT w m) c = CollectFacts m c+  type SubmitFacts (WriterT w m) a = SubmitFacts m a    run = lift . run   {-# INLINABLE run #-}@@ -234,6 +239,7 @@ instance MonadSouffle m => MonadSouffle (StateT s m) where   type Handler (StateT s m) = Handler m   type CollectFacts (StateT s m) c = CollectFacts m c+  type SubmitFacts (StateT s m) a = SubmitFacts m a    run = lift . run   {-# INLINABLE run #-}@@ -253,6 +259,7 @@ instance (MonadSouffle m, Monoid w) => MonadSouffle (RWST r w s m) where   type Handler (RWST r w s m) = Handler m   type CollectFacts (RWST r w s m) c = CollectFacts m c+  type SubmitFacts (RWST r w s m) a = SubmitFacts m a    run = lift . run   {-# INLINABLE run #-}@@ -272,6 +279,7 @@ instance MonadSouffle m => MonadSouffle (ExceptT e m) where   type Handler (ExceptT e m) = Handler m   type CollectFacts (ExceptT e m) c = CollectFacts m c+  type SubmitFacts (ExceptT e m) a = SubmitFacts m a    run = lift . run   {-# INLINABLE run #-}@@ -288,7 +296,6 @@   addFacts facts = lift . addFacts facts   {-# INLINABLE addFacts #-} - -- | A mtl-style typeclass for Souffle-related actions that involve file IO. class MonadSouffle m => MonadSouffleFileIO m where   -- | Load all facts from files in a certain directory.@@ -327,3 +334,4 @@   {-# INLINABLE loadFiles #-}   writeFiles prog = lift . writeFiles prog   {-# INLINABLE writeFiles #-}+
lib/Language/Souffle/Compiled.hs view
@@ -1,5 +1,8 @@ {-# OPTIONS_GHC -Wno-redundant-constraints #-}-{-# LANGUAGE FlexibleInstances, TypeFamilies, DerivingVia, InstanceSigs, BangPatterns #-}+{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, DerivingVia #-}+{-# LANGUAGE BangPatterns, RoleAnnotations, MultiParamTypeClasses #-}+{-# LANGUAGE InstanceSigs, DataKinds, TypeApplications, TypeOperators #-}+{-# LANGUAGE ConstraintKinds, PolyKinds #-}  -- | This module provides an implementation for the typeclasses defined in --   "Language.Souffle.Class".@@ -17,6 +20,7 @@   , Direction(..)   , ContainsInputFact   , ContainsOutputFact+  , Submit   , Handle   , SouffleM   , MonadSouffle(..)@@ -25,28 +29,54 @@   ) where  import Prelude hiding ( init )-+import Control.Exception import Control.Monad.Except-import Control.Monad.RWS.Strict-import Control.Monad.Reader+import Control.Monad.State.Strict import Data.Foldable ( traverse_ )+import Data.Functor.Identity 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.ByteString as BS+import qualified Data.ByteString.Short as BSS+import qualified Data.ByteString.Unsafe as BSU+import qualified Data.Text as T+import qualified Data.Text.Short as TS+import qualified Data.Text.Short.Unsafe as TSU+import qualified Data.Text.Lazy as TL import qualified Data.Vector as V import qualified Data.Vector.Mutable as MV+import Data.Int+import Data.Word import Foreign.ForeignPtr+import Foreign.ForeignPtr.Unsafe+import Foreign (copyBytes) import Foreign.Ptr+import qualified Foreign.Storable as S+import GHC.Generics import Language.Souffle.Class import qualified Language.Souffle.Internal as Internal import Language.Souffle.Marshal+import Control.Concurrent  +type ByteCount = Int+type ByteBuf = Internal.ByteBuf++data BufData+  = BufData+  { bufPtr :: {-# UNPACK #-} !(ForeignPtr ByteBuf)+  , bufSize :: {-# UNPACK #-} !ByteCount+  }+ -- | 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)+data Handle prog+  = Handle {-# UNPACK #-} !(ForeignPtr Internal.Souffle)+           {-# UNPACK #-} !(MVar BufData)+type role Handle nominal  -- | A monad for executing Souffle-related actions in. newtype SouffleM a = SouffleM (IO a)@@ -66,172 +96,386 @@ runSouffle prog action =   let progName = programName prog       (SouffleM result) = do-        handle <- fmap Handle <$> liftIO (Internal.init progName)-        action handle+        maybeHandle <- liftIO (Internal.init progName) >>= \case+          Nothing -> pure Nothing+          Just souffleHandle -> do+            bufData <- liftIO $ do+              ptr <- newForeignPtr_ nullPtr+              newMVar $ BufData ptr 0+            pure $ Just $ Handle souffleHandle bufData+        action maybeHandle    in result--type Tuple = Ptr Internal.Tuple+{-# INLINABLE runSouffle #-}  -- | A monad used solely for marshalling and unmarshalling---   between Haskell and Souffle Datalog.-newtype CMarshal a = CMarshal (ReaderT Tuple IO a)-  deriving (Functor, Applicative, Monad, MonadIO, MonadReader Tuple)-  via ( ReaderT Tuple IO )+--   between Haskell and Souffle Datalog. This fast variant is used when the+--   marshalling from Haskell to C++ and the exact size of a datastructure+--   is statically known (read: data type contains no string-like types),+--   or when marshalling from C++ to Haskell (pointer is then managed by C++).+newtype CMarshalFast a = CMarshalFast (StateT (Ptr ByteBuf) IO a)+  deriving (Functor, Applicative, Monad, MonadIO, MonadState (Ptr ByteBuf))+  via (StateT (Ptr ByteBuf) IO) -runM :: CMarshal a -> Tuple -> IO a-runM (CMarshal m) = runReaderT m-{-# INLINABLE runM #-}+runMarshalFastM :: CMarshalFast a -> Ptr ByteBuf -> IO a+runMarshalFastM (CMarshalFast m) = evalStateT m+{-# INLINABLE runMarshalFastM #-} -instance MonadPush CMarshal where-  pushInt32 int = do-    tuple <- ask-    liftIO $ Internal.tuplePushInt32 tuple int-  {-# INLINABLE pushInt32 #-}+-- NOTE: assumes Souffle is compiled with 32-bit RAM domain.+ramDomainSize :: Int+ramDomainSize = 4 -  pushUInt32 int = do-    tuple <- ask-    liftIO $ Internal.tuplePushUInt32 tuple int-  {-# INLINABLE pushUInt32 #-}+writeAsBytes :: (S.Storable a, Marshal a) => a -> CMarshalFast ()+writeAsBytes a = do+  ptr <- gets castPtr+  liftIO $ S.poke ptr a+  put $ ptr `plusPtr` ramDomainSize+{-# INLINABLE writeAsBytes #-} -  pushFloat float = do-    tuple <- ask-    liftIO $ Internal.tuplePushFloat tuple float-  {-# INLINABLE pushFloat #-}+readAsBytes :: (S.Storable a, Marshal a) => CMarshalFast a+readAsBytes = do+  ptr <- gets castPtr+  a <- liftIO $ S.peek ptr+  put $ ptr `plusPtr` ramDomainSize+  pure a+{-# INLINABLE readAsBytes #-} -  pushString str = do-    tuple <- ask-    liftIO $ Internal.tuplePushString tuple str+instance MonadPush CMarshalFast where+  pushInt32 = writeAsBytes+  {-# INLINABLE pushInt32 #-}+  pushUInt32 = writeAsBytes+  {-# INLINABLE pushUInt32 #-}+  pushFloat = writeAsBytes+  {-# INLINABLE pushFloat #-}+  pushString str = pushText $ TS.pack str   {-# INLINABLE pushString #-}+  pushTextUtf16 str = pushText $ TS.fromText str+  {-# INLINABLE pushTextUtf16 #-}+  pushText _ =+    error "Fast marshalling does not support serializing string-like values."+  {-# INLINABLE pushText #-} -instance MonadPop CMarshal where-  popInt32 = do-    tuple <- ask-    liftIO $ Internal.tuplePopInt32 tuple+instance MonadPop CMarshalFast where+  popInt32 = readAsBytes   {-# INLINABLE popInt32 #-}--  popUInt32 = do-    tuple <- ask-    liftIO $ Internal.tuplePopUInt32 tuple+  popUInt32 = readAsBytes   {-# INLINABLE popUInt32 #-}--  popFloat = do-    tuple <- ask-    liftIO $ Internal.tuplePopFloat tuple+  popFloat = readAsBytes   {-# INLINABLE popFloat #-}--  popString = do-    tuple <- ask-    liftIO $ Internal.tuplePopString tuple+  popString = TS.unpack <$> popText   {-# INLINABLE popString #-}+  popTextUtf16 = TS.toText <$> popText+  {-# INLINABLE popTextUtf16 #-}+  popText = do+    byteCount <- popUInt32+    if byteCount == 0+      then pure TS.empty+      else do+        ptr <- gets castPtr+        bs <- liftIO $ BSU.unsafePackCStringLen (ptr, fromIntegral byteCount)+        -- NOTE: `evaluate` is needed here to force the text value. A copy needs to+        -- be made (using toShort), before the bytearray is overwritten.+        bss <- liftIO $ evaluate $ BSS.toShort bs+        put $ ptr `plusPtr` fromIntegral byteCount+        pure $ TSU.fromShortByteStringUnsafe bss+  {-# INLINABLE popText #-} ++data MarshalState+  = MarshalState+  { _buf :: {-# UNPACK #-} !BufData+  , _ptr :: {-# UNPACK #-} !(Ptr ByteBuf)+  , _ptrOffset :: {-# UNPACK #-} !Int+  }++-- | A monad used solely for marshalling from Haskell to Souffle Datalog (C++).+--   This slow variant is used when the exact size of a datastructure is *not*+--   statically known (read: data type contains string-like types).+newtype CMarshalSlow a = CMarshalSlow (StateT MarshalState IO a)+  deriving (Functor, Applicative, Monad, MonadIO, MonadState MarshalState)+  via (StateT MarshalState IO)++runMarshalSlowM :: BufData -> Int -> CMarshalSlow a -> IO a+runMarshalSlowM bufData byteCount (CMarshalSlow m) = do+  bufData' <- if bufSize bufData > byteCount+    then pure bufData+    else flip BufData byteCount <$> allocateBuf byteCount+  let ptr = unsafeForeignPtrToPtr (bufPtr bufData')+  evalStateT m $ MarshalState bufData' ptr 0+{-# INLINABLE runMarshalSlowM #-}++resizeBufWhenNeeded :: ByteCount -> CMarshalSlow ()+resizeBufWhenNeeded byteCount = do+  MarshalState bufData _ offset <- get+  let totalByteCount = bufSize bufData+  when (byteCount + offset > totalByteCount) $ do+    let newTotalByteCount = getNewTotalByteCount byteCount offset totalByteCount+    newBuf <- allocateBuf newTotalByteCount+    copyBuf newBuf (bufPtr bufData) totalByteCount+    let newPtr = unsafeForeignPtrToPtr newBuf+        bufData' = BufData newBuf newTotalByteCount+    put $ MarshalState bufData' (newPtr `plusPtr` offset) offset+{-# INLINABLE resizeBufWhenNeeded #-}++allocateBuf :: MonadIO m => ByteCount -> m (ForeignPtr ByteBuf)+allocateBuf byteCount = liftIO $+  mallocForeignPtrBytes byteCount+{-# INLINABLE allocateBuf #-}++copyBuf :: ForeignPtr ByteBuf -> ForeignPtr ByteBuf -> Int -> CMarshalSlow ()+copyBuf dst src byteCount = liftIO $+  withForeignPtr src $ \srcPtr ->+  withForeignPtr dst $ \dstPtr ->+    copyBytes dstPtr srcPtr byteCount+{-# INLINABLE copyBuf #-}++getNewTotalByteCount :: ByteCount -> Int -> ByteCount -> ByteCount+getNewTotalByteCount byteCount offset = go where+  go totalByteCount+    | byteCount + offset > totalByteCount = go (totalByteCount * 2)+    | otherwise = totalByteCount+{-# INLINABLE getNewTotalByteCount #-}++incrementPtr :: ByteCount -> CMarshalSlow ()+incrementPtr byteCount =+  modify $ \(MarshalState buf ptr offset) ->+    MarshalState buf (ptr `plusPtr` byteCount) (offset + byteCount)+{-# INLINABLE incrementPtr #-}++instance MonadPush CMarshalSlow where+  pushInt32 = writeAsBytesSlow+  {-# INLINABLE pushInt32 #-}+  pushUInt32 = writeAsBytesSlow+  {-# INLINABLE pushUInt32 #-}+  pushFloat = writeAsBytesSlow+  {-# INLINABLE pushFloat #-}+  pushString str = pushText $ TS.pack str+  {-# INLINABLE pushString #-}+  pushTextUtf16 str = pushText $ TS.fromText str+  {-# INLINABLE pushTextUtf16 #-}+  pushText txt = do+    let bs = TS.toByteString txt  -- TODO: is it possible to get rid of this copy?+        len = BS.length bs+    resizeBufWhenNeeded (ramDomainSize + len)+    pushUInt32 (fromIntegral len)+    if len == 0+      then pure ()+      else do+        ptr <- gets (castPtr . _ptr)+        liftIO $ BSU.unsafeUseAsCString bs $ flip (copyBytes ptr) len+        incrementPtr len+  {-# INLINABLE pushText #-}++writeAsBytesSlow :: (S.Storable a, Marshal a) => a -> CMarshalSlow ()+writeAsBytesSlow a = do+  resizeBufWhenNeeded ramDomainSize+  ptr <- gets (castPtr . _ptr)+  liftIO $ S.poke ptr a+  incrementPtr ramDomainSize+{-# INLINABLE writeAsBytesSlow #-}++ class Collect c where-  collect :: Marshal a => Int -> ForeignPtr Internal.RelationIterator -> IO (c a)+  collect :: Marshal a => Word32 -> CMarshalFast (c a)  instance Collect [] where-  collect factCount = go 0 factCount []-    where-      go idx count acc _ | idx == count = pure acc-      go idx count !acc !it = do-        tuple <- Internal.relationIteratorNext it-        result <- runM pop tuple-        go (idx + 1) count (result : acc) it+  collect objCount = go objCount [] where+    go count acc+      | count == 0 = pure acc+      | otherwise = do+        !x <- pop+        go (count - 1) (x:acc)   {-# INLINABLE collect #-}  instance Collect V.Vector where-  collect factCount iterator = do-    vec <- MV.unsafeNew factCount-    go vec 0 factCount iterator+  collect objCount = do+    vm <- liftIO $ MV.unsafeNew objCount'+    collect' vm 0     where-      go vec idx count _ | idx == count = V.unsafeFreeze vec-      go vec idx count it = do-        tuple <- Internal.relationIteratorNext it-        result <- runM pop tuple-        MV.unsafeWrite vec idx result-        go vec (idx + 1) count it+      objCount' = fromIntegral objCount+      collect' vec idx+        | idx == objCount' = liftIO $ V.unsafeFreeze vec+        | otherwise = do+          !obj <- pop+          liftIO $ MV.write vec idx obj+          collect' vec (idx + 1)   {-# INLINABLE collect #-}  instance Collect (A.Array Int) where-  collect factCount iterator = do-    array <- A.newArray_ (0, factCount - 1)-    go array 0 factCount iterator+  collect objCount = do+    ma <- liftIO $ A.newArray_ (0, objCount' - 1)+    collect' ma 0     where-      go :: Marshal a-         => A.IOArray Int a-         -> Int-         -> Int-         -> ForeignPtr Internal.RelationIterator-         -> IO (A.Array Int a)-      go array idx count _ | idx == count = A.unsafeFreeze array-      go array idx count it = do-        tuple <- Internal.relationIteratorNext it-        result <- runM pop tuple-        A.writeArray array idx result-        go array (idx + 1) count it+      objCount' = fromIntegral objCount+      collect' :: Marshal a => A.IOArray Int a -> Int -> CMarshalFast (A.Array Int a)+      collect' array idx+        | idx == objCount' = liftIO $ A.unsafeFreeze array+        | otherwise = do+          !obj <- pop+          liftIO $ A.writeArray array idx obj+          collect' array (idx + 1)   {-# INLINABLE collect #-} +-- | A helper typeclass constraint, needed to serialize Datalog facts from+--   Haskell to C++.+type Submit a = ToByteSize (Rep a)+ instance MonadSouffle SouffleM where   type Handler SouffleM = Handle   type CollectFacts SouffleM c = Collect c+  type SubmitFacts SouffleM a = Submit a -  run (Handle prog) = SouffleM $ Internal.run prog+  run (Handle prog _) = SouffleM $ Internal.run prog   {-# INLINABLE run #-} -  setNumThreads (Handle prog) numCores =+  setNumThreads (Handle prog _) numCores =     SouffleM $ Internal.setNumThreads prog numCores   {-# INLINABLE setNumThreads #-} -  getNumThreads (Handle prog) =+  getNumThreads (Handle prog _) =     SouffleM $ Internal.getNumThreads prog   {-# INLINABLE getNumThreads #-} -  addFact :: forall a prog. (Fact a, ContainsInputFact prog a)+  addFact :: forall a prog. (Fact a, ContainsInputFact prog a, Submit a)           => Handle prog -> a -> SouffleM ()-  addFact (Handle prog) fact = liftIO $ do+  addFact (Handle prog bufVar) fact = liftIO $ do     let relationName = factName (Proxy :: Proxy a)     relation <- Internal.getRelation prog relationName-    addFact' relation fact+    writeBytes bufVar relation (Identity fact)   {-# INLINABLE addFact #-} -  addFacts :: forall t a prog . (Foldable t, Fact a, ContainsInputFact prog a)+  addFacts :: forall t a prog. (Foldable t, Fact a, ContainsInputFact prog a, Submit a)            => Handle prog -> t a -> SouffleM ()-  addFacts (Handle prog) facts = liftIO $ do+  addFacts (Handle prog bufVar) facts = liftIO $ do     let relationName = factName (Proxy :: Proxy a)     relation <- Internal.getRelation prog relationName-    traverse_ (addFact' relation) facts+    writeBytes bufVar relation facts   {-# INLINABLE addFacts #-}    getFacts :: forall a c prog. (Fact a, ContainsOutputFact prog a, Collect c)            => Handle prog -> SouffleM (c a)-  getFacts (Handle prog) = SouffleM $ do+  getFacts (Handle prog _) = SouffleM $ do     let relationName = factName (Proxy :: Proxy a)     relation <- Internal.getRelation prog relationName-    factCount <- Internal.countFacts relation-    Internal.getRelationIterator relation >>= collect factCount+    buf <- withForeignPtr prog $ flip Internal.popFacts relation+    flip runMarshalFastM buf $ collect =<< popUInt32   {-# INLINABLE getFacts #-} -  findFact :: forall a prog. (Fact a, ContainsOutputFact prog a)+  findFact :: forall a prog. (Fact a, ContainsOutputFact prog a, Submit a)            => Handle prog -> a -> SouffleM (Maybe a)-  findFact (Handle prog) fact = SouffleM $ do+  findFact (Handle prog bufVar) fact = SouffleM $ do     let relationName = factName (Proxy :: Proxy a)     relation <- Internal.getRelation prog relationName-    tuple <- Internal.allocTuple relation-    withForeignPtr tuple $ runM (push fact)-    found <- Internal.containsTuple relation tuple+    found <- case estimateNumBytes (Proxy @a) of+      Exact numBytes -> do+        modifyMVarMasked bufVar $ \bufData -> do+          bufData' <- if bufSize bufData > numBytes+            then pure bufData+            else flip BufData numBytes <$> allocateBuf numBytes+          found <- withForeignPtr (bufPtr bufData') $ \ptr -> do+            runMarshalFastM (push fact) ptr+            Internal.containsFact relation ptr+          pure (bufData', found)+      Estimated numBytes -> modifyMVarMasked bufVar $ \bufData ->+        runMarshalSlowM bufData numBytes $ do+          push fact+          bufData' <- gets _buf+          liftIO $ withForeignPtr (bufPtr bufData') $ \ptr -> do+            found <- Internal.containsFact relation ptr+            pure (bufData', found)     pure $ if found then Just fact else Nothing   {-# INLINABLE findFact #-} -addFact' :: Fact a => Ptr Internal.Relation -> a -> IO ()-addFact' relation fact = do-  tuple <- Internal.allocTuple relation-  withForeignPtr tuple $ runM (push fact)-  Internal.addTuple relation tuple-{-# INLINABLE addFact' #-}-- instance MonadSouffleFileIO SouffleM where-  loadFiles (Handle prog) = SouffleM . Internal.loadAll prog+  loadFiles (Handle prog _) = SouffleM . Internal.loadAll prog   {-# INLINABLE loadFiles #-} -  writeFiles (Handle prog) = SouffleM . Internal.printAll prog+  writeFiles (Handle prog _) = SouffleM . Internal.printAll prog   {-# INLINABLE writeFiles #-}+++data ByteSize+  = Exact {-# UNPACK #-} !ByteCount+  | Estimated {-# UNPACK #-} !ByteCount++instance Semigroup ByteSize where+  Exact s1 <> Exact s2 = Exact (s1 + s2)+  Exact s1 <> Estimated s2 = Estimated (s1 + s2)+  Estimated s1 <> Exact s2 = Estimated (s1 + s2)+  Estimated s1 <> Estimated s2 = Estimated (s1 + s2)+  {-# INLINABLE (<>) #-}++class ToByteSize (a :: k) where+  toByteSize :: Proxy a -> ByteSize++instance ToByteSize Int32 where+  toByteSize = const $ Exact 4+  {-# INLINABLE toByteSize #-}++instance ToByteSize Word32 where+  toByteSize = const $ Exact 4+  {-# INLINABLE toByteSize #-}++instance ToByteSize Float where+  toByteSize = const $ Exact 4+  {-# INLINABLE toByteSize #-}++instance ToByteSize String where+  -- 4 for length prefix + 32 for actual string+  toByteSize = const $ Estimated 36+  {-# INLINABLE toByteSize #-}++instance ToByteSize T.Text where+  -- 4 for length prefix + 32 for actual string+  toByteSize = const $ Estimated 36+  {-# INLINABLE toByteSize #-}++instance ToByteSize TL.Text where+  -- 4 for length prefix + 32 for actual string+  toByteSize = const $ Estimated 36+  {-# INLINABLE toByteSize #-}++instance ToByteSize TS.ShortText where+  -- 4 for length prefix + 32 for actual string+  toByteSize = const $ Estimated 36+  {-# INLINABLE toByteSize #-}++instance ToByteSize a => ToByteSize (K1 i a) where+  toByteSize = const $ toByteSize (Proxy @a)+  {-# INLINABLE toByteSize #-}++instance ToByteSize a => ToByteSize (M1 i c a) where+  toByteSize = const $ toByteSize (Proxy @a)+  {-# INLINABLE toByteSize #-}++instance (ToByteSize f, ToByteSize g) => ToByteSize (f :*: g) where+  toByteSize = const $+    toByteSize (Proxy @f) <> toByteSize (Proxy @g)+  {-# INLINABLE toByteSize #-}++estimateNumBytes :: forall a. ToByteSize (Rep a) => Proxy a -> ByteSize+estimateNumBytes _ = toByteSize (Proxy @(Rep a))+{-# INLINABLE estimateNumBytes #-}++writeBytes :: forall f a. (Foldable f, Marshal a, ToByteSize (Rep a))+           => MVar BufData -> Ptr Internal.Relation -> f a -> IO ()+writeBytes bufVar relation fa = case estimateNumBytes (Proxy @a) of+  Exact numBytes -> modifyMVarMasked_ bufVar $ \bufData -> do+    let totalByteCount = numBytes * objCount+    bufData' <- if bufSize bufData > totalByteCount+      then pure bufData+      else flip BufData totalByteCount <$> allocateBuf totalByteCount+    withForeignPtr (bufPtr bufData') $ \ptr -> do+      runMarshalFastM (traverse_ push fa) ptr+      Internal.pushFacts relation ptr (fromIntegral objCount)+    pure bufData'++  Estimated numBytes -> modifyMVarMasked_ bufVar $ \bufData ->+    runMarshalSlowM bufData (numBytes * objCount) $ do+      traverse_ push fa+      bufData' <- gets _buf+      liftIO $ withForeignPtr (bufPtr bufData') $ \ptr -> do+        Internal.pushFacts relation ptr (fromIntegral objCount)+        pure bufData'+  where objCount = length fa+{-# INLINABLE writeBytes #-} 
− lib/Language/Souffle/Experimental.hs
@@ -1,1104 +0,0 @@-{-# LANGUAGE GADTs, RankNTypes, DataKinds, TypeOperators, ConstraintKinds #-}-{-# LANGUAGE UndecidableInstances, UndecidableSuperClasses, FlexibleContexts #-}-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, DerivingVia, ScopedTypeVariables #-}-{-# LANGUAGE PolyKinds, TypeFamilyDependencies #-}-{-# OPTIONS_GHC -Wno-redundant-constraints #-}--{-| This module provides an experimental DSL for generating Souffle Datalog code,-    directly from Haskell.--    The module is meant to be imported unqualified, unlike the rest of this-    library. This allows for a syntax that is very close to the corresponding-    Datalog syntax you would normally write.--    The functions and operators provided by this module follow a naming scheme:--    - If there is no clash with something imported via Prelude, the-      function or operator is named exactly the same as in Souffle.-    - If there is a clash for functions, an apostrophe is appended-      (e.g. "max" in Datalog is 'max'' in Haskell).-    - Most operators (besides those from the Num typeclass) start with a "."-      (e.g. '.^' is the "^"  operator in Datalog)--    The DSL makes heavy use of Haskell's typesystem to avoid-    many kinds of errors. This being said, not everything can be checked at-    compile-time (for example performing comparisons on ungrounded variables-    can't be checked). For this reason you should regularly write the-    Datalog code to a file while prototyping your algorithm and check it using-    the Souffle executable for errors.--    A large subset of the Souffle language is covered, with some exceptions-    such as "$", aggregates, ... There are no special functions for supporting-    components either, but this is automatically possible by making use of-    polymorphism in Haskell.--    Here's an example snippet of Haskell code that can generate Datalog code:--    @-    -- Assuming we have 2 types of facts named Edge and Reachable:-    data Edge = Edge String String-    data Reachable = Reachable String String--    program = do-      Predicate edge <- predicateFor \@Edge-      Predicate reachable <- predicateFor \@Reachable-      a <- var "a"-      b <- var "b"-      c <- var "c"-      reachable(a, b) |- edge(a, b)-      reachable(a, b) |- do-        edge(a, c)-        reachable(c, b)-    @--    When rendered to a file (using 'renderIO'), this generates the following-    Souffle code:--    @-    .decl edge(t1: symbol, t2: symbol)-    .input edge-    .decl reachable(t1: symbol, t2: symbol)-    .output reachable-    reachable(a, b) :--      edge(a, b)-    reachable(a, b) :- do-      edge(a, c)-      reachable(c, b)-    @--    For more examples, take a look at the <https://github.com/luc-tielen/souffle-haskell/blob/2c24e1e169da269c45fc192ab5efd4ff2196114b/tests/Test/Language/Souffle/ExperimentalSpec.hs tests>.--}-module Language.Souffle.Experimental-  ( -- * DSL-related types and functions-    -- ** Types-    Predicate(..)-  , Fragment-  , Tuple-  , DSL-  , Head-  , Body-  , Term-  , VarName-  , UsageContext(..)-  , Direction(..)-  , ToPredicate-  , FactMetadata(..)-  , Metadata(..)-  , StructureOpt(..)-  , InlineOpt(..)-  -- ** Basic building blocks-  , predicateFor-  , var-  , __-  , underscore-  , (|-)-  , (\/)-  , not'-  -- ** Souffle operators-  , (.<)-  , (.<=)-  , (.>)-  , (.>=)-  , (.=)-  , (.!=)-  , (.^)-  , (.%)-  , band-  , bor-  , bxor-  , lor-  , land-  -- ** Souffle functions-  , max'-  , min'-  , cat-  , contains-  , match-  , ord-  , strlen-  , substr-  , to_number-  , to_string-  -- * Functions for running a Datalog DSL fragment / AST directly.-  , runSouffleInterpretedWith-  , runSouffleInterpreted-  , embedProgram-  -- * Rendering functions-  , render-  , renderIO-  -- * Helper type families useful in some situations-  , Structure-  , NoVarsInAtom-  , SupportsArithmetic-  ) where--import Control.Monad.Reader-import Control.Monad.State-import Control.Monad.Writer-import Data.Int-import Data.Kind-import Data.List.NonEmpty (NonEmpty(..), toList)-import Data.Map ( Map )-import qualified Data.Map as Map-import Data.Maybe (fromMaybe, catMaybes, mapMaybe)-import Data.Proxy-import Data.String-import qualified Data.Text as T-import qualified Data.Text.IO as TIO-import qualified Data.Text.Lazy as TL-import Data.Word-import GHC.Generics-import GHC.TypeLits-import Language.Haskell.TH.Syntax (qRunIO, qAddForeignFilePath, Q, Dec, ForeignSrcLang(..))-import Language.Souffle.Class ( Program(..), Fact(..), ContainsFact, Direction(..) )-import Language.Souffle.Internal.Constraints (SimpleProduct)-import qualified Language.Souffle.Interpreted as I-import System.Directory-import System.FilePath-import System.IO.Temp-import System.Process-import Text.Printf (printf)-import Type.Errors.Pretty----- | A datatype that contains a function for generating Datalog AST fragments---   that can be glued together using other functions in this module.------   The rank-N type allows using the inner function in multiple places to---   generate different parts of the AST. This is one of the key things---   that allows writing Haskell code in a very smilar way to the Datalog code.------   The inner function uses the 'Structure' of a type to compute what the---   shape of the input tuple for the predicate should be. For example, if a---   fact has a data constructor containing a Float and a String,---   the resulting tuple will be of type ('Term' ctx Float, 'Term' ctx String).------   Currently, only facts with up to 10 fields are supported. If you need more---   fields, please file an issue on---   <https://github.com/luc-tielen/souffle-haskell/issues Github>.-newtype Predicate a-  = Predicate (forall f ctx. Fragment f ctx => Tuple ctx (Structure a) -> f ctx ())--type VarMap = Map VarName Int---- | The main monad in which Datalog AST fragments are combined together---   using other functions in this module.------   - The "prog" type variable is used for performing many compile time checks.---     This variable is filled (automatically) with a type that implements the---     'Program' typeclass.---   - The "ctx" type variable is the context in which a DSL fragment is used.---     For more information, see 'UsageContext'.---   - The "a" type variable is the value contained inside---     (just like other monads).-newtype DSL prog ctx a = DSL (StateT VarMap (Writer [AST]) a)-  deriving (Functor, Applicative, Monad, MonadWriter [AST], MonadState VarMap)-  via (StateT VarMap (Writer [AST]))--addDefinition :: AST -> DSL prog 'Definition ()-addDefinition dl = tell [dl]---- | This function runs the DSL fragment directly using the souffle interpreter---   executable.------   It does this by saving the fragment to a temporary file right before---   running the souffle interpreter. All created files are automatically---   cleaned up after the souffle related actions have been executed. If this is---   not your intended behavior, see 'runSouffleInterpretedWith' which allows---   passing in different interpreter settings.-runSouffleInterpreted-  :: (MonadIO m, Program prog)-  => prog-  -> DSL prog 'Definition ()-  -> (Maybe (I.Handle prog) -> I.SouffleM a)-  -> m a-runSouffleInterpreted program dsl f = liftIO $ do-  tmpDir <- getCanonicalTemporaryDirectory-  souffleHsDir <- createTempDirectory tmpDir "souffle-haskell"-  defaultCfg <- I.defaultConfig-  let cfg = defaultCfg { I.cfgDatalogDir = souffleHsDir-                       , I.cfgFactDir = Just souffleHsDir-                       , I.cfgOutputDir = Just souffleHsDir-                       }-  runSouffleInterpretedWith cfg program dsl f <* removeDirectoryRecursive souffleHsDir---- | This function runs the DSL fragment directly using the souffle interpreter---   executable.------   It does this by saving the fragment to a file in the directory specified by---   the 'I.cfgDatalogDir' field in the interpreter settings. Depending on the---   chosen settings, the fact and output files may not be automatically cleaned---   up after running the souffle interpreter. See 'I.runSouffleWith' for more---   information on automatic cleanup.-runSouffleInterpretedWith-  :: (MonadIO m, Program prog)-  => I.Config-  -> prog-  -> DSL prog 'Definition ()-  -> (Maybe (I.Handle prog) -> I.SouffleM a)-  -> m a-runSouffleInterpretedWith config program dsl f = liftIO $ do-  let progName = programName program-      datalogFile = I.cfgDatalogDir config </> progName <.> "dl"-  renderIO program datalogFile dsl-  I.runSouffleWith config program f---- | Embeds a Datalog program from a DSL fragment directly in a Haskell file.------   Note that due to TemplateHaskell staging restrictions, this function must---   be used in a different module than the module where 'Program' and 'Fact'---   instances are defined.------   In order to use this function correctly, you have to add the following---   line to the top of the module where 'embedProgram' is used in order---   for the embedded C++ code to be compiled correctly:------   > {-# OPTIONS_GHC -optc-std=c++17 -D__EMBEDDED_SOUFFLE__ #-}-embedProgram :: Program prog => prog -> DSL prog 'Definition () -> Q [Dec]-embedProgram program dsl = do-  cppFile <- qRunIO $ do-    tmpDir <- getCanonicalTemporaryDirectory-    souffleHsDir <- createTempDirectory tmpDir "souffle-haskell"-    let progName = programName program-        datalogFile = souffleHsDir </> progName <.> "dl"-        cppFile = souffleHsDir </> progName <.> "cpp"-    renderIO program datalogFile dsl-    callCommand $ printf "souffle -g %s %s" cppFile datalogFile-    pure cppFile-  qAddForeignFilePath LangCxx cppFile-  pure []--runDSL :: Program prog => prog -> DSL prog 'Definition a -> DL-runDSL _ (DSL a) = Statements $ mapMaybe simplify $ execWriter (evalStateT a mempty) where-  simplify = \case-    Declare' name dir fields opts -> pure $ Declare name dir fields opts-    Rule' name terms body -> Rule name terms <$> simplify body-    Atom' name terms -> pure $ Atom name terms-    And' exprs -> case mapMaybe simplify exprs of-      [] -> Nothing-      exprs' -> pure $ foldl1 And exprs'-    Or' exprs -> case mapMaybe simplify exprs of-      [] -> Nothing-      exprs' -> pure $ foldl1 Or exprs'-    Not' expr -> Not <$> simplify expr-    Constrain' e -> pure $ Constrain e---- | Generates a unique variable, using the name argument as a hint.------   The type of the variable is determined the first predicate it is used in.---   The 'NoVarsInAtom' constraint generates a user-friendly type error if the---   generated variable is used inside a relation (which is not valid in---   Datalog).------   Note: If a variable is created but not used using this function, you will---   get a compile-time error because it can't deduce the constraint.-var :: NoVarsInAtom ctx => VarName -> DSL prog ctx' (Term ctx ty)-var name = do-  count <- fromMaybe 0 <$> gets (Map.lookup name)-  modify $ Map.insert name (count + 1)-  let varName = if count == 0 then name else name <> "_" <> T.pack (show count)-  pure $ VarTerm varName---- | Data type representing the head of a relation---   (the part before ":-" in a Datalog relation).------   - The "ctx" type variable is the context in which this type is used.---     For this type, this will always be 'Relation'. The variable is there to---     perform some compile-time checks.---   - The "unused" type variable is unused and only there so the type has the---     same kind as 'Body' and 'DSL'.------   See also '|-'.-data Head ctx unused-  = Head Name (NonEmpty SimpleTerm)---- | Data type representing the body of a relation---   (what follows after ":-" in a Datalog relation).------   By being a monad, it supports do-notation which allows for a syntax---   that is quite close to Datalog.------   - The "ctx" type variable is the context in which this type is used.---     For this type, this will always be 'Relation'. The variable is there to---     perform some compile-time checks.---   - The "a" type variable is the value contained inside---     (just like other monads).------   See also '|-'.-newtype Body ctx a = Body (Writer [AST] a)-  deriving (Functor, Applicative, Monad, MonadWriter [AST])-  via (Writer [AST])---- | Creates a fragment that is the logical disjunction (OR) of 2 sub-fragments.---   This corresponds with ";" in Datalog.-(\/) :: Body ctx () -> Body ctx () -> Body ctx ()-body1 \/ body2 = do-  let rules1 = And' $ runBody body1-      rules2 = And' $ runBody body2-  tell [Or' [rules1, rules2]]---- | Creates a fragment that is the logical negation of a sub-fragment.---   This is equivalent to "!" in Datalog. (But this operator can't be used---   in Haskell since it only allows unary negation as a prefix operator.)-not' :: Body ctx a -> Body ctx ()-not' body = do-  let rules = And' $ runBody body-  tell [Not' rules]--runBody :: Body ctx a -> [AST]-runBody (Body m) = execWriter m--data TypeInfo (a :: k) (ts :: [Type]) = TypeInfo---- | Constraint that makes sure a type can be converted to a predicate function.---   It gives a user-friendly error in case any of the sub-constraints---   are not met.-type ToPredicate prog a =-  ( Fact a-  , FactMetadata a-  , ContainsFact prog a-  , SimpleProduct a-  , Assert (Length (Structure a) <=? 10) BigTupleError-  , KnownDLTypes (Structure a)-  , KnownDirection (FactDirection a)-  , KnownSymbols (AccessorNames a)-  , ToTerms (Structure a)-  )---- | A typeclass for optionally configuring extra settings---   (for performance reasons).----   Since it contains no required functions, it is possible to derive this---   typeclass automatically (this gives you the default behavior):------   @---   data Edge = Edge String String---     deriving (Generic, Marshal, FactMetadata)---   @-class (Fact a, SimpleProduct a) => FactMetadata a where-  -- | An optional function for configuring fact metadata.-  ---  --   By default no extra options are configured.-  --   For more information, see the 'Metadata' type.-  factOpts :: Proxy a -> Metadata a-  factOpts = const $ Metadata Automatic NoInline---- | A data type that allows for finetuning of fact settings---   (for performance reasons).-data Metadata a-  = Metadata (StructureOpt a) (InlineOpt (FactDirection a))---- | Datatype describing the way a fact is stored inside Datalog.---   A different choice of storage type can lead to an improvement in---   performance (potentially).------   For more information, see this---   <https://souffle-lang.github.io/tuning#datastructure link> and this---   <https://souffle-lang.github.io/relations link>.-data StructureOpt (a :: Type) where-  -- | Automatically choose the underlying storage for a relation.-  --   This is the storage type that is used by default.-  ---  --   For Souffle, it will choose a direct btree for facts with arity <= 6.-  --   For larger facts, it will use an indirect btree.-  Automatic :: StructureOpt a-  -- | Uses a direct btree structure.-  BTree :: StructureOpt a-  -- | Uses a brie structure. This can improve performance in some cases and is-  --   more memory efficient for particularly large relations.-  Brie :: StructureOpt a-  -- | A high performance datastructure optimised specifically for equivalence-  --   relations. This is only valid for binary facts with 2 fields of the-  --   same type.-  EqRel :: (IsBinaryRelation a, Structure a ~ '[t, t]) => StructureOpt a--type IsBinaryRelation a =-  Assert (Length (Structure a) == 2)-         ("Equivalence relations are only allowed with binary relations" <> ".")---- | Datatype indicating if we should inline a fact or not.-data InlineOpt (d :: Direction) where-  -- | Inlines the fact, only possible for internal facts.-  Inline :: InlineOpt 'Internal-  -- | Does not inline the fact.-  NoInline :: InlineOpt d---- | Generates a function for a type that implements 'Fact' and is a---   'SimpleProduct'. The predicate function takes the same amount of arguments---   as the original fact type. Calling the function with a tuple of arguments,---   creates fragments of datalog code that can be glued together using other---   functions in this module.------   Note: You need to specify for which fact you want to return a predicate---   for using TypeApplications.-predicateFor :: forall a prog. ToPredicate prog a => DSL prog 'Definition (Predicate a)-predicateFor = do-  let typeInfo = TypeInfo :: TypeInfo a (Structure a)-      p = Proxy :: Proxy a-      name = T.pack $ factName p-      accNames = fromMaybe genericNames $ accessorNames p-      opts = toSimpleMetadata $ factOpts p-      genericNames = map (("t" <>) . T.pack . show) [1..]-      tys = getTypes (Proxy :: Proxy (Structure a))-      direction = getDirection (Proxy :: Proxy (FactDirection a))-      fields = zipWith FieldData tys accNames-      definition = Declare' name direction fields opts-  addDefinition definition-  pure $ Predicate $ toFragment typeInfo name--toSimpleMetadata :: Metadata a -> SimpleMetadata-toSimpleMetadata (Metadata struct inline) =-  let structOpt = case struct of-        Automatic -> AutomaticLayout-        BTree -> BTreeLayout-        Brie -> BrieLayout-        EqRel -> EqRelLayout-      inlineOpt = case inline of-        Inline -> DoInline-        NoInline -> DoNotInline-  in SimpleMetadata structOpt inlineOpt--class KnownDirection a where-  getDirection :: Proxy a -> Direction-instance KnownDirection 'Input where getDirection = const Input-instance KnownDirection 'Output where getDirection = const Output-instance KnownDirection 'InputOutput where getDirection = const InputOutput-instance KnownDirection 'Internal where getDirection = const Internal---- | Turnstile operator from Datalog, used in relations.------   This is used for creating a DSL fragment that contains a relation.---   NOTE: |- is used instead of :- due to limitations of the Haskell syntax.-(|-) :: Head 'Relation a -> Body 'Relation () -> DSL prog 'Definition ()-Head name terms |- body =-  let rules = runBody body-      relation = Rule' name terms (And' rules)-  in addDefinition relation--infixl 0 |----- | A typeclass used for generating AST fragments of Datalog code.---   The generated fragments can be further glued together using the---   various functions in this module.-class Fragment f ctx where-  toFragment :: ToTerms ts => TypeInfo a ts -> Name -> Tuple ctx ts -> f ctx ()--instance Fragment Head 'Relation where-  toFragment typeInfo name terms =-    let terms' = toTerms (Proxy :: Proxy 'Relation) typeInfo terms-     in Head name terms'--instance Fragment Body 'Relation where-  toFragment typeInfo name terms =-    let terms' = toTerms (Proxy :: Proxy 'Relation) typeInfo terms-    in tell [Atom' name terms']--instance Fragment (DSL prog) 'Definition where-  toFragment typeInfo name terms =-    let terms' = toTerms (Proxy :: Proxy 'Definition) typeInfo terms-     in addDefinition $ Atom' name terms'---data RenderMode = Nested | TopLevel---- | Renders a DSL fragment to the corresponding Datalog code and writes it to---   a file.-renderIO :: Program prog => prog -> FilePath -> DSL prog 'Definition () -> IO ()-renderIO prog path = TIO.writeFile path . render prog---- | Renders a DSL fragment to the corresponding Datalog code.-render :: Program prog => prog -> DSL prog 'Definition () -> T.Text-render prog = flip runReader TopLevel . f . runDSL prog where-  f = \case-    Statements stmts ->-      T.unlines <$> traverse f stmts-    Declare name dir fields metadata ->-      let fieldPairs = map renderField fields-          renderedFactOpts = renderMetadata metadata-          renderedOpts = if T.null renderedFactOpts then "" else " " <> renderedFactOpts-       in pure $ T.intercalate "\n" $ catMaybes-        [ Just $ ".decl " <> name <> "(" <> T.intercalate ", " fieldPairs <> ")" <> renderedOpts-        , renderDir name dir-        ]-    Atom name terms -> do-      let rendered = name <> "(" <> renderTerms (toList terms) <> ")"-      end <- maybeDot-      pure $ rendered <> end-    Rule name terms body -> do-      body' <- f body-      let rendered =-            name <> "(" <> renderTerms (toList terms) <> ") :-\n" <>-            T.intercalate "\n" (map indent $ T.lines body')-      pure rendered-    And e1 e2 -> do-      txt <- nested $ do-        txt1 <- f e1-        txt2 <- f e2-        pure $ txt1 <> ",\n" <> txt2-      end <- maybeDot-      pure $ txt <> end-    Or e1 e2 -> do-      txt <- nested $ do-        txt1 <- f e1-        txt2 <- f e2-        pure $ txt1 <> ";\n" <> txt2-      end <- maybeDot-      case end of-        "." -> pure $ txt <> end-        _ -> pure $ "(" <> txt <> ")"-    Not e -> do-      let maybeAddParens txt = case e of-            And _ _ -> "(" <> txt <> ")"-            _ -> txt-      txt <- maybeAddParens <$> nested (f e)-      end <- maybeDot-      case end of-        "." -> pure $ "!" <> txt <> end-        _ -> pure $ "!" <> txt-    Constrain t -> do-      let t' = renderTerm t-      end <- maybeDot-      case end of-        "." -> pure $ t' <> "."-        _ -> pure t'-  indent = ("  " <>)-  nested = local (const Nested)-  maybeDot = ask >>= \case-    TopLevel -> pure "."-    Nested -> pure mempty--renderDir :: VarName -> Direction -> Maybe T.Text-renderDir name = \case-  Input -> Just $ ".input " <> name-  Output -> Just $ ".output " <> name-  InputOutput -> Just $ T.intercalate "\n"-                      $ catMaybes [renderDir name Input, renderDir name Output]-  Internal -> Nothing--renderField :: FieldData -> T.Text-renderField (FieldData ty accName) =-  let txt = case ty of-        DLNumber -> ": number"-        DLUnsigned -> ": unsigned"-        DLFloat -> ": float"-        DLString -> ": symbol"-   in accName <> txt--renderMetadata :: SimpleMetadata -> T.Text-renderMetadata (SimpleMetadata struct inline) =-  let structTxt = case struct of-        AutomaticLayout -> Nothing-        BTreeLayout -> Just "btree"-        BrieLayout -> Just "brie"-        EqRelLayout -> Just "eqrel"-      inlineTxt = case inline of-        DoInline -> Just "inline"-        DoNotInline -> Nothing-  in T.intercalate " " $ catMaybes [structTxt, inlineTxt]--renderTerms :: [SimpleTerm] -> T.Text-renderTerms = T.intercalate ", " . map renderTerm--renderTerm :: SimpleTerm -> T.Text-renderTerm = \case-  I x -> T.pack $ show x-  U x -> T.pack $ show x-  F x -> T.pack $ printf "%f" x-  S s -> "\"" <> T.pack s <> "\""-  V v -> v-  Underscore -> "_"--  BinOp' op t1 t2 -> renderTerm t1 <> " " <> renderBinOp op <> " " <> renderTerm t2-  UnaryOp' op t1 -> renderUnaryOp op <> renderTerm t1-  Func' name ts -> renderFunc name <> "(" <> renderTerms (toList ts) <> ")"-  where-    renderFunc = \case-      Max -> "max"-      Min -> "min"-      Cat -> "cat"-      Contains -> "contains"-      Match -> "match"-      Ord -> "ord"-      StrLen -> "strlen"-      Substr -> "substr"-      ToNumber -> "to_number"-      ToString -> "to_string"-    renderBinOp = \case-      Plus -> "+"-      Mul -> "*"-      Subtract -> "-"-      Div -> "/"-      Pow -> "^"-      Rem -> "%"-      BinaryAnd -> "band"-      BinaryOr -> "bor"-      BinaryXor -> "bxor"-      LogicalAnd -> "land"-      LogicalOr -> "lor"-      LessThan -> "<"-      LessThanOrEqual -> "<="-      GreaterThan -> ">"-      GreaterThanOrEqual -> ">="-      IsEqual -> "="-      IsNotEqual -> "!="-    renderUnaryOp Negate = "-"---type Name = T.Text---- | Type representing a variable name in Datalog.-type VarName = T.Text--type AccessorName = T.Text--data DLType-  = DLNumber-  | DLUnsigned-  | DLFloat-  | DLString--data FieldData = FieldData DLType AccessorName---- | A type level tag describing in which context a DSL fragment is used.---   This is only used on the type level and helps catch some semantic errors---   at compile time.-data UsageContext-  = Definition-  -- ^ A DSL fragment is used in a top level definition.-  | Relation-  -- ^ A DSL fragment is used inside a relation (either head or body of a relation).---- | A type family used for generating a user-friendly type error in case---   you use a variable in a DSL fragment where it is not allowed---   (outside of relations).-type family NoVarsInAtom (ctx :: UsageContext) :: Constraint where-  NoVarsInAtom ctx = Assert (ctx == 'Relation) NoVarsInAtomError--type NoVarsInAtomError =-  ( "You tried to use a variable in a top level fact, which is not supported in Souffle."-  % "Possible solutions:"-  % "  - Move the fact inside a rule body."-  % "  - Replace the variable in the fact with a string, number, unsigned or float constant."-  )---- | Data type for representing Datalog terms.------   All constructors are hidden, but with the `Num`, 'Fractional' and---   `IsString` instances it is possible to create terms using Haskell syntax---   for literals. For non-literal values, smart constructors are provided.---   (See for example 'underscore' / '__'.)-data Term ctx ty where-  -- NOTE: type family is used here instead of "Term 'Relation ty";-  -- this allows giving a better type error in some situations.-  VarTerm :: NoVarsInAtom ctx => VarName -> Term ctx ty-  UnderscoreTerm :: Term ctx ty-  NumberTerm :: Int32 -> Term ctx Int32-  UnsignedTerm :: Word32 -> Term ctx Word32-  FloatTerm :: Float -> Term ctx Float-  StringTerm :: ToString ty => ty -> Term ctx ty--  UnaryOp :: Num ty => Op1 -> Term ctx ty -> Term ctx ty-  BinOp :: Num ty => Op2 -> Term ctx ty -> Term ctx ty -> Term ctx ty-  Func :: FuncName -> NonEmpty SimpleTerm -> Term ctx ty2--data Op2-  = Plus-  | Mul-  | Subtract-  | Div-  | Pow-  | Rem-  | BinaryAnd-  | BinaryOr-  | BinaryXor-  | LogicalAnd-  | LogicalOr-  | LessThan-  | LessThanOrEqual-  | GreaterThan-  | GreaterThanOrEqual-  | IsEqual-  | IsNotEqual--data Op1 = Negate--data FuncName-  = Max-  | Min-  | Cat-  | Contains-  | Match-  | Ord-  | StrLen-  | Substr-  | ToNumber-  | ToString----- | Term representing a wildcard ("_") in Datalog.-underscore :: Term ctx ty-underscore = UnderscoreTerm---- | Term representing a wildcard ("_") in Datalog. Note that in the DSL this---   is with 2 underscores. (Single underscore is reserved for typed holes!)-__ :: Term ctx ty-__ = underscore--class ToString a where-  toString :: a -> String--instance ToString String where toString = id-instance ToString T.Text where toString = T.unpack-instance ToString TL.Text where toString = TL.unpack--instance IsString (Term ctx String) where fromString = StringTerm-instance IsString (Term ctx T.Text) where fromString = StringTerm . T.pack-instance IsString (Term ctx TL.Text) where fromString = StringTerm . TL.pack---- | A helper typeclass, mainly used for avoiding a lot of boilerplate---   in the 'Num' instance for 'Term'.-class Num ty => SupportsArithmetic ty where-  fromInteger' :: Integer -> Term ctx ty--instance SupportsArithmetic Int32 where-  fromInteger' = NumberTerm . fromInteger-instance SupportsArithmetic Word32 where-  fromInteger' = UnsignedTerm . fromInteger-instance SupportsArithmetic Float where-  fromInteger' = FloatTerm . fromInteger--instance (SupportsArithmetic ty, Num ty) => Num (Term ctx ty) where-  fromInteger = fromInteger'-  (+) = BinOp Plus-  (*) = BinOp Mul-  (-) = BinOp Subtract-  negate = UnaryOp Negate-  abs = error "'abs' is not supported for Souffle terms"-  signum = error "'signum' is not supported for Souffle terms"--instance Fractional (Term ctx Float) where-  fromRational = FloatTerm . fromRational-  (/) = BinOp Div---- | Exponentiation operator ("^" in Datalog).-(.^) :: Num ty => Term ctx ty -> Term ctx ty -> Term ctx ty-(.^) = BinOp Pow---- | Remainder operator ("%" in Datalog).-(.%) :: (Num ty, Integral ty) => Term ctx ty -> Term ctx ty -> Term ctx ty-(.%) = BinOp Rem---- | Creates a less than constraint (a < b), for use in the body of a relation.-(.<) :: Num ty => Term ctx ty -> Term ctx ty -> Body ctx ()-(.<) = addConstraint LessThan-infix 1 .<---- | Creates a less than or equal constraint (a <= b), for use in the body of---   a relation.-(.<=) :: Num ty => Term ctx ty -> Term ctx ty -> Body ctx ()-(.<=) = addConstraint LessThanOrEqual-infix 1 .<=---- | Creates a greater than constraint (a > b), for use in the body of a relation.-(.>) :: Num ty => Term ctx ty -> Term ctx ty -> Body ctx ()-(.>) = addConstraint GreaterThan-infix 1 .>---- | Creates a greater than or equal constraint (a >= b), for use in the body of---   a relation.-(.>=) :: Num ty => Term ctx ty -> Term ctx ty -> Body ctx ()-(.>=) = addConstraint GreaterThanOrEqual-infix 1 .>=---- | Creates a constraint that 2 terms should be equal to each other (a = b),---   for use in the body of a relation.-(.=) :: Term ctx ty -> Term ctx ty -> Body ctx ()-(.=) = addConstraint IsEqual-infix 1 .=---- | Creates a constraint that 2 terms should not be equal to each other---   (a != b), for use in the body of a relation.-(.!=) :: Term ctx ty -> Term ctx ty -> Body ctx ()-(.!=) = addConstraint IsNotEqual-infix 1 .!=--addConstraint :: Op2 -> Term ctx ty -> Term ctx ty -> Body ctx ()-addConstraint op e1 e2 =-  let expr = BinOp' op (toTerm e1) (toTerm e2)-   in tell [Constrain' expr]---- | Binary AND operator.-band :: (Num ty, Integral ty) => Term ctx ty -> Term ctx ty -> Term ctx ty-band = BinOp BinaryAnd---- | Binary OR operator.-bor :: (Num ty, Integral ty) => Term ctx ty -> Term ctx ty -> Term ctx ty-bor = BinOp BinaryOr---- | Binary XOR operator.-bxor :: (Num ty, Integral ty) => Term ctx ty -> Term ctx ty -> Term ctx ty-bxor = BinOp BinaryXor---- | Logical AND operator.-land :: (Num ty, Integral ty) => Term ctx ty -> Term ctx ty -> Term ctx ty-land = BinOp LogicalAnd---- | Logical OR operator.-lor :: (Num ty, Integral ty) => Term ctx ty -> Term ctx ty -> Term ctx ty-lor = BinOp LogicalOr---- | "max" function.-max' :: Num ty => Term ctx ty -> Term ctx ty -> Term ctx ty-max' = func2 Max---- | "min" function.-min' :: Num ty => Term ctx ty -> Term ctx ty -> Term ctx ty-min' = func2 Min---- | "cat" function (string concatenation).-cat :: ToString ty => Term ctx ty -> Term ctx ty -> Term ctx ty-cat = func2 Cat---- | "contains" predicate, checks if 2nd string contains the first.-contains :: ToString ty => Term ctx ty -> Term ctx ty -> Body ctx ()-contains a b =-  let expr = toTerm $ func2 Contains a b-   in tell [Constrain' expr]---- | "match" predicate, checks if a wildcard string matches a given string.-match :: ToString ty => Term ctx ty -> Term ctx ty -> Body ctx ()-match p s =-  let expr = toTerm $ func2 Match p s-  in tell [Constrain' expr]---- | "ord" function.-ord :: ToString ty => Term ctx ty -> Term ctx Int32-ord = func1 Ord---- | "strlen" function.-strlen :: ToString ty => Term ctx ty -> Term ctx Int32-strlen = func1 StrLen---- | "substr" function.-substr :: ToString ty => Term ctx ty -> Term ctx Int32 -> Term ctx Int32 -> Term ctx ty-substr a b c = Func Substr $ toTerm a :| [toTerm b, toTerm c]---- | "to_number" function.-to_number :: ToString ty => Term ctx ty -> Term ctx Int32-to_number = func1 ToNumber---- | "to_string" function.-to_string :: ToString ty => Term ctx Int32 -> Term ctx ty-to_string = func1 ToString--func1 :: FuncName -> Term ctx ty -> Term ctx ty2-func1 name a = Func name $ toTerm a :| []--func2 :: FuncName -> Term ctx ty -> Term ctx ty -> Term ctx ty2-func2 name a b = Func name $ toTerm a :| [toTerm b]--data SimpleTerm-  = V VarName-  | I Int32-  | U Word32-  | F Float-  | S String-  | Underscore--  | BinOp' Op2 SimpleTerm SimpleTerm-  | UnaryOp' Op1 SimpleTerm-  | Func' FuncName (NonEmpty SimpleTerm)--data SimpleMetadata = SimpleMetadata StructureOption InlineOption--data StructureOption-  = AutomaticLayout-  | BTreeLayout-  | BrieLayout-  | EqRelLayout--data InlineOption-  = DoInline-  | DoNotInline--data AST-  = Declare' VarName Direction [FieldData] SimpleMetadata-  | Rule' Name (NonEmpty SimpleTerm) AST-  | Atom' Name (NonEmpty SimpleTerm)-  | And' [AST]-  | Or' [AST]-  | Not' AST-  | Constrain' SimpleTerm--data DL-  = Statements [DL]-  | Declare VarName Direction [FieldData] SimpleMetadata-  | Rule Name (NonEmpty SimpleTerm) DL-  | Atom Name (NonEmpty SimpleTerm)-  | And DL DL-  | Or DL DL-  | Not DL-  | Constrain SimpleTerm---class KnownDLTypes (ts :: [Type]) where-  getTypes :: Proxy ts -> [DLType]--instance KnownDLTypes '[] where-  getTypes _ = []--instance (KnownDLType t, KnownDLTypes ts) => KnownDLTypes (t ': ts) where-  getTypes _ = getType (Proxy :: Proxy t) : getTypes (Proxy :: Proxy ts)--class KnownDLType t where-  getType :: Proxy t -> DLType--instance KnownDLType Int32 where getType = const DLNumber-instance KnownDLType Word32 where getType = const DLUnsigned-instance KnownDLType Float where getType = const DLFloat-instance KnownDLType String where getType = const DLString-instance KnownDLType T.Text where getType = const DLString-instance KnownDLType TL.Text where getType = const DLString--type family AccessorNames a :: [Symbol] where-  AccessorNames a = GetAccessorNames (Rep a)--type family GetAccessorNames (f :: Type -> Type) :: [Symbol] where-  GetAccessorNames (a :*: b) = GetAccessorNames a ++ GetAccessorNames b-  GetAccessorNames (C1 ('MetaCons _ _ 'False) _) = '[]-  GetAccessorNames (S1 ('MetaSel ('Just name) _ _ _) a) = '[name] ++ GetAccessorNames a-  GetAccessorNames (M1 _ _ a) = GetAccessorNames a-  GetAccessorNames (K1 _ _) = '[]--class KnownSymbols (symbols :: [Symbol]) where-  toStrings :: Proxy symbols -> [String]--instance KnownSymbols '[] where-  toStrings = const []--instance (KnownSymbol s, KnownSymbols symbols) => KnownSymbols (s ': symbols) where-  toStrings _ =-    let sym = symbolVal (Proxy :: Proxy s)-        symbols =  toStrings (Proxy :: Proxy symbols)-     in sym : symbols--accessorNames :: forall a. KnownSymbols (AccessorNames a) => Proxy a -> Maybe [T.Text]-accessorNames _ = case toStrings (Proxy :: Proxy (AccessorNames a)) of-  [] -> Nothing-  names -> Just $ T.pack <$> names---- | A type synonym for a tuple consisting of Datalog 'Term's.---   Only tuples containing up to 10 elements are currently supported.-type Tuple ctx ts = TupleOf (MapType (Term ctx) ts)--class ToTerms (ts :: [Type]) where-  toTerms :: Proxy ctx -> TypeInfo a ts -> Tuple ctx ts -> NonEmpty SimpleTerm--instance ToTerms '[t] where-  toTerms _ _ a =-    toTerm a :| []--instance ToTerms '[t1, t2] where-  toTerms _ _ (a, b) =-    toTerm a :| [toTerm b]--instance ToTerms '[t1, t2, t3] where-  toTerms _ _ (a, b, c) =-    toTerm a :| [toTerm b, toTerm c]--instance ToTerms '[t1, t2, t3, t4] where-  toTerms _ _ (a, b, c, d) =-    toTerm a :| [toTerm b, toTerm c, toTerm d]--instance ToTerms '[t1, t2, t3, t4, t5] where-  toTerms _ _ (a, b, c, d, e) =-    toTerm a :| [toTerm b, toTerm c, toTerm d, toTerm e]--instance ToTerms '[t1, t2, t3, t4, t5, t6] where-  toTerms _ _ (a, b, c, d, e, f) =-    toTerm a :| [toTerm b, toTerm c, toTerm d, toTerm e, toTerm f]--instance ToTerms '[t1, t2, t3, t4, t5, t6, t7] where-  toTerms _ _ (a, b, c, d, e, f, g) =-    toTerm a :| [toTerm b, toTerm c, toTerm d, toTerm e, toTerm f, toTerm g]--instance ToTerms '[t1, t2, t3, t4, t5, t6, t7, t8] where-  toTerms _ _ (a, b, c, d, e, f, g, h) =-    toTerm a :| [toTerm b, toTerm c, toTerm d, toTerm e, toTerm f, toTerm g, toTerm h]--instance ToTerms '[t1, t2, t3, t4, t5, t6, t7, t8, t9] where-  toTerms _ _ (a, b, c, d, e, f, g, h, i) =-    toTerm a :| [toTerm b, toTerm c, toTerm d, toTerm e, toTerm f, toTerm g, toTerm h, toTerm i]--instance ToTerms '[t1, t2, t3, t4, t5, t6, t7, t8, t9, t10] where-  toTerms _ _ (a, b, c, d, e, f, g, h, i, j) =-    toTerm a :| [ toTerm b, toTerm c, toTerm d, toTerm e, toTerm f-                , toTerm g, toTerm h, toTerm i, toTerm j-                ]--toTerm :: Term ctx t -> SimpleTerm-toTerm = \case-  VarTerm v -> V v-  StringTerm s -> S $ toString s-  NumberTerm x -> I x-  UnsignedTerm x -> U x-  FloatTerm x -> F x-  UnderscoreTerm -> Underscore--  BinOp op t1 t2 -> BinOp' op (toTerm t1) (toTerm t2)-  UnaryOp op t1 -> UnaryOp' op (toTerm t1)-  Func name ts -> Func' name ts----- Helper functions / type families / ...--type family MapType (f :: Type -> Type) (ts :: [Type]) :: [Type] where-  MapType _ '[] = '[]-  MapType f (t ': ts) = f t ': MapType f ts--type family Assert (c :: Bool) (msg :: ErrorMessage) :: Constraint where-  Assert 'True _ = ()-  Assert 'False msg = TypeError msg--type family (a :: k) == (b :: k) :: Bool where-  a == a = 'True-  _ == _ = 'False--type family Length (xs :: [Type]) :: Nat where-  Length '[] = 0-  Length (_ ': xs) = 1 + Length xs---- | A helper type family for computing the list of types used in a data type.---   (The type family assumes a data type with a single data constructor.)-type family Structure a :: [Type] where-  Structure a = Collect (Rep a)--type family Collect (a :: Type -> Type) where-  Collect (a :*: b) = Collect a ++ Collect b-  Collect (M1 _ _ a) = Collect a-  Collect (K1 _ ty) = '[ty]--type family a ++ b = c where-  '[] ++ b = b-  a ++ '[] = a-  (a ': b) ++ c = a ': (b ++ c)--type family TupleOf (ts :: [Type]) = t where-  TupleOf '[t] = t-  TupleOf '[t1, t2] = (t1, t2)-  TupleOf '[t1, t2, t3] = (t1, t2, t3)-  TupleOf '[t1, t2, t3, t4] = (t1, t2, t3, t4)-  TupleOf '[t1, t2, t3, t4, t5] = (t1, t2, t3, t4, t5)-  TupleOf '[t1, t2, t3, t4, t5, t6] = (t1, t2, t3, t4, t5, t6)-  TupleOf '[t1, t2, t3, t4, t5, t6, t7] = (t1, t2, t3, t4, t5, t6, t7)-  TupleOf '[t1, t2, t3, t4, t5, t6, t7, t8] = (t1, t2, t3, t4, t5, t6, t7, t8)-  TupleOf '[t1, t2, t3, t4, t5, t6, t7, t8, t9] = (t1, t2, t3, t4, t5, t6, t7, t8, t9)-  TupleOf '[t1, t2, t3, t4, t5, t6, t7, t8, t9, t10] = (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10)-  TupleOf _ = TypeError BigTupleError--type BigTupleError =-  ( "The DSL only supports facts/tuples consisting of up to 10 elements."-  % "If you need more arguments, please submit an issue on Github "-  <> "(https://github.com/luc-tielen/souffle-haskell/issues)"-  )-
lib/Language/Souffle/Internal.hs view
@@ -10,8 +10,7 @@ module Language.Souffle.Internal   ( Souffle   , Relation-  , RelationIterator-  , Tuple+  , ByteBuf   , init   , setNumThreads   , getNumThreads@@ -19,35 +18,22 @@   , loadAll   , printAll   , getRelation-  , countFacts-  , getRelationIterator-  , relationIteratorNext-  , allocTuple-  , addTuple-  , containsTuple-  , tuplePushInt32-  , tuplePushUInt32-  , tuplePushFloat-  , tuplePushString-  , tuplePopInt32-  , tuplePopUInt32-  , tuplePopFloat-  , tuplePopString+  , pushFacts+  , popFacts+  , containsFact   ) where  import Prelude hiding ( init ) import Data.Functor ( (<&>) ) import Data.Word-import Data.Int-import Foreign.Marshal.Alloc-import Foreign.Storable import Foreign.C.String import Foreign.C.Types import Foreign.ForeignPtr import Foreign.Ptr import qualified Language.Souffle.Internal.Bindings as Bindings import Language.Souffle.Internal.Bindings-  ( Souffle, Relation, RelationIterator, Tuple )+  ( Souffle, Relation, ByteBuf )+import Control.Exception (mask_)   {- | Initializes a Souffle program.@@ -60,7 +46,7 @@      in this module. -} init :: String -> IO (Maybe (ForeignPtr Souffle))-init prog = do+init prog = mask_ $ do   ptr <- withCString prog Bindings.init   if ptr == nullPtr     then pure Nothing@@ -106,103 +92,37 @@   withCString relation $ Bindings.getRelation ptr {-# INLINABLE getRelation #-} --- | Returns the amount of facts found in a relation.-countFacts :: Ptr Relation -> IO Int-countFacts relation =-  Bindings.getTupleCount relation >>= \(CSize count) ->-    -- TODO: check what happens for really large sizes?-    pure (fromIntegral count)---- | Create an iterator for iterating over the facts of a relation.-getRelationIterator :: Ptr Relation -> IO (ForeignPtr RelationIterator)-getRelationIterator relation =-  Bindings.getRelationIterator relation >>= newForeignPtr Bindings.freeRelationIterator-{-# INLINABLE getRelationIterator #-}--{-| Advances the relation iterator by 1 position.+{-| Serializes many facts from Datalog to Haskell. -    Calling this function when there are no more results to be returned-    will result in a crash.+    You need to check if the passed pointers are non-NULL before passing it+    to this function. Not doing so results in undefined behavior.+    Passing in a different count of objects to what is actually inside the+    byte buffer will crash. -}-relationIteratorNext :: ForeignPtr RelationIterator -> IO (Ptr Tuple)-relationIteratorNext iter = withForeignPtr iter Bindings.relationIteratorNext-{-# INLINABLE relationIteratorNext #-}+pushFacts :: Ptr Relation -> Ptr ByteBuf -> Word64 -> IO ()+pushFacts relation buf x =+  Bindings.pushByteBuf relation buf (CSize x)+{-# INLINABLE pushFacts #-} --- | Allocates memory for a tuple (fact) to be added to a relation.-allocTuple :: Ptr Relation -> IO (ForeignPtr Tuple)-allocTuple relation =-  Bindings.allocTuple relation >>= newForeignPtr Bindings.freeTuple-{-# INLINABLE allocTuple #-}+{-| Serializes many facts from Haskell to Datalog. --- | Adds a tuple (fact) to a relation.-addTuple :: Ptr Relation -> ForeignPtr Tuple -> IO ()-addTuple relation tuple =-  withForeignPtr tuple $ Bindings.addTuple relation-{-# INLINABLE addTuple #-}+    You need to check if the passed pointer is non-NULL before passing it+    to this function. Not doing so results in undefined behavior. +    Returns a pointer to a byte buffer that contains the serialized Datalog facts.+-}+popFacts :: Ptr Souffle -> Ptr Relation -> IO (Ptr ByteBuf)+popFacts = Bindings.popByteBuf+{-# INLINABLE popFacts #-}+ {- | Checks if a relation contains a certain tuple.       Returns True if the tuple was found in the relation; otherwise False. -}-containsTuple :: Ptr Relation -> ForeignPtr Tuple -> IO Bool-containsTuple relation tuple = withForeignPtr tuple $ \ptr ->-  Bindings.containsTuple relation ptr <&> \case+containsFact :: Ptr Relation -> Ptr ByteBuf -> IO Bool+containsFact relation buf =+  Bindings.containsTuple relation buf <&> \case     CBool 0 -> False     CBool _ -> True-{-# INLINABLE containsTuple #-}---- | Pushes an integer value into a tuple.-tuplePushInt32 :: Ptr Tuple -> Int32 -> IO ()-tuplePushInt32 tuple i = Bindings.tuplePushInt32 tuple (CInt i)-{-# INLINABLE tuplePushInt32 #-}---- | Pushes an unsigned integer value into a tuple.-tuplePushUInt32 :: Ptr Tuple -> Word32 -> IO ()-tuplePushUInt32 tuple i = Bindings.tuplePushUInt32 tuple (CUInt i)-{-# INLINABLE tuplePushUInt32 #-}---- | Pushes a float value into a tuple.-tuplePushFloat :: Ptr Tuple -> Float -> IO ()-tuplePushFloat tuple f = Bindings.tuplePushFloat tuple (CFloat f)-{-# INLINABLE tuplePushFloat #-}---- | Pushes a string value into a tuple.-tuplePushString :: Ptr Tuple -> String -> IO ()-tuplePushString tuple str =-  withCString str $ Bindings.tuplePushString tuple-{-# INLINABLE tuplePushString #-}---- | Extracts a 32 bit signed integer value from a tuple.-tuplePopInt32 :: Ptr Tuple -> IO Int32-tuplePopInt32 tuple = alloca $ \ptr -> do-  Bindings.tuplePopInt32 tuple ptr-  (CInt res) <- peek ptr-  pure res-{-# INLINABLE tuplePopInt32 #-}---- | Extracts a 32 bit unsigned integer value from a tuple.-tuplePopUInt32 :: Ptr Tuple -> IO Word32-tuplePopUInt32 tuple = alloca $ \ptr -> do-  Bindings.tuplePopUInt32 tuple ptr-  (CUInt res) <- peek ptr-  pure res-{-# INLINABLE tuplePopUInt32 #-}---- | Extracts a float value from a tuple.-tuplePopFloat :: Ptr Tuple -> IO Float-tuplePopFloat tuple = alloca $ \ptr -> do-  Bindings.tuplePopFloat tuple ptr-  (CFloat res) <- peek ptr-  pure res-{-# INLINABLE tuplePopFloat #-}---- | Extracts a string value from a tuple.-tuplePopString :: Ptr Tuple -> IO String-tuplePopString tuple = alloca $ \ptr -> do-  Bindings.tuplePopString tuple ptr-  cstr <- peek ptr-  str <- peekCString cstr-  free cstr-  pure str-{-# INLINABLE tuplePopString #-}+{-# INLINABLE containsFact #-} 
lib/Language/Souffle/Internal/Bindings.hs view
@@ -5,8 +5,7 @@ module Language.Souffle.Internal.Bindings   ( Souffle   , Relation-  , RelationIterator-  , Tuple+  , ByteBuf   , init   , free   , setNumThreads@@ -15,22 +14,9 @@   , loadAll   , printAll   , getRelation-  , getTupleCount-  , getRelationIterator-  , freeRelationIterator-  , relationIteratorNext-  , allocTuple-  , freeTuple-  , addTuple+  , pushByteBuf+  , popByteBuf   , containsTuple-  , tuplePushInt32-  , tuplePushUInt32-  , tuplePushString-  , tuplePushFloat-  , tuplePopInt32-  , tuplePopUInt32-  , tuplePopString-  , tuplePopFloat   ) where  import Prelude hiding ( init )@@ -46,13 +32,8 @@ -- | A void type, used for tagging a pointer that points to a relation. data Relation --- | A void type, used for tagging a pointer that points to an---   iterator used for iterating over a relation.-data RelationIterator---- | A void type, used for tagging a pointer that points to a tuple---   (term used in the Souffle compiler for a fact).-data Tuple+-- | A void type, used for tagging a pointer that points to a raw bytearray.+data ByteBuf   {- | Initializes a Souffle program.@@ -128,187 +109,33 @@ foreign import ccall unsafe "souffle_relation" getRelation   :: Ptr Souffle -> CString -> IO (Ptr Relation) -{-| Gets the amount of tuples found in a relation.--    You need to check if both passed pointers are not equal to 'nullPtr' before-    passing it to this function. Not doing so results in undefined behavior (in C++).--    Returns the amount of tuples found in a relation.--}-foreign import ccall unsafe "souffle_relation_tuple_count" getTupleCount-  :: Ptr Relation -> IO CSize--{-| Create an iterator for iterating over the facts of a relation.--    You need to check if the passed pointer is not equal to 'nullPtr' before-    passing it to this function. Not doing so results in undefined behavior (in C++).--    The returned pointer needs to be freed with 'freeRelationIterator'-    after it is no longer needed.--}-foreign import ccall unsafe "souffle_relation_iterator" getRelationIterator-  :: Ptr Relation -> IO (Ptr RelationIterator)--{-| Frees a pointer previously allocated with 'getRelationIterator'.--    You need to check if the passed pointer is not equal to 'nullPtr' before-    passing it to this function. Not doing so results in undefined behavior (in C++).--}-foreign import ccall unsafe "&souffle_relation_iterator_free" freeRelationIterator-  :: FunPtr (Ptr RelationIterator -> IO ())--{-| Advances the relation iterator by 1 position.--    You need to check if the passed pointer is not equal to 'nullPtr' before-    passing it to this function. Not doing so results in undefined behavior (in C++).--    Calling this function when there are no more tuples to be returned-    will result in a crash.--    Returns a pointer to the next tuple. This pointer is not allowed to be freed-    as it is managed by the Souffle program already.--}-foreign import ccall unsafe "souffle_relation_iterator_next" relationIteratorNext-  :: Ptr RelationIterator -> IO (Ptr Tuple)--{-| Allocates memory for a tuple (fact) to be added to a relation.--    You need to check if the passed pointer is not equal to 'nullPtr' before-    passing it to this function. Not doing so results in undefined behavior (in C++).--    Returns a pointer to a new tuple. Use 'freeTuple' when the tuple-    is no longer required.--}-foreign import ccall unsafe "souffle_tuple_alloc" allocTuple-  :: Ptr Relation -> IO (Ptr Tuple)--{-| Frees memory of a tuple that was previously allocated (in Haskell).--    You need to check if the passed pointer is not equal to 'nullPtr' before-    passing it to this function. Not doing so results in undefined behavior (in C++).--}-foreign import ccall unsafe "&souffle_tuple_free" freeTuple-  :: FunPtr (Ptr Tuple -> IO ())--{-| Adds a tuple to a relation.--    You need to check if both passed pointers are not equal to 'nullPtr' before-    passing it to this function. Not doing so results in undefined behavior (in C++).--}-foreign import ccall unsafe "souffle_tuple_add" addTuple-  :: Ptr Relation -> Ptr Tuple -> IO ()--{- | Checks if a relation contains a certain tuple.--     You need to check if the passed pointers are non-NULL before passing it-     to this function. Not doing so results in undefined behavior.--     Returns True if the tuple was found in the relation; otherwise False.--}-foreign import ccall unsafe "souffle_contains_tuple" containsTuple-  :: Ptr Relation -> Ptr Tuple -> IO CBool--{-| Pushes a 32 bit signed integer value into a tuple.--    You need to check if the passed pointer is not equal to 'nullPtr' before-    passing it to this function. Not doing so results in undefined behavior (in C++).--    Pushing an integer value onto a tuple that expects another type results-    in a crash. Pushing a value into a tuple when it already is "full"-    also results in a crash.--}-foreign import ccall unsafe "souffle_tuple_push_int32" tuplePushInt32-  :: Ptr Tuple -> CInt -> IO ()--{-| Pushes a 32 bit unsigned integer value into a tuple.--    You need to check if the passed pointer is not equal to 'nullPtr' before-    passing it to this function. Not doing so results in undefined behavior (in C++).--    Pushing an integer value onto a tuple that expects another type results-    in a crash. Pushing a value into a tuple when it already is "full"-    also results in a crash.--}-foreign import ccall unsafe "souffle_tuple_push_uint32" tuplePushUInt32-  :: Ptr Tuple -> CUInt -> IO ()--{-| Pushes a float value into a tuple.--    You need to check if the passed pointer is not equal to 'nullPtr' before-    passing it to this function. Not doing so results in undefined behavior (in C++).--    Pushing a float value onto a tuple that expects another type results-    in a crash. Pushing a value into a tuple when it already is "full"-    also results in a crash.--}-foreign import ccall unsafe "souffle_tuple_push_float" tuplePushFloat-  :: Ptr Tuple -> CFloat -> IO ()--{-| Pushes a string value into a tuple.--    You need to check if the passed pointer is not equal to 'nullPtr' before-    passing it to this function. Not doing so results in undefined behavior (in C++).--    Pushing a string value onto a tuple that expects another type results-    in a crash. Pushing a value into a tuple when it already is "full"-    also results in a crash.--}-foreign import ccall unsafe "souffle_tuple_push_string" tuplePushString-  :: Ptr Tuple -> CString -> IO ()--{-| Extracts a 32 bit signed integer value from a tuple.--    You need to check if the passed pointer is not equal to 'nullPtr' before passing it-    to this function. Not doing so results in undefined behavior.--    Extracting an integer value from a tuple that expects another type results-    in a crash. Extracting a value from a tuple when it is already "empty"-    also results in a crash.--    The popped integer will be stored in the pointer that is passed in.--}-foreign import ccall unsafe "souffle_tuple_pop_int32" tuplePopInt32-  :: Ptr Tuple -> Ptr CInt -> IO ()--{-| Extracts a 32 bit unsigned integer value from a tuple.+{-| Checks if a relation contains a certain tuple. -    You need to check if the passed pointer is not equal to 'nullPtr' before passing it+    You need to check if the passed pointers are non-NULL before passing it     to this function. Not doing so results in undefined behavior. -    Extracting an integer value from a tuple that expects another type results-    in a crash. Extracting a value from a tuple when it is already "empty"-    also results in a crash.--    The popped integer will be stored in the pointer that is passed in.+    Returns True if the tuple was found in the relation; otherwise False. -}-foreign import ccall unsafe "souffle_tuple_pop_uint32" tuplePopUInt32-  :: Ptr Tuple -> Ptr CUInt -> IO ()+foreign import ccall unsafe "souffle_contains_tuple" containsTuple+  :: Ptr Relation -> Ptr ByteBuf -> IO CBool -{-| Extracts a float value from a tuple.+{-| Serializes many Datalog facts from Haskell to C++. -    You need to check if the passed pointer is not equal to 'nullPtr' before passing it+    You need to check if the passed pointers are non-NULL before passing it     to this function. Not doing so results in undefined behavior.--    Extracting a float value from a tuple that expects another type results-    in a crash. Extracting a value from a tuple when it is already "empty"-    also results in a crash.--    The popped float will be stored in the pointer that is passed in.+    Passing in a different count of objects to what is actually inside the+    byte buffer will crash. -}-foreign import ccall unsafe "souffle_tuple_pop_float" tuplePopFloat-  :: Ptr Tuple -> Ptr CFloat -> IO ()+foreign import ccall unsafe "souffle_tuple_push_many" pushByteBuf+  :: Ptr Relation -> Ptr ByteBuf -> CSize -> IO () -{-| Extracts a string value from a tuple.+{-| Serializes many Datalog facts from Datalog to Haskell -    You need to check if the passed pointer is not equal to 'nullPtr' before passing it+    You need to check if the passed pointers are non-NULL before passing it     to this function. Not doing so results in undefined behavior. -    Extracting a string value from a tuple that expects another type results-    in a crash. Extracting a value from a tuple when it is already "empty"-    also results in a crash.--    The popped string will be stored in the result pointer.+    Returns a pointer to a byte buffer that contains the serialized Datalog facts. -}-foreign import ccall unsafe "souffle_tuple_pop_string" tuplePopString-  :: Ptr Tuple -> Ptr CString -> IO ()+foreign import ccall unsafe "souffle_tuple_pop_many" popByteBuf+  :: Ptr Souffle -> Ptr Relation -> IO (Ptr ByteBuf) 
lib/Language/Souffle/Internal/Constraints.hs view
@@ -14,6 +14,7 @@ import Data.Word import qualified Data.Text as T import qualified Data.Text.Lazy as TL+import qualified Data.Text.Short as TS   -- | A helper type family used for generating a more user-friendly type error@@ -23,7 +24,8 @@ --   The __a__ type parameter is the original type, used when displaying the type error. -- --   A type error is returned if the passed in type is not a simple product type---   consisting of only "simple" types like Int32, Word32, Float, String and Text.+--   consisting of only "simple" types like Int32, Word32, Float, String, Text+--   and ShortText. type family SimpleProduct (a :: Type) :: Constraint where   SimpleProduct a = (ProductLike a (Rep a), OnlySimpleFields a (Rep a)) @@ -56,12 +58,13 @@ type family DirectlyMarshallable (a :: Type) (b :: Type) :: Constraint where   DirectlyMarshallable _ T.Text = ()   DirectlyMarshallable _ TL.Text = ()+  DirectlyMarshallable _ TS.ShortText = ()   DirectlyMarshallable _ Int32 = ()   DirectlyMarshallable _ Word32 = ()   DirectlyMarshallable _ Float = ()   DirectlyMarshallable _ String = ()   DirectlyMarshallable t a =     TypeError ( "Error while generating marshalling code for " <> t <> ":"-              % "Can only marshal values of Int32, Word32, Float, String and Text directly"+              % "Can only marshal values of Int32, Word32, Float, String, Text and ShortText directly"              <> ", but found " <> a <> " type instead.") 
lib/Language/Souffle/Interpreted.hs view
@@ -1,5 +1,6 @@ {-# OPTIONS_GHC -Wno-redundant-constraints #-}-{-# LANGUAGE FlexibleInstances, TypeFamilies, DerivingVia, InstanceSigs, UndecidableInstances #-}+{-# LANGUAGE FlexibleInstances, TypeFamilies, DerivingVia, InstanceSigs #-}+{-# LANGUAGE UndecidableInstances, RoleAnnotations #-}  -- | This module provides an implementation for the `MonadSouffle` typeclass --   defined in "Language.Souffle.Class".@@ -40,6 +41,7 @@ import Data.Proxy import qualified Data.Array as A import qualified Data.Text as T+import qualified Data.Text.Short as TS import qualified Data.Vector as V import Data.Word import Language.Souffle.Class@@ -169,6 +171,7 @@   , stdoutResult :: IORef (Maybe T.Text)   , stderrResult :: IORef (Maybe T.Text)   }+type role Handle nominal  -- | The data needed for the interpreter is the path where the souffle --   executable can be found, and a template directory where the program@@ -199,6 +202,12 @@   pushString str = modify (str:)   {-# INLINABLE pushString #-} +  pushText txt = pushString (TS.unpack txt)+  {-# INLINABLE pushText #-}++  pushTextUtf16 txt = pushString (T.unpack txt)+  {-# INLINABLE pushTextUtf16 #-}+ instance MonadPop IMarshal where   popInt32 = state $ \case     [] -> error "Empty fact stack"@@ -220,6 +229,20 @@     (h:t) -> (h, t)   {-# INLINABLE popString #-} +  popText = do+    str <- state $ \case+      [] -> error "Empty fact stack"+      (h:t) -> (h, t)+    pure $ TS.pack str+  {-# INLINABLE popText #-}++  popTextUtf16 = do+    str <- state $ \case+      [] -> error "Empty fact stack"+      (h:t) -> (h, t)+    pure $ T.pack str+  {-# INLINABLE popTextUtf16 #-}+ popMarshalT :: IMarshal a -> [String] -> a popMarshalT (IMarshal m) = evalState m {-# INLINABLE popMarshalT #-}@@ -252,6 +275,7 @@ instance MonadSouffle SouffleM where   type Handler SouffleM = Handle   type CollectFacts SouffleM c = Collect c+  type SubmitFacts SouffleM _ = ()    run (Handle refHandleData refHandleStdOut refHandleStdErr) = liftIO $ do     handle <- readIORef refHandleData@@ -347,8 +371,9 @@   (_, Just hout, _, locateCmdHandle) <- createProcess locateCmd   waitForProcess locateCmdHandle >>= \case     ExitFailure _ -> pure Nothing-    ExitSuccess ->-      words <$> hGetContents hout >>= \case+    ExitSuccess -> do+      contents <- hGetContents hout+      case words contents of         [souffleBin] -> pure $ Just souffleBin         _ -> pure Nothing {-# INLINABLE locateSouffle #-}
lib/Language/Souffle/Marshal.hs view
@@ -16,6 +16,7 @@ import Data.Int import Data.Word import qualified Data.Text as T+import qualified Data.Text.Short as TS import qualified Data.Text.Lazy as TL import qualified Language.Souffle.Internal.Constraints as C @@ -34,6 +35,10 @@   pushFloat :: Float -> m ()   -- | Marshals a string to the datalog side.   pushString :: String -> m ()+  -- | Marshals a UTF8-encoded Text string to the datalog side.+  pushText :: TS.ShortText -> m ()+  -- | Marshals a UTF16-encoded Text string to the datalog side.+  pushTextUtf16 :: T.Text -> m ()  {- | A typeclass for serializing primitive values from Datalog to Haskell. @@ -50,6 +55,10 @@   popFloat :: m Float   -- | Unmarshals a string from the datalog side.   popString :: m String+  -- | Unmarshals a Text string from the datalog side.+  popText :: m TS.ShortText+  -- | Unmarshals a UTF16-encoded Text string from the datalog side.+  popTextUtf16 :: m T.Text  {- | A typeclass for providing a uniform API to marshal/unmarshal values      between Haskell and Souffle datalog.@@ -111,16 +120,22 @@   pop = popString   {-# INLINABLE pop #-} +instance Marshal TS.ShortText where+  push = pushText+  {-# INLINABLE push #-}+  pop = popText+  {-# INLINABLE pop #-}+ instance Marshal T.Text where-  push = push . T.unpack+  push = pushTextUtf16   {-# INLINABLE push #-}-  pop = T.pack <$> pop+  pop = popTextUtf16   {-# INLINABLE pop #-}  instance Marshal TL.Text where-  push = push . TL.unpack+  push = push . TL.toStrict   {-# INLINABLE push #-}-  pop = TL.pack <$> pop+  pop = TL.fromStrict <$> pop   {-# INLINABLE pop #-}  class GMarshal f where
souffle-haskell.cabal view
@@ -1,13 +1,13 @@ cabal-version: 2.2 --- This file has been generated from package.yaml by hpack version 0.33.0.+-- This file has been generated from package.yaml by hpack version 0.34.2. -- -- see: https://github.com/sol/hpack ----- hash: 282b7f644a46aaacc10fd325f80d88a1529d0ea5737403640996967d6b523a4c+-- hash: 7e179d1e2ce8ddd1c9a53631a6b4743b754065bf70a2130d654d738b83cec53a  name:           souffle-haskell-version:        2.1.0+version:        3.0.0 synopsis:       Souffle Datalog bindings for Haskell description:    Souffle Datalog bindings for Haskell. category:       Logic Programming, Foreign Binding, Bindings@@ -60,6 +60,7 @@     cbits/souffle/utility/StreamUtil.h     cbits/souffle/utility/StringUtil.h     cbits/souffle/utility/tinyformat.h+    cbits/souffle.cpp     cbits/souffle/LICENSE  source-repository head@@ -70,7 +71,6 @@   exposed-modules:       Language.Souffle.Class       Language.Souffle.Compiled-      Language.Souffle.Experimental       Language.Souffle.Internal       Language.Souffle.Internal.Bindings       Language.Souffle.Internal.Constraints@@ -130,6 +130,7 @@   build-depends:       array <=1.0     , base >=4.12 && <5+    , bytestring     , containers >=0.6.2.1 && <1     , deepseq >=1.4.4 && <2     , directory >=1.3.3 && <2@@ -139,6 +140,7 @@     , template-haskell >=2 && <3     , temporary >=1.3 && <2     , text >=1.0 && <2+    , text-short >=0.1.3 && <1     , type-errors-pretty >=0.0.1.0 && <1     , vector <=1.0   if os(linux)@@ -151,9 +153,6 @@   main-is: test.hs   other-modules:       Test.Language.Souffle.CompiledSpec-      Test.Language.Souffle.Experimental.Fixtures-      Test.Language.Souffle.Experimental.FixturesCompiled-      Test.Language.Souffle.ExperimentalSpec       Test.Language.Souffle.InterpretedSpec       Test.Language.Souffle.MarshalSpec       Paths_souffle_haskell@@ -203,11 +202,13 @@       souffle/utility/EvaluatorUtil.h       souffle/utility/FunctionalUtil.h   cxx-sources:+      tests/fixtures/edge_cases.cpp       tests/fixtures/path.cpp       tests/fixtures/round_trip.cpp   build-depends:       array <=1.0     , base >=4.12 && <5+    , bytestring     , containers >=0.6.2.1 && <1     , deepseq >=1.4.4 && <2     , directory >=1.3.3 && <2@@ -222,6 +223,82 @@     , template-haskell >=2 && <3     , temporary >=1.3 && <2     , text >=1.0 && <2+    , text-short >=0.1.3 && <1+    , type-errors-pretty >=0.0.1.0 && <1+    , vector <=1.0+  if os(darwin)+    extra-libraries:+        c+++  default-language: Haskell2010++benchmark souffle-haskell-benchmarks+  type: exitcode-stdio-1.0+  main-is: bench.hs+  other-modules:+      Paths_souffle_haskell+  hs-source-dirs:+      benchmarks+  default-extensions: OverloadedStrings LambdaCase ScopedTypeVariables+  ghc-options: -Wall -Weverything -Wno-safe -Wno-unsafe -Wno-implicit-prelude -Wno-missed-specializations -Wno-all-missed-specializations -Wno-missing-import-lists -Wno-type-defaults -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-missing-deriving-strategies -Wno-prepositive-qualified-module -Wno-missing-safe-haskell-mode -optP-Wno-nonportable-include-path -fhide-source-paths -fno-show-valid-hole-fits -fno-sort-valid-hole-fits +RTS -N1 -RTS+  cxx-options: -std=c++17 -D__EMBEDDED_SOUFFLE__ -std=c++17 -march=native+  include-dirs:+      cbits+      cbits/souffle+  install-includes:+      souffle/CompiledSouffle.h+      souffle/CompiledTuple.h+      souffle/RamTypes.h+      souffle/RecordTable.h+      souffle/SignalHandler.h+      souffle/SouffleInterface.h+      souffle/SymbolTable.h+      souffle/utility/MiscUtil.h+      souffle/utility/tinyformat.h+      souffle/utility/ParallelUtil.h+      souffle/utility/StreamUtil.h+      souffle/utility/ContainerUtil.h+      souffle/datastructure/Brie.h+      souffle/utility/CacheUtil.h+      souffle/datastructure/EquivalenceRelation.h+      souffle/datastructure/LambdaBTree.h+      souffle/datastructure/BTree.h+      souffle/datastructure/PiggyList.h+      souffle/datastructure/UnionFind.h+      souffle/datastructure/Table.h+      souffle/io/IOSystem.h+      souffle/io/ReadStream.h+      souffle/io/SerialisationStream.h+      souffle/utility/json11.h+      souffle/utility/StringUtil.h+      souffle/io/ReadStreamCSV.h+      souffle/utility/FileUtil.h+      souffle/io/gzfstream.h+      souffle/io/ReadStreamJSON.h+      souffle/io/WriteStream.h+      souffle/io/WriteStreamCSV.h+      souffle/io/WriteStreamJSON.h+      souffle/io/ReadStreamSQLite.h+      souffle/io/WriteStreamSQLite.h+      souffle/utility/EvaluatorUtil.h+      souffle/utility/FunctionalUtil.h+  cxx-sources:+      benchmarks/fixtures/bench.cpp+  build-depends:+      array <=1.0+    , base >=4.12 && <5+    , bytestring+    , containers >=0.6.2.1 && <1+    , criterion+    , deepseq >=1.4.4 && <2+    , directory >=1.3.3 && <2+    , filepath >=1.4.2 && <2+    , mtl >=2.0 && <3+    , process >=1.6 && <2+    , souffle-haskell+    , template-haskell >=2 && <3+    , temporary >=1.3 && <2+    , text >=1.0 && <2+    , text-short >=0.1.3 && <1     , type-errors-pretty >=0.0.1.0 && <1     , vector <=1.0   if os(darwin)
tests/Test/Language/Souffle/CompiledSpec.hs view
@@ -54,6 +54,27 @@       isJust prog `shouldBe` True    describe "getFacts" $ parallel $ do+    it "doesn't crash if used as last action (lists)" $ do+      edges <- Souffle.runSouffle Path $ \handle -> do+        let prog = fromJust handle+        Souffle.run prog+        Souffle.getFacts prog+      edges `shouldBe` [Edge "b" "c", Edge "a" "b"]++    it "doesn't crash if used as last action (vectors)" $ do+      edges <- Souffle.runSouffle Path $ \handle -> do+        let prog = fromJust handle+        Souffle.run prog+        Souffle.getFacts prog+      edges `shouldBe` V.fromList [Edge "a" "b", Edge "b" "c"]++    it "doesn't crash if used as last action (arrays)" $ do+      edges <- Souffle.runSouffle Path $ \handle -> do+        let prog = fromJust handle+        Souffle.run prog+        Souffle.getFacts prog+      edges `shouldBe` A.listArray (0 :: Int, 1) [Edge "a" "b", Edge "b" "c"]+     it "can retrieve facts as a list" $ do       (edges, reachables) <- Souffle.runSouffle Path $ \handle -> do         let prog = fromJust handle@@ -170,6 +191,19 @@         pure (e, r)       edge `shouldBe` Just (Edge "a" "b")       reachable `shouldBe` Just (Reachable "a" "c")++    it "can handle unicode characters" $ do+      let fact = Edge "∀∀" "bla"+          fact2 = Edge "∃∃" "bla"+          fact3 = Edge "℀℀" "bla"+      results <- Souffle.runSouffle Path $ \handle -> do+        let prog = fromJust handle+        Souffle.addFact prog fact+        Souffle.run prog+        (,,) <$> Souffle.findFact prog fact+             <*> Souffle.findFact prog fact2+             <*> Souffle.findFact prog fact3+      results `shouldBe` (Just fact, Nothing, Nothing)    -- TODO writeFiles / loadFiles 
− tests/Test/Language/Souffle/Experimental/Fixtures.hs
@@ -1,31 +0,0 @@--{-# LANGUAGE DataKinds, TypeFamilies, DeriveGeneric, DeriveAnyClass #-}--module Test.Language.Souffle.Experimental.Fixtures-  ( module Test.Language.Souffle.Experimental.Fixtures-  ) where--import GHC.Generics-import Language.Souffle.Class-import Language.Souffle.Experimental--data CompiledProgram = CompiledProgram--instance Program CompiledProgram where-  type ProgramFacts CompiledProgram = [Edge, Reachable]-  programName = const "compiledprogram"--data Edge = Edge String String-  deriving (Generic, Marshal, FactMetadata)--data Reachable = Reachable String String-  deriving (Eq, Show, Generic, Marshal, FactMetadata)--instance Fact Edge where-  type FactDirection Edge = 'Input-  factName = const "edge"--instance Fact Reachable where-  type FactDirection Reachable = 'Output-  factName = const "reachable"-
− tests/Test/Language/Souffle/Experimental/FixturesCompiled.hs
@@ -1,22 +0,0 @@--{-# OPTIONS_GHC -optc-std=c++17 -D__EMBEDDED_SOUFFLE__ #-}-{-# LANGUAGE TypeApplications, TemplateHaskell #-}-module Test.Language.Souffle.Experimental.FixturesCompiled () where---- NOTE: this module can't be grouped together with "Fixtures"--- due to TemplateHaskell staging restriction.--import Test.Language.Souffle.Experimental.Fixtures-import Language.Souffle.Experimental--$(embedProgram CompiledProgram $ do-  Predicate edge <- predicateFor @Edge-  Predicate reachable <- predicateFor @Reachable-  a <- var "a"-  b <- var "b"-  c <- var "c"-  reachable(a, b) |- edge(a, b)-  reachable(a, b) |- do-    edge(a, c)-    reachable(c, b)- )
− tests/Test/Language/Souffle/ExperimentalSpec.hs
@@ -1,1117 +0,0 @@--{-# LANGUAGE DeriveGeneric, DeriveAnyClass, TypeApplications, QuasiQuotes, TypeOperators #-}-{-# LANGUAGE DataKinds, TypeFamilies #-}--module Test.Language.Souffle.ExperimentalSpec-  ( module Test.Language.Souffle.ExperimentalSpec-  ) where--import qualified Test.Language.Souffle.Experimental.Fixtures as F-import Test.Hspec-import GHC.Generics-import Data.Int-import Data.Word-import Data.Maybe (fromJust)-import qualified Data.Text as T-import qualified Data.Text.Lazy as TL-import System.IO.Temp-import Language.Souffle.Experimental-import Language.Souffle.Class-import Language.Souffle.Interpreted as I-import Language.Souffle.Compiled as C-import NeatInterpolation---data Point = Point { x :: Int32, y :: Int32 }-  deriving (Generic, Marshal, FactMetadata)--newtype IntFact = IntFact Int32-  deriving (Generic, Marshal, FactMetadata)--newtype UnsignedFact = UnsignedFact Word32-  deriving (Generic, Marshal, FactMetadata)--newtype FloatFact = FloatFact Float-  deriving (Generic, Marshal, FactMetadata)--data TextFact = TextFact T.Text TL.Text-  deriving (Generic, Marshal, FactMetadata)--data Triple = Triple String Int32 String-  deriving (Generic, Marshal, FactMetadata)--newtype Vertex = Vertex String-  deriving (Generic, Marshal, FactMetadata)--data Edge = Edge String String-  deriving (Generic, Marshal, FactMetadata)--data Reachable = Reachable String String-  deriving (Eq, Show, Generic, Marshal, FactMetadata)--newtype BTreeFact = BTreeFact Int32-  deriving (Generic, Marshal)--newtype BrieFact = BrieFact Int32-  deriving (Generic, Marshal)--data EqRelFact = EqRelFact Int32 Int32-  deriving (Generic, Marshal)--data DSLProgram = DSLProgram--instance Program DSLProgram where-  type ProgramFacts DSLProgram =-    [ Point-    , IntFact-    , FloatFact-    , UnsignedFact-    , TextFact-    , BTreeFact-    , BrieFact-    , EqRelFact-    , Triple-    , Vertex-    , Edge-    , Reachable-    ]-  programName = const "dslprogram"--instance Fact Point where-  type FactDirection Point = 'Input-  factName = const "point"-instance Fact IntFact where-  type FactDirection IntFact = 'Input-  factName = const "intfact"-instance Fact FloatFact where-  type FactDirection FloatFact = 'Input-  factName = const "floatfact"-instance Fact UnsignedFact where-  type FactDirection UnsignedFact = 'Input-  factName = const "unsignedfact"-instance Fact TextFact where-  type FactDirection TextFact = 'InputOutput-  factName = const "textfact"-instance Fact Triple where-  type FactDirection Triple = 'Internal-  factName = const "triple"-instance Fact Vertex where-  type FactDirection Vertex = 'Output-  factName = const "vertex"-instance Fact Edge where-  type FactDirection Edge = 'Input-  factName = const "edge"-instance Fact Reachable where-  type FactDirection Reachable = 'Output-  factName = const "reachable"-instance Fact BTreeFact where-  type FactDirection BTreeFact = 'Internal-  factName = const "btreefact"-instance Fact BrieFact where-  type FactDirection BrieFact = 'Internal-  factName = const "briefact"-instance Fact EqRelFact where-  type FactDirection EqRelFact = 'Input-  factName = const "eqrelfact"-instance FactMetadata BTreeFact where-  factOpts = const $ Metadata BTree NoInline-instance FactMetadata BrieFact where-  factOpts = const $ Metadata Brie Inline-instance FactMetadata EqRelFact where-  factOpts = const $ Metadata EqRel NoInline--spec :: Spec-spec = describe "Souffle DSL" $ parallel $ do-  describe "code generation" $ parallel $ do-    let prog ==> txt =-          let rendered = T.strip $ render DSLProgram prog-              expected = T.strip txt-          in rendered `shouldBe` expected--    it "can render an empty program" $-      render DSLProgram (pure ()) `shouldBe` ""--    it "can render a program with an input type definition" $ do-      let prog = do-            Predicate _ <- predicateFor @Edge-            pure ()-      prog ==> [text|-        .decl edge(t1: symbol, t2: symbol)-        .input edge-        |]--    it "can render a program with an output type definition" $ do-      let prog = do-            Predicate _ <- predicateFor @Reachable-            pure ()-      prog ==> [text|-        .decl reachable(t1: symbol, t2: symbol)-        .output reachable-        |]--    it "can render a program with type declared both as in- and output" $ do-      let prog = do-            Predicate _ <- predicateFor @TextFact-            pure ()-      prog ==> [text|-        .decl textfact(t1: symbol, t2: symbol)-        .input textfact-        .output textfact-        |]--    it "can render a program with type declared and only used internally" $ do-      let prog = do-            Predicate _ <- predicateFor @Triple-            pure ()-      prog ==> [text|-        .decl triple(t1: symbol, t2: number, t3: symbol)-        |]--    it "renders type declaration based on type info" $ do-      let prog = do-            Predicate _ <- predicateFor @IntFact-            Predicate _ <- predicateFor @UnsignedFact-            Predicate _ <- predicateFor @FloatFact-            Predicate _ <- predicateFor @Triple-            Predicate _ <- predicateFor @BTreeFact-            Predicate _ <- predicateFor @BrieFact-            Predicate _ <- predicateFor @EqRelFact-            pure ()-      prog ==> [text|-        .decl intfact(t1: number)-        .input intfact-        .decl unsignedfact(t1: unsigned)-        .input unsignedfact-        .decl floatfact(t1: float)-        .input floatfact-        .decl triple(t1: symbol, t2: number, t3: symbol)-        .decl btreefact(t1: number) btree-        .decl briefact(t1: number) brie inline-        .decl eqrelfact(t1: number, t2: number) eqrel-        .input eqrelfact-        |]--    it "uses record accessors as attribute names in type declaration if provided" $ do-      let prog = do-            Predicate _ <- predicateFor @Point-            pure ()-      prog ==> [text|-        .decl point(x: number, y: number)-        .input point-        |]--    it "can render facts" $ do-      let prog = do-            Predicate edge <- predicateFor @Edge-            Predicate triple <- predicateFor @Triple-            Predicate txt <- predicateFor @TextFact-            Predicate unsigned <- predicateFor @UnsignedFact-            Predicate float <- predicateFor @FloatFact-            edge("a", "b")-            triple("cde", 1000, "fgh")-            txt("ijk", "lmn")-            unsigned(42)-            float(42.42)-            float(0.01)-      prog ==> [text|-        .decl edge(t1: symbol, t2: symbol)-        .input edge-        .decl triple(t1: symbol, t2: number, t3: symbol)-        .decl textfact(t1: symbol, t2: symbol)-        .input textfact-        .output textfact-        .decl unsignedfact(t1: unsigned)-        .input unsignedfact-        .decl floatfact(t1: float)-        .input floatfact-        edge("a", "b").-        triple("cde", 1000, "fgh").-        textfact("ijk", "lmn").-        unsignedfact(42).-        floatfact(42.42).-        floatfact(0.01).-        |]--    it "can render a relation with a single rule" $ do-      let prog = do-            Predicate edge <- predicateFor @Edge-            Predicate reachable <- predicateFor @Reachable-            a <- var "a"-            b <- var "b"-            reachable(a, b) |- edge(a, b)-      prog ==> [text|-        .decl edge(t1: symbol, t2: symbol)-        .input edge-        .decl reachable(t1: symbol, t2: symbol)-        .output reachable-        reachable(a, b) :--          edge(a, b).-        |]--    it "can render a relation with multiple rules" $ do-      let prog = do-            Predicate edge <- predicateFor @Edge-            Predicate reachable <- predicateFor @Reachable-            a <- var "a"-            b <- var "b"-            reachable(a, b) |- do-              edge(a, a)-              edge(b, b)-              edge(a, b)-      prog ==> [text|-        .decl edge(t1: symbol, t2: symbol)-        .input edge-        .decl reachable(t1: symbol, t2: symbol)-        .output reachable-        reachable(a, b) :--          edge(a, a),-          edge(b, b),-          edge(a, b).-        |]--    it "can render a relation containing a wildcard" $ do-      let prog = do-            Predicate edge <- predicateFor @Edge-            Predicate vertex <- predicateFor @Vertex-            a <- var "a"-            vertex(a) |- do-              edge(a, __)-              edge(__, a)-      prog ==> [text|-        .decl edge(t1: symbol, t2: symbol)-        .input edge-        .decl vertex(t1: symbol)-        .output vertex-        vertex(a) :--          edge(a, _),-          edge(_, a).-        |]--    it "can render a relation with a logical or in the rule block" $ do-      let prog = do-            Predicate edge <- predicateFor @Edge-            Predicate reachable <- predicateFor @Reachable-            a <- var "a"-            b <- var "b"-            reachable(a, b) |- do-              let rules1 = do-                    edge(a, a)-                    edge(b, b)-                  rules2 = do-                    edge(a, b)-                    edge(b, a)-              rules1 \/ rules2-      prog ==> [text|-        .decl edge(t1: symbol, t2: symbol)-        .input edge-        .decl reachable(t1: symbol, t2: symbol)-        .output reachable-        reachable(a, b) :--          edge(a, a),-          edge(b, b);-          edge(a, b),-          edge(b, a).-        |]--    it "can render a relation with multiple clauses" $ do-      let prog = do-            Predicate edge <- predicateFor @Edge-            Predicate reachable <- predicateFor @Reachable-            a <- var "a"-            b <- var "b"-            c <- var "c"-            reachable(a, b) |- edge(a, b)-            reachable(a, b) |- do-              edge(a, c)-              reachable(c, b)-      prog ==> [text|-        .decl edge(t1: symbol, t2: symbol)-        .input edge-        .decl reachable(t1: symbol, t2: symbol)-        .output reachable-        reachable(a, b) :--          edge(a, b).-        reachable(a, b) :--          edge(a, c),-          reachable(c, b).-        |]--    it "can render a mix of and- and or- clauses correctly" $ do-      let prog = do-            Predicate edge <- predicateFor @Edge-            Predicate reachable <- predicateFor @Reachable-            a <- var "a"-            b <- var "b"-            c <- var "c"-            reachable(a, b) |- do-              edge(a, c) \/ edge(a, b)-              reachable(c, b)-      prog ==> [text|-        .decl edge(t1: symbol, t2: symbol)-        .input edge-        .decl reachable(t1: symbol, t2: symbol)-        .output reachable-        reachable(a, b) :--          (edge(a, c);-          edge(a, b)),-          reachable(c, b).-        |]--    it "discards empty alternative blocks" $ do-      let prog = do-            Predicate edge <- predicateFor @Edge-            Predicate reachable <- predicateFor @Reachable-            a <- var "a"-            b <- var "b"-            c <- var "c"-            reachable(a, b) |- do-              pure () \/ edge(a, c)-              reachable(c, b)-            reachable(a, b) |- do-              edge(a,c) \/ pure ()-              reachable(c, b)-            reachable(a, b) |- do-              pure () \/ do-                edge(a, c)-                reachable(c, b)-      prog ==> [text|-        .decl edge(t1: symbol, t2: symbol)-        .input edge-        .decl reachable(t1: symbol, t2: symbol)-        .output reachable-        reachable(a, b) :--          edge(a, c),-          reachable(c, b).-        reachable(a, b) :--          edge(a, c),-          reachable(c, b).-        reachable(a, b) :--          edge(a, c),-          reachable(c, b).-        |]--    it "discards rules with empty rule blocks completely" $ do-      let prog = do-            Predicate reachable <- predicateFor @Reachable-            a <- var "a"-            b <- var "b"-            reachable(a, b) |--              pure ()-            reachable(a, b) |- do-              pure () \/ pure ()-              pure ()-      prog ==> [text|-        .decl reachable(t1: symbol, t2: symbol)-        .output reachable-        |]--    it "discards empty negations" $ do-      let prog = do-            Predicate reachable <- predicateFor @Reachable-            a <- var "a"-            b <- var "b"-            reachable(a, b) |- do-              not' $ pure ()-      prog ==> [text|-        .decl reachable(t1: symbol, t2: symbol)-        .output reachable-        |]--    it "allows generically describing predicate relations" $ do-      -- NOTE: type signature not required, but it results in more clear type errors-      -- and can serve as documentation.-      let transitive :: forall prog p1 p2 t. Structure p1 ~ Structure p2-                      => Structure p1 ~ '[t, t]-                      => Predicate p1 -> Predicate p2 -> DSL prog 'Definition ()-          transitive (Predicate p1) (Predicate p2) = do-            a <- var "a"-            b <- var "b"-            c <- var "c"-            p1(a, b) |- p2(a, b)-            p1(a, b) |- do-              p2(a, c)-              p1(c, b)-          prog = do-            edge <- predicateFor @Edge-            reachable <- predicateFor @Reachable-            transitive reachable edge-      prog ==> [text|-        .decl edge(t1: symbol, t2: symbol)-        .input edge-        .decl reachable(t1: symbol, t2: symbol)-        .output reachable-        reachable(a, b) :--          edge(a, b).-        reachable(a, b) :--          edge(a, c),-          reachable(c, b).-        |]--    it "can render logical negation in rule block" $ do-      let prog = do-            Predicate edge <- predicateFor @Edge-            Predicate triple <- predicateFor @Triple-            a <- var "a"-            b <- var "b"-            c <- var "c"-            triple(a, b, c) |- do-              not' $ edge(a,c)-            triple(a, b, c) |- do-              not' $ do-                edge(a,a)-                edge(c,c)-            triple(a, b, c) |- do-              not' $ edge(a,a) \/ edge(c,c)-            triple(a, b, c) |- do-              not' $ not' $ edge(a,a)-      prog ==> [text|-        .decl edge(t1: symbol, t2: symbol)-        .input edge-        .decl triple(t1: symbol, t2: number, t3: symbol)-        triple(a, b, c) :--          !edge(a, c).-        triple(a, b, c) :--          !(edge(a, a),-          edge(c, c)).-        triple(a, b, c) :--          !(edge(a, a);-          edge(c, c)).-        triple(a, b, c) :--          !!edge(a, a).-        |]--    it "generates unique var names to avoid name collisions" $ do-      let prog = do-            Predicate edge <- predicateFor @Edge-            Predicate reachable <- predicateFor @Reachable-            a <- var "a"-            a' <- var "a"-            reachable(a, a') |- edge(a, a')-      prog ==> [text|-        .decl edge(t1: symbol, t2: symbol)-        .input edge-        .decl reachable(t1: symbol, t2: symbol)-        .output reachable-        reachable(a, a_1) :--          edge(a, a_1).-        |]--    describe "operators" $ parallel $ do-      -- TODO: check for number, unsigned, float; check underscore is not allowed-      describe "arithmetic" $ parallel $ do-        it "supports +" $ do-          let prog = do-                Predicate int <- predicateFor @IntFact-                Predicate unsigned <- predicateFor @UnsignedFact-                Predicate float <- predicateFor @FloatFact-                int(10 + 32)-                int(10 + 80 + 10)-                unsigned(10 + 32)-                float(10.12 + 31.88)-          prog ==> [text|-            .decl intfact(t1: number)-            .input intfact-            .decl unsignedfact(t1: unsigned)-            .input unsignedfact-            .decl floatfact(t1: float)-            .input floatfact-            intfact(10 + 32).-            intfact(10 + 80 + 10).-            unsignedfact(10 + 32).-            floatfact(10.12 + 31.88).-            |]--        it "supports *" $ do-          let prog = do-                Predicate int <- predicateFor @IntFact-                Predicate unsigned <- predicateFor @UnsignedFact-                Predicate float <- predicateFor @FloatFact-                int(10 * 32)-                int(10 * 80 * 10)-                unsigned(10 * 32)-                float(10.12 * 31.88)-          prog ==> [text|-            .decl intfact(t1: number)-            .input intfact-            .decl unsignedfact(t1: unsigned)-            .input unsignedfact-            .decl floatfact(t1: float)-            .input floatfact-            intfact(10 * 32).-            intfact(10 * 80 * 10).-            unsignedfact(10 * 32).-            floatfact(10.12 * 31.88).-            |]--        it "supports binary -" $ do-          let prog = do-                Predicate int <- predicateFor @IntFact-                Predicate unsigned <- predicateFor @UnsignedFact-                Predicate float <- predicateFor @FloatFact-                int(10 - 32)-                int(10 - 80 - 10)-                unsigned(10 - 32)-                float(10.12 - 31.88)-          prog ==> [text|-            .decl intfact(t1: number)-            .input intfact-            .decl unsignedfact(t1: unsigned)-            .input unsignedfact-            .decl floatfact(t1: float)-            .input floatfact-            intfact(10 - 32).-            intfact(10 - 80 - 10).-            unsignedfact(10 - 32).-            floatfact(10.12 - 31.88).-            |]--        it "supports unary -" $ do-          let prog = do-                Predicate int <- predicateFor @IntFact-                Predicate float <- predicateFor @FloatFact-                int(-42)-                int(-100)-                float(-13.37)-          prog ==> [text|-            .decl intfact(t1: number)-            .input intfact-            .decl floatfact(t1: float)-            .input floatfact-            intfact(-42).-            intfact(-100).-            floatfact(-13.37).-            |]--        it "supports /" $ do-          let prog = do-                Predicate float <- predicateFor @FloatFact-                float(13.37 / 0.01)-          prog ==> [text|-            .decl floatfact(t1: float)-            .input floatfact-            floatfact(13.37 / 0.01).-            |]--        it "supports ^" $ do-          let prog = do-                Predicate int <- predicateFor @IntFact-                Predicate unsigned <- predicateFor @UnsignedFact-                Predicate float <- predicateFor @FloatFact-                int(10 .^ 32)-                int(10 .^ 80 .^ 10)-                unsigned(10 .^ 32)-                float(42.42 .^ 2)-          prog ==> [text|-            .decl intfact(t1: number)-            .input intfact-            .decl unsignedfact(t1: unsigned)-            .input unsignedfact-            .decl floatfact(t1: float)-            .input floatfact-            intfact(10 ^ 32).-            intfact(10 ^ 80 ^ 10).-            unsignedfact(10 ^ 32).-            floatfact(42.42 ^ 2.0).-            |]--        it "supports %" $ do-          let prog = do-                Predicate int <- predicateFor @IntFact-                Predicate unsigned <- predicateFor @UnsignedFact-                int(10 .% 32)-                int(10 .% 80 .% 10)-                unsigned(10 .% 32)-          prog ==> [text|-            .decl intfact(t1: number)-            .input intfact-            .decl unsignedfact(t1: unsigned)-            .input unsignedfact-            intfact(10 % 32).-            intfact(10 % 80 % 10).-            unsignedfact(10 % 32).-            |]--      describe "logical operators" $ parallel $ do-        it "supports band" $ do-          let prog = do-                Predicate int <- predicateFor @IntFact-                Predicate unsigned <- predicateFor @UnsignedFact-                int(10 `band` 32)-                int(10 `band` 80 `band` 10)-                unsigned(10 `band` 32)-          prog ==> [text|-            .decl intfact(t1: number)-            .input intfact-            .decl unsignedfact(t1: unsigned)-            .input unsignedfact-            intfact(10 band 32).-            intfact(10 band 80 band 10).-            unsignedfact(10 band 32).-            |]--        it "supports bor" $ do-          let prog = do-                Predicate int <- predicateFor @IntFact-                Predicate unsigned <- predicateFor @UnsignedFact-                int(10 `bor` 32)-                int(10 `bor` 80 `bor` 10)-                unsigned(10 `bor` 32)-          prog ==> [text|-            .decl intfact(t1: number)-            .input intfact-            .decl unsignedfact(t1: unsigned)-            .input unsignedfact-            intfact(10 bor 32).-            intfact(10 bor 80 bor 10).-            unsignedfact(10 bor 32).-            |]--        it "supports bxor" $ do-          let prog = do-                Predicate int <- predicateFor @IntFact-                Predicate unsigned <- predicateFor @UnsignedFact-                int(10 `bxor` 32)-                int(10 `bxor` 80 `bxor` 10)-                unsigned(10 `bxor` 32)-          prog ==> [text|-            .decl intfact(t1: number)-            .input intfact-            .decl unsignedfact(t1: unsigned)-            .input unsignedfact-            intfact(10 bxor 32).-            intfact(10 bxor 80 bxor 10).-            unsignedfact(10 bxor 32).-            |]--        it "supports land" $ do-          let prog = do-                Predicate int <- predicateFor @IntFact-                Predicate unsigned <- predicateFor @UnsignedFact-                int(10 `land` 32)-                int(10 `land` 80 `land` 10)-                unsigned(10 `land` 32)-          prog ==> [text|-            .decl intfact(t1: number)-            .input intfact-            .decl unsignedfact(t1: unsigned)-            .input unsignedfact-            intfact(10 land 32).-            intfact(10 land 80 land 10).-            unsignedfact(10 land 32).-            |]--        it "supports lor" $ do-          let prog = do-                Predicate int <- predicateFor @IntFact-                Predicate unsigned <- predicateFor @UnsignedFact-                int(10 `lor` 32)-                int(10 `lor` 80 `lor` 10)-                unsigned(10 `lor` 32)-          prog ==> [text|-            .decl intfact(t1: number)-            .input intfact-            .decl unsignedfact(t1: unsigned)-            .input unsignedfact-            intfact(10 lor 32).-            intfact(10 lor 80 lor 10).-            unsignedfact(10 lor 32).-            |]--      describe "comparisons and equality, inequality" $ parallel $ do-        -- NOTE: the following generated programs are not correct-        -- since vars are not grounded (but is done to keep tests succinct)-        it "supports <" $ do-          let prog = do-                Predicate int <- predicateFor @IntFact-                Predicate unsigned <- predicateFor @UnsignedFact-                Predicate float <- predicateFor @FloatFact-                a <- var "a"-                b <- var "b"-                c <- var "c"-                int(a) |- a .< 10-                unsigned(b) |- b .< 10-                float(c) |- c .< 10.1-          prog ==> [text|-            .decl intfact(t1: number)-            .input intfact-            .decl unsignedfact(t1: unsigned)-            .input unsignedfact-            .decl floatfact(t1: float)-            .input floatfact-            intfact(a) :--              a < 10.-            unsignedfact(b) :--              b < 10.-            floatfact(c) :--              c < 10.1.-            |]--        it "supports <=" $ do-          let prog = do-                Predicate int <- predicateFor @IntFact-                Predicate unsigned <- predicateFor @UnsignedFact-                Predicate float <- predicateFor @FloatFact-                a <- var "a"-                b <- var "b"-                c <- var "c"-                int(a) |- a .<= 10-                unsigned(b) |- b .<= 10-                float(c) |- c .<= 10.1-          prog ==> [text|-            .decl intfact(t1: number)-            .input intfact-            .decl unsignedfact(t1: unsigned)-            .input unsignedfact-            .decl floatfact(t1: float)-            .input floatfact-            intfact(a) :--              a <= 10.-            unsignedfact(b) :--              b <= 10.-            floatfact(c) :--              c <= 10.1.-            |]--        it "supports >" $ do-          let prog = do-                Predicate int <- predicateFor @IntFact-                Predicate unsigned <- predicateFor @UnsignedFact-                Predicate float <- predicateFor @FloatFact-                a <- var "a"-                b <- var "b"-                c <- var "c"-                int(a) |- a .> 10-                unsigned(b) |- b .> 10-                float(c) |- c .> 10.1-          prog ==> [text|-            .decl intfact(t1: number)-            .input intfact-            .decl unsignedfact(t1: unsigned)-            .input unsignedfact-            .decl floatfact(t1: float)-            .input floatfact-            intfact(a) :--              a > 10.-            unsignedfact(b) :--              b > 10.-            floatfact(c) :--              c > 10.1.-            |]--        it "supports >=" $ do-          let prog = do-                Predicate int <- predicateFor @IntFact-                Predicate unsigned <- predicateFor @UnsignedFact-                Predicate float <- predicateFor @FloatFact-                a <- var "a"-                b <- var "b"-                c <- var "c"-                int(a) |- a .>= 10-                unsigned(b) |- b .>= 10-                float(c) |- c .>= 10.1-          prog ==> [text|-            .decl intfact(t1: number)-            .input intfact-            .decl unsignedfact(t1: unsigned)-            .input unsignedfact-            .decl floatfact(t1: float)-            .input floatfact-            intfact(a) :--              a >= 10.-            unsignedfact(b) :--              b >= 10.-            floatfact(c) :--              c >= 10.1.-            |]--        it "supports =" $ do-          let prog = do-                Predicate int <- predicateFor @IntFact-                Predicate unsigned <- predicateFor @UnsignedFact-                Predicate float <- predicateFor @FloatFact-                Predicate vertex <- predicateFor @Vertex-                a <- var "a"-                b <- var "b"-                c <- var "c"-                d <- var "d"-                int(a) |- a .= 10-                unsigned(b) |- b .= 10-                float(c) |- c .= 10.1-                vertex(d) |- d .= "abc"-          prog ==> [text|-            .decl intfact(t1: number)-            .input intfact-            .decl unsignedfact(t1: unsigned)-            .input unsignedfact-            .decl floatfact(t1: float)-            .input floatfact-            .decl vertex(t1: symbol)-            .output vertex-            intfact(a) :--              a = 10.-            unsignedfact(b) :--              b = 10.-            floatfact(c) :--              c = 10.1.-            vertex(d) :--              d = "abc".-            |]--        it "supports !=" $ do-          let prog = do-                Predicate int <- predicateFor @IntFact-                Predicate unsigned <- predicateFor @UnsignedFact-                Predicate float <- predicateFor @FloatFact-                Predicate vertex <- predicateFor @Vertex-                a <- var "a"-                b <- var "b"-                c <- var "c"-                d <- var "d"-                int(a) |- a .!= 10-                unsigned(b) |- b .!= 10-                float(c) |- c .!= 10.1-                vertex(d) |- d .!= "abc"-          prog ==> [text|-            .decl intfact(t1: number)-            .input intfact-            .decl unsignedfact(t1: unsigned)-            .input unsignedfact-            .decl floatfact(t1: float)-            .input floatfact-            .decl vertex(t1: symbol)-            .output vertex-            intfact(a) :--              a != 10.-            unsignedfact(b) :--              b != 10.-            floatfact(c) :--              c != 10.1.-            vertex(d) :--              d != "abc".-            |]--    describe "functors" $ parallel $ do-      it "supports max" $ do-        let prog = do-              Predicate int <- predicateFor @IntFact-              Predicate unsigned <- predicateFor @UnsignedFact-              Predicate float <- predicateFor @FloatFact-              int(max' 10 32)-              int(max' (max' 10 80) 10)-              unsigned(max' 10 32)-              float(max' 42.42 2)-        prog ==> [text|-          .decl intfact(t1: number)-          .input intfact-          .decl unsignedfact(t1: unsigned)-          .input unsignedfact-          .decl floatfact(t1: float)-          .input floatfact-          intfact(max(10, 32)).-          intfact(max(max(10, 80), 10)).-          unsignedfact(max(10, 32)).-          floatfact(max(42.42, 2.0)).-          |]--      it "supports min" $ do-        let prog = do-              Predicate int <- predicateFor @IntFact-              Predicate unsigned <- predicateFor @UnsignedFact-              Predicate float <- predicateFor @FloatFact-              int(min' 10 32)-              int(min' (min' 10 80) 10)-              unsigned(min' 10 32)-              float(min' 42.42 2)-        prog ==> [text|-          .decl intfact(t1: number)-          .input intfact-          .decl unsignedfact(t1: unsigned)-          .input unsignedfact-          .decl floatfact(t1: float)-          .input floatfact-          intfact(min(10, 32)).-          intfact(min(min(10, 80), 10)).-          unsignedfact(min(10, 32)).-          floatfact(min(42.42, 2.0)).-          |]--      it "supports cat" $ do-        let prog = do-              Predicate vertex <- predicateFor @Vertex-              vertex(cat "abc" "def")-              vertex(cat "abc" $ cat "def" "ghi")-        prog ==> [text|-          .decl vertex(t1: symbol)-          .output vertex-          vertex(cat("abc", "def")).-          vertex(cat("abc", cat("def", "ghi"))).-          |]--      it "supports contains" $ do-        let prog = do-              Predicate vertex <- predicateFor @Vertex-              Predicate int <- predicateFor @IntFact-              a <- var "a"-              b <- var "b"-              int(0) |- do-                vertex(a)-                vertex(b)-                contains a b-        prog ==> [text|-          .decl vertex(t1: symbol)-          .output vertex-          .decl intfact(t1: number)-          .input intfact-          intfact(0) :--            vertex(a),-            vertex(b),-            contains(a, b).-          |]--      it "supports match" $ do-        let prog = do-              Predicate vertex <- predicateFor @Vertex-              Predicate int <- predicateFor @IntFact-              a <- var "a"-              int(0) |- do-                vertex(a)-                match "*.a" a-        prog ==> [text|-          .decl vertex(t1: symbol)-          .output vertex-          .decl intfact(t1: number)-          .input intfact-          intfact(0) :--            vertex(a),-            match("*.a", a).-          |]--      it "supports ord" $ do-        let prog = do-              Predicate vertex <- predicateFor @Vertex-              Predicate int <- predicateFor @IntFact-              a <- var "a"-              int(ord a) |--                vertex(a)-        prog ==> [text|-          .decl vertex(t1: symbol)-          .output vertex-          .decl intfact(t1: number)-          .input intfact-          intfact(ord(a)) :--            vertex(a).-          |]--      it "supports strlen" $ do-        let prog = do-              Predicate vertex <- predicateFor @Vertex-              Predicate int <- predicateFor @IntFact-              a <- var "a"-              int(strlen a) |--                vertex(a)-        prog ==> [text|-          .decl vertex(t1: symbol)-          .output vertex-          .decl intfact(t1: number)-          .input intfact-          intfact(strlen(a)) :--            vertex(a).-          |]--      it "supports substr" $ do-        let prog = do-              Predicate vertex <- predicateFor @Vertex-              a <- var "a"-              vertex(a) |--                a .= substr "Hello" 1 3-        prog ==> [text|-          .decl vertex(t1: symbol)-          .output vertex-          vertex(a) :--            a = substr("Hello", 1, 3).-          |]---      it "supports to_number" $ do-        let prog = do-              Predicate vertex <- predicateFor @Vertex-              Predicate int <- predicateFor @IntFact-              a <- var "a"-              int(to_number a) |--                vertex(a)-        prog ==> [text|-          .decl vertex(t1: symbol)-          .output vertex-          .decl intfact(t1: number)-          .input intfact-          intfact(to_number(a)) :--            vertex(a).-          |]--      it "supports to_string" $ do-        let prog = do-              Predicate vertex <- predicateFor @Vertex-              Predicate int <- predicateFor @IntFact-              a <- var "a"-              vertex(to_string a) |--                int(a)-        prog ==> [text|-          .decl vertex(t1: symbol)-          .output vertex-          .decl intfact(t1: number)-          .input intfact-          vertex(to_string(a)) :--            intfact(a).-          |]--  describe "running DSL code directly " $ parallel $ do-    it "can run DSL with default config in interpreted mode" $ do-      let ast = do-            Predicate edge <- predicateFor @Edge-            Predicate reachable <- predicateFor @Reachable-            a <- var "a"-            b <- var "b"-            c <- var "c"-            reachable(a, b) |- edge(a, b)-            reachable(a, b) |- do-              edge(a, c)-              reachable(c, b)-          action handle = do-            let prog = fromJust handle-            I.addFacts prog [Edge "a" "b", Edge "b" "c"]-            I.run prog-            I.getFacts prog-      rs <- runSouffleInterpreted DSLProgram ast action-      rs `shouldBe` [Reachable "a" "b", Reachable "a" "c", Reachable "b" "c"]--    it "can run DSL with modified config in interpreted mode" $ do-      tmpDir <- getCanonicalTemporaryDirectory-      souffleHsDir <- createTempDirectory tmpDir "souffle-haskell"-      cfg <- I.defaultConfig-      let config = cfg { I.cfgDatalogDir = souffleHsDir }-          ast = do-            Predicate edge <- predicateFor @Edge-            Predicate reachable <- predicateFor @Reachable-            a <- var "a"-            b <- var "b"-            c <- var "c"-            reachable(a, b) |- edge(a, b)-            reachable(a, b) |- do-              edge(a, c)-              reachable(c, b)-          action handle = do-            let prog = fromJust handle-            I.addFacts prog [Edge "a" "b", Edge "b" "c"]-            I.run prog-            I.getFacts prog-      rs <- runSouffleInterpretedWith config DSLProgram ast action-      rs `shouldBe` [Reachable "a" "b", Reachable "a" "c", Reachable "b" "c"]--    it "can run DSL in compiled mode" $ do-      rs <- C.runSouffle F.CompiledProgram $ \handle -> do-        let prog = fromJust handle-        C.addFacts prog [F.Edge "a" "b", F.Edge "b" "c"]-        C.run prog-        C.getFacts prog-      rs `shouldBe` [F.Reachable "b" "c", F.Reachable "a" "c", F.Reachable "a" "b"]-
tests/Test/Language/Souffle/MarshalSpec.hs view
@@ -1,6 +1,6 @@  {-# LANGUAGE DeriveGeneric, TypeFamilies, DataKinds, RankNTypes #-}-+{-# LANGUAGE FlexibleInstances, FlexibleContexts #-} module Test.Language.Souffle.MarshalSpec   ( module Test.Language.Souffle.MarshalSpec   ) where@@ -12,16 +12,20 @@ import GHC.Generics import qualified Data.Text as T import qualified Data.Text.Lazy as TL+import qualified Data.Text.Short as TS import Data.Text import Data.Int import Data.Word import Data.Maybe ( fromJust ) import Control.Monad.IO.Class ( liftIO )+import Control.Monad import Language.Souffle.Marshal import qualified Language.Souffle.Marshal as Souffle import qualified Language.Souffle.Class as Souffle import qualified Language.Souffle.Compiled as Compiled import qualified Language.Souffle.Interpreted as Interpreted+import Data.String (IsString)+import Data.Void (Void)   data Edge = Edge String String@@ -90,6 +94,9 @@ newtype LazyTextFact = LazyTextFact TL.Text   deriving (Eq, Show, Generic) +newtype ShortTextFact = ShortTextFact TS.ShortText+  deriving (Eq, Show, Generic)+ newtype Int32Fact = Int32Fact Int32   deriving (Eq, Show, Generic) @@ -111,6 +118,10 @@   type FactDirection LazyTextFact = 'Souffle.InputOutput   factName = const "string_fact" +instance Souffle.Fact ShortTextFact where+  type FactDirection ShortTextFact = 'Souffle.InputOutput+  factName = const "string_fact"+ instance Souffle.Fact Int32Fact where   type FactDirection Int32Fact = 'Souffle.InputOutput   factName = const "number_fact"@@ -126,21 +137,96 @@ instance Souffle.Marshal StringFact instance Souffle.Marshal TextFact instance Souffle.Marshal LazyTextFact+instance Souffle.Marshal ShortTextFact instance Souffle.Marshal Int32Fact instance Souffle.Marshal Word32Fact instance Souffle.Marshal FloatFact  instance Souffle.Program RoundTrip where   type ProgramFacts RoundTrip =-    [StringFact, TextFact, LazyTextFact, Int32Fact, Word32Fact, FloatFact]+    [StringFact, TextFact, LazyTextFact, ShortTextFact, Int32Fact, Word32Fact, FloatFact]   programName = const "round_trip"  type RoundTripAction   = forall a. Souffle.Fact a   => Souffle.ContainsInputFact RoundTrip a   => Souffle.ContainsOutputFact RoundTrip a+  => Compiled.Submit a   => a -> PropertyT IO a ++data EdgeCases = EdgeCases++data EmptyStrings a+  = EmptyStrings a a Int32+  deriving (Eq, Show, Generic)++newtype LongStrings a+  = LongStrings a+  deriving (Eq, Show, Generic)++newtype Unicode a+  = Unicode a+  deriving (Eq, Show, Generic)++data NoStrings a = NoStrings Word32 Int32 Float+  deriving (Eq, Show, Generic)++instance Souffle.Program EdgeCases where+  type ProgramFacts EdgeCases =+    [ EmptyStrings String, EmptyStrings T.Text, EmptyStrings TL.Text+    , LongStrings String, LongStrings T.Text, LongStrings TL.Text+    , Unicode String, Unicode T.Text, Unicode TL.Text+    , NoStrings Void+    ]+  programName = const "edge_cases"++instance Souffle.Fact (EmptyStrings String) where+  type FactDirection (EmptyStrings String) = 'Souffle.InputOutput+  factName = const "empty_strings"+instance Souffle.Fact (EmptyStrings T.Text) where+  type FactDirection (EmptyStrings T.Text) = 'Souffle.InputOutput+  factName = const "empty_strings"+instance Souffle.Fact (EmptyStrings TL.Text) where+  type FactDirection (EmptyStrings TL.Text) = 'Souffle.InputOutput+  factName = const "empty_strings"++instance Souffle.Fact (LongStrings String) where+  type FactDirection (LongStrings String) = 'Souffle.InputOutput+  factName = const "long_strings"+instance Souffle.Fact (LongStrings T.Text) where+  type FactDirection (LongStrings T.Text) = 'Souffle.InputOutput+  factName = const "long_strings"+instance Souffle.Fact (LongStrings TL.Text) where+  type FactDirection (LongStrings TL.Text) = 'Souffle.InputOutput+  factName = const "long_strings"++instance Souffle.Fact (Unicode String) where+  type FactDirection (Unicode String) = 'Souffle.InputOutput+  factName = const "unicode"+instance Souffle.Fact (Unicode T.Text) where+  type FactDirection (Unicode T.Text) = 'Souffle.InputOutput+  factName = const "unicode"+instance Souffle.Fact (Unicode TL.Text) where+  type FactDirection (Unicode TL.Text) = 'Souffle.InputOutput+  factName = const "unicode"++instance Souffle.Fact (NoStrings a) where+  type FactDirection (NoStrings _) = 'Souffle.InputOutput+  factName = const "no_strings"++instance Marshal (EmptyStrings String)+instance Marshal (EmptyStrings T.Text)+instance Marshal (EmptyStrings TL.Text)+instance Marshal (LongStrings String)+instance Marshal (LongStrings T.Text)+instance Marshal (LongStrings TL.Text)+instance Marshal (Unicode String)+instance Marshal (Unicode T.Text)+instance Marshal (Unicode TL.Text)+instance Marshal (NoStrings a)++ spec :: Spec spec = describe "Marshalling" $ parallel $ do   describe "Auto-deriving marshalling code" $@@ -148,58 +234,270 @@       -- If this file compiles, then the test has already passed       42 `shouldBe` 42 -  describe "data transfer between Haskell and Souffle" $ parallel $ do-    let roundTripTests :: RoundTripAction -> Spec-        roundTripTests run = do-          it "can serialize and deserialize String values" $ hedgehog $ do-            str <- forAll $ Gen.string (Range.linear 0 10) Gen.unicode-            let fact = StringFact str-            fact' <- run fact-            fact === fact'+  roundTripSpecs+  edgeCaseSpecs -          it "can serialize and deserialize lazy Text" $ hedgehog $ do-            str <- forAll $ Gen.string (Range.linear 0 10) Gen.unicode-            let fact = LazyTextFact (TL.pack str)-            fact' <- run fact-            fact === fact'+roundTripSpecs :: Spec+roundTripSpecs = describe "data transfer between Haskell and Souffle" $ parallel $ do+  let roundTripTests :: RoundTripAction -> Spec+      roundTripTests run = do+        it "can serialize and deserialize String values" $ hedgehog $ do+          str <- forAll $ Gen.string (Range.linear 0 10) Gen.unicode+          let fact = StringFact str+          fact' <- run fact+          fact === fact' -          it "can serialize and deserialize strict Text values" $ hedgehog $ do-            str <- forAll $ Gen.text (Range.linear 0 10) Gen.unicode-            let fact = TextFact str-            fact' <- run fact-            fact === fact'+        it "can serialize and deserialize lazy Text values" $ hedgehog $ do+          str <- forAll $ Gen.string (Range.linear 0 10) Gen.unicode+          let fact = LazyTextFact (TL.pack str)+          fact' <- run fact+          fact === fact' -          it "can serialize and deserialize Int32 values" $ hedgehog $ do-            x <- forAll $ Gen.int32 (Range.linear minBound maxBound)-            let fact = Int32Fact x-            fact' <- run fact-            fact === fact'+        it "can serialize and deserialize strict Text values" $ hedgehog $ do+          str <- forAll $ Gen.text (Range.linear 0 10) Gen.unicode+          let fact = TextFact str+          fact' <- run fact+          fact === fact' -          it "can serialize and deserialize Word32 values" $ hedgehog $ do-            x <- forAll $ Gen.word32 (Range.linear minBound maxBound)-            let fact = Word32Fact x-            fact' <- run fact-            fact === fact'+        it "can serialize and deserialize short Text values" $ hedgehog $ do+          str <- forAll $ Gen.text (Range.linear 0 10) Gen.unicode+          let fact = ShortTextFact (TS.fromText str)+          fact' <- run fact+          fact === fact' -          it "can serialize and deserialize Float values" $ hedgehog $ do-            let epsilon = 1e-6-                fmin = -1e9-                fmax =  1e9-            x <- forAll $ Gen.float (Range.exponentialFloat fmin fmax)-            let fact = FloatFact x-            FloatFact x' <- run fact-            (abs (x' - x) < epsilon) === True+        it "can serialize and deserialize Int32 values" $ hedgehog $ do+          x <- forAll $ Gen.int32 (Range.linear minBound maxBound)+          let fact = Int32Fact x+          fact' <- run fact+          fact === fact' -    describe "interpreted mode" $ parallel $-      roundTripTests $ \fact -> liftIO $ Interpreted.runSouffle RoundTrip $ \handle -> do+        it "can serialize and deserialize Word32 values" $ hedgehog $ do+          x <- forAll $ Gen.word32 (Range.linear minBound maxBound)+          let fact = Word32Fact x+          fact' <- run fact+          fact === fact'++        it "can serialize and deserialize Float values" $ hedgehog $ do+          let epsilon = 1e-6+              fmin = -1e9+              fmax =  1e9+          x <- forAll $ Gen.float (Range.exponentialFloat fmin fmax)+          let fact = FloatFact x+          FloatFact x' <- run fact+          (abs (x' - x) < epsilon) === True++  describe "interpreted mode" $ parallel $+    roundTripTests $ \fact -> liftIO $ Interpreted.runSouffle RoundTrip $ \handle -> do+      let prog = fromJust handle+      Interpreted.addFact prog fact+      Interpreted.run prog+      Prelude.head <$> Interpreted.getFacts prog++  describe "compiled mode" $ parallel $+    roundTripTests $ \fact -> liftIO $ Compiled.runSouffle RoundTrip $ \handle -> do+      let prog = fromJust handle+      Compiled.addFact prog fact+      Compiled.run prog+      Prelude.head <$> Compiled.getFacts prog++edgeCaseSpecs :: Spec+edgeCaseSpecs = describe "edge cases" $ parallel $ do+  let longString :: IsString a => a+      longString = "long_string_from_DL:...............................................................................................................................................................................................................................................................................................end"++      getFactsI :: forall f a. (Souffle.Fact (f a), Souffle.ContainsOutputFact EdgeCases (f a)) => IO [f a]+      getFactsI = Interpreted.runSouffle EdgeCases $ \handle -> do         let prog = fromJust handle-        Interpreted.addFact prog fact         Interpreted.run prog-        Prelude.head <$> Interpreted.getFacts prog+        Interpreted.getFacts prog+      getFactsC :: forall f a. (Souffle.Fact (f a), Souffle.ContainsOutputFact EdgeCases (f a)) => IO [f a]+      getFactsC = Compiled.runSouffle EdgeCases $ \handle -> do+        let prog = fromJust handle+        Compiled.run prog+        Prelude.reverse <$> Compiled.getFacts prog -    describe "compiled mode" $ parallel $-      roundTripTests $ \fact -> liftIO $ Compiled.runSouffle RoundTrip $ \handle -> do+      getUnicodeFactsI :: forall a. (IsString a, Eq a, Souffle.Fact (Unicode a), Souffle.ContainsOutputFact EdgeCases (Unicode a))+                        => IO ([Unicode a], Maybe (Unicode a), Maybe (Unicode a))+      getUnicodeFactsI = Interpreted.runSouffle EdgeCases $ \handle -> do         let prog = fromJust handle-        Compiled.addFact prog fact+        Interpreted.run prog+        (,,) <$> Interpreted.getFacts prog+              <*> Interpreted.findFact prog (Unicode "⌀")  -- \x2300 iso \x2200+              <*> Interpreted.findFact prog (Unicode "≂")  -- \x2242 iso \x2200++      getUnicodeFactsC :: forall a. (IsString a, Eq a, Souffle.Fact (Unicode a), Souffle.ContainsOutputFact EdgeCases (Unicode a), Compiled.Submit (Unicode a))+                        => IO ([Unicode a], Maybe (Unicode a), Maybe (Unicode a))+      getUnicodeFactsC = Compiled.runSouffle EdgeCases $ \handle -> do+        let prog = fromJust handle         Compiled.run prog-        Prelude.head <$> Compiled.getFacts prog+        (,,) <$> (Prelude.reverse <$> Compiled.getFacts prog)+              <*> Compiled.findFact prog (Unicode "⌀")  -- \x2300 iso \x2200+              <*> Compiled.findFact prog (Unicode "≂")  -- \x2242 iso \x2200++      addAndGetFactsI :: Souffle.Fact (f a)+                      => Souffle.ContainsInputFact EdgeCases (f a)+                      => Souffle.ContainsOutputFact EdgeCases (f a)+                      => [f a] -> IO [f a]+      addAndGetFactsI fs = Interpreted.runSouffle EdgeCases $ \handle -> do+        let prog = fromJust handle+        Interpreted.addFacts prog fs+        Interpreted.run prog+        Interpreted.getFacts prog+      addAndGetFactsC :: Souffle.Fact (f a)+                      => Souffle.ContainsInputFact EdgeCases (f a)+                      => Souffle.ContainsOutputFact EdgeCases (f a)+                      => Compiled.Submit (f a)+                      => [f a] -> IO [f a]+      addAndGetFactsC fs = Compiled.runSouffle EdgeCases $ \handle -> do+        let prog = fromJust handle+        Compiled.addFacts prog fs+        Compiled.run prog+        Prelude.reverse <$> Compiled.getFacts prog+++      runTests :: (forall f a. (Souffle.Fact (f a), Souffle.ContainsOutputFact EdgeCases (f a)) => IO [f a])+                -> (forall a. (IsString a, Eq a, Souffle.Fact (Unicode a), Souffle.ContainsOutputFact EdgeCases (Unicode a), Compiled.Submit (Unicode a))+                    => IO ([Unicode a], Maybe (Unicode a), Maybe (Unicode a)))+                -> (forall f a. Souffle.Fact (f a)+                    => Souffle.ContainsInputFact EdgeCases (f a)+                    => Souffle.ContainsOutputFact EdgeCases (f a)+                    => Compiled.Submit (f a)+                    => [f a] -> IO [f a])+                -> Spec+      runTests getFacts getUnicodeFacts addAndGetFacts = do+        it "correctly marshals facts with number-like types" $ do+          facts <- getFacts+          (facts :: [NoStrings Void])+            `shouldBe` [ NoStrings 42 (-100) 1.5+                       , NoStrings 123 (-456) 3.14+                       ]++        it "correctly marshals facts with empty Strings" $ do+          facts <- getFacts+          (facts :: [EmptyStrings String])+            `shouldBe` [ EmptyStrings "" "" 42+                       , EmptyStrings "" "abc" 42+                       , EmptyStrings "abc" "" 42+                       ]++        it "correctly marshals facts with empty Texts" $ do+          facts <- getFacts+          (facts :: [EmptyStrings T.Text])+            `shouldBe` [ EmptyStrings "" "" 42+                        , EmptyStrings "" "abc" 42+                        , EmptyStrings "abc" "" 42+                        ]++        it "correctly marshals facts with empty lazy Texts" $ do+          facts <- getFacts+          (facts :: [EmptyStrings TL.Text])+            `shouldBe` [ EmptyStrings "" "" 42+                        , EmptyStrings "" "abc" 42+                        , EmptyStrings "abc" "" 42+                        ]++        it "correctly marshals facts really with long (>255 chars) String" $ do+          facts <- getFacts+          (facts :: [LongStrings String]) `shouldBe` [ LongStrings longString ]++        it "correctly marshals facts really with long (>255 chars) Text" $ do+          facts <- getFacts+          (facts :: [LongStrings T.Text]) `shouldBe` [ LongStrings longString ]++        it "correctly marshals facts really with long (>255 chars) lazy Text" $ do+          facts <- getFacts+          (facts :: [LongStrings TL.Text]) `shouldBe` [ LongStrings longString ]++        it "correctly marshals facts containing unicode characters (String)" $ do+          results <- getUnicodeFacts+          results `shouldBe`+            ( [ Unicode ("∀" :: String), Unicode "∀∀" ]+            , Nothing :: Maybe (Unicode String)+            , Nothing :: Maybe (Unicode String)+            )++        it "correctly marshals facts containing unicode characters (Text)" $ do+          results <- getUnicodeFacts+          results `shouldBe`+            ( [ Unicode ("∀" :: T.Text), Unicode "∀∀" ]+            , Nothing :: Maybe (Unicode T.Text)+            , Nothing :: Maybe (Unicode T.Text)+            )++        it "correctly marshals facts containing unicode characters (lazy Text)" $ do+          results <- getUnicodeFacts+          results `shouldBe`+            ( [ Unicode ("∀" :: TL.Text), Unicode "∀∀" ]+            , Nothing :: Maybe (Unicode TL.Text)+            , Nothing :: Maybe (Unicode TL.Text)+            )++        it "correctly marshals empty strings back and forth (Strings)" $ do+          let facts :: [EmptyStrings String]+              facts = [EmptyStrings "" "" 1, EmptyStrings "" "" 42, EmptyStrings "" "abc" 2, EmptyStrings "" "abc" 42, EmptyStrings "abc" "" 3, EmptyStrings "abc" "" 42]+          facts' <- addAndGetFacts facts+          facts' `shouldBe` facts++        it "correctly marshals empty strings back and forth (Text)" $ do+          let facts :: [EmptyStrings T.Text]+              facts = [EmptyStrings "" "" 1, EmptyStrings "" "" 42, EmptyStrings "" "abc" 2, EmptyStrings "" "abc" 42, EmptyStrings "abc" "" 3, EmptyStrings "abc" "" 42]+          facts' <- addAndGetFacts facts+          facts' `shouldBe` facts++        it "correctly marshals empty strings back and forth (lazy Text)" $ do+          let facts :: [EmptyStrings TL.Text]+              facts = [EmptyStrings "" "" 1, EmptyStrings "" "" 42, EmptyStrings "" "abc" 2, EmptyStrings "" "abc" 42, EmptyStrings "abc" "" 3, EmptyStrings "abc" "" 42]+          facts' <- addAndGetFacts facts+          facts' `shouldBe` facts++        it "correctly marshals unicode back and forth (Strings)" $ do+          let facts :: [Unicode String]+              facts = [Unicode "∀", Unicode "∀∀", Unicode "≂", Unicode "⌀", Unicode "⌀⌀"]+          facts' <- addAndGetFacts facts+          facts' `shouldBe` facts++        it "correctly marshals unicode back and forth (Text)" $ do+          let facts :: [Unicode T.Text]+              facts = [Unicode "∀", Unicode "∀∀", Unicode "≂", Unicode "⌀", Unicode "⌀⌀"]+          facts' <- addAndGetFacts facts+          facts' `shouldBe` facts++        it "correctly marshals unicode back and forth (lazy Text)" $ do+          let facts :: [Unicode TL.Text]+              facts = [Unicode "∀", Unicode "∀∀", Unicode "≂", Unicode "⌀", Unicode "⌀⌀"]+          facts' <- addAndGetFacts facts+          facts' `shouldBe` facts++        it "correctly marshals really long strings back and forth (Strings)" $ do+          let facts :: [LongStrings String]+              facts = [LongStrings longString, LongStrings $ join $ Prelude.replicate 10000 "abc"]+          facts' <- addAndGetFacts facts+          facts' `shouldBe` facts++        it "correctly marshals really long strings back and forth (Text)" $ do+          let facts :: [LongStrings T.Text]+              facts = [LongStrings longString, LongStrings $ T.pack $ join $ Prelude.replicate 10000 "abc"]+          facts' <- addAndGetFacts facts+          facts' `shouldBe` facts++        it "correctly marshals really long strings back and forth (lazy Text)" $ do+          let facts :: [LongStrings TL.Text]+              facts = [LongStrings longString, LongStrings $ TL.pack $ join $ Prelude.replicate 10000 "abc"]+          facts' <- addAndGetFacts facts+          facts' `shouldBe` facts++        it "correctly marshals facts with number-like types" $ do+          let facts :: [NoStrings Void]+              facts = [ NoStrings 42 (-100) 1.5+                      , NoStrings 123 (-456) 3.14+                      , NoStrings 789 (-789) 1000.123+                      , NoStrings 0x12345678 (-1000) 1234.56789+                      ]+          facts' <- addAndGetFacts facts+          facts' `shouldBe` facts++  describe "interpreted mode" $ parallel $ do+    runTests getFactsI getUnicodeFactsI addAndGetFactsI++  describe "compiled mode" $ parallel $ do+    runTests getFactsC getUnicodeFactsC addAndGetFactsC
+ tests/fixtures/edge_cases.cpp view
@@ -0,0 +1,698 @@++#include "souffle/CompiledSouffle.h"++extern "C" {+}++namespace souffle {+static const RamDomain RAM_BIT_SHIFT_MASK = RAM_DOMAIN_SIZE - 1;+struct t_btree_iii__0_1_2__111 {+using t_tuple = Tuple<RamDomain, 3>;+struct t_comparator_0{+ int operator()(const t_tuple& a, const t_tuple& b) const {+  return (ramBitCast<RamSigned>(a[0]) < ramBitCast<RamSigned>(b[0])) ? -1 : (ramBitCast<RamSigned>(a[0]) > ramBitCast<RamSigned>(b[0])) ? 1 :((ramBitCast<RamSigned>(a[1]) < ramBitCast<RamSigned>(b[1])) ? -1 : (ramBitCast<RamSigned>(a[1]) > ramBitCast<RamSigned>(b[1])) ? 1 :((ramBitCast<RamSigned>(a[2]) < ramBitCast<RamSigned>(b[2])) ? -1 : (ramBitCast<RamSigned>(a[2]) > ramBitCast<RamSigned>(b[2])) ? 1 :(0)));+ }+bool less(const t_tuple& a, const t_tuple& b) const {+  return (ramBitCast<RamSigned>(a[0]) < ramBitCast<RamSigned>(b[0]))|| (ramBitCast<RamSigned>(a[0]) == ramBitCast<RamSigned>(b[0])) && ((ramBitCast<RamSigned>(a[1]) < ramBitCast<RamSigned>(b[1]))|| (ramBitCast<RamSigned>(a[1]) == ramBitCast<RamSigned>(b[1])) && ((ramBitCast<RamSigned>(a[2]) < ramBitCast<RamSigned>(b[2]))));+ }+bool equal(const t_tuple& a, const t_tuple& b) const {+return (ramBitCast<RamSigned>(a[0]) == ramBitCast<RamSigned>(b[0]))&&(ramBitCast<RamSigned>(a[1]) == ramBitCast<RamSigned>(b[1]))&&(ramBitCast<RamSigned>(a[2]) == ramBitCast<RamSigned>(b[2]));+ }+};+using t_ind_0 = btree_set<t_tuple,t_comparator_0>;+t_ind_0 ind_0;+using iterator = t_ind_0::iterator;+struct context {+t_ind_0::operation_hints hints_0_lower;+t_ind_0::operation_hints hints_0_upper;+};+context createContext() { return context(); }+bool insert(const t_tuple& t) {+context h;+return insert(t, h);+}+bool insert(const t_tuple& t, context& h) {+if (ind_0.insert(t, h.hints_0_lower)) {+return true;+} else return false;+}+bool insert(const RamDomain* ramDomain) {+RamDomain data[3];+std::copy(ramDomain, ramDomain + 3, data);+const t_tuple& tuple = reinterpret_cast<const t_tuple&>(data);+context h;+return insert(tuple, h);+}+bool insert(RamDomain a0,RamDomain a1,RamDomain a2) {+RamDomain data[3] = {a0,a1,a2};+return insert(data);+}+bool contains(const t_tuple& t, context& h) const {+return ind_0.contains(t, h.hints_0_lower);+}+bool contains(const t_tuple& t) const {+context h;+return contains(t, h);+}+std::size_t size() const {+return ind_0.size();+}+iterator find(const t_tuple& t, context& h) const {+return ind_0.find(t, h.hints_0_lower);+}+iterator find(const t_tuple& t) const {+context h;+return find(t, h);+}+range<iterator> lowerUpperRange_000(const t_tuple& /* lower */, const t_tuple& /* upper */, context& /* h */) const {+return range<iterator>(ind_0.begin(),ind_0.end());+}+range<iterator> lowerUpperRange_000(const t_tuple& /* lower */, const t_tuple& /* upper */) const {+return range<iterator>(ind_0.begin(),ind_0.end());+}+range<t_ind_0::iterator> lowerUpperRange_111(const t_tuple& lower, const t_tuple& upper, context& h) const {+t_comparator_0 comparator;+int cmp = comparator(lower, upper);+if (cmp == 0) {+    auto pos = ind_0.find(lower, h.hints_0_lower);+    auto fin = ind_0.end();+    if (pos != fin) {fin = pos; ++fin;}+    return make_range(pos, fin);+}+if (cmp > 0) {+    return make_range(ind_0.end(), ind_0.end());+}+return make_range(ind_0.lower_bound(lower, h.hints_0_lower), ind_0.upper_bound(upper, h.hints_0_upper));+}+range<t_ind_0::iterator> lowerUpperRange_111(const t_tuple& lower, const t_tuple& upper) const {+context h;+return lowerUpperRange_111(lower,upper,h);+}+bool empty() const {+return ind_0.empty();+}+std::vector<range<iterator>> partition() const {+return ind_0.getChunks(400);+}+void purge() {+ind_0.clear();+}+iterator begin() const {+return ind_0.begin();+}+iterator end() const {+return ind_0.end();+}+void printStatistics(std::ostream& o) const {+o << " arity 3 direct b-tree index 0 lex-order [0,1,2]\n";+ind_0.printStats(o);+}+};+struct t_btree_i__0__1 {+using t_tuple = Tuple<RamDomain, 1>;+struct t_comparator_0{+ int operator()(const t_tuple& a, const t_tuple& b) const {+  return (ramBitCast<RamSigned>(a[0]) < ramBitCast<RamSigned>(b[0])) ? -1 : (ramBitCast<RamSigned>(a[0]) > ramBitCast<RamSigned>(b[0])) ? 1 :(0);+ }+bool less(const t_tuple& a, const t_tuple& b) const {+  return (ramBitCast<RamSigned>(a[0]) < ramBitCast<RamSigned>(b[0]));+ }+bool equal(const t_tuple& a, const t_tuple& b) const {+return (ramBitCast<RamSigned>(a[0]) == ramBitCast<RamSigned>(b[0]));+ }+};+using t_ind_0 = btree_set<t_tuple,t_comparator_0>;+t_ind_0 ind_0;+using iterator = t_ind_0::iterator;+struct context {+t_ind_0::operation_hints hints_0_lower;+t_ind_0::operation_hints hints_0_upper;+};+context createContext() { return context(); }+bool insert(const t_tuple& t) {+context h;+return insert(t, h);+}+bool insert(const t_tuple& t, context& h) {+if (ind_0.insert(t, h.hints_0_lower)) {+return true;+} else return false;+}+bool insert(const RamDomain* ramDomain) {+RamDomain data[1];+std::copy(ramDomain, ramDomain + 1, data);+const t_tuple& tuple = reinterpret_cast<const t_tuple&>(data);+context h;+return insert(tuple, h);+}+bool insert(RamDomain a0) {+RamDomain data[1] = {a0};+return insert(data);+}+bool contains(const t_tuple& t, context& h) const {+return ind_0.contains(t, h.hints_0_lower);+}+bool contains(const t_tuple& t) const {+context h;+return contains(t, h);+}+std::size_t size() const {+return ind_0.size();+}+iterator find(const t_tuple& t, context& h) const {+return ind_0.find(t, h.hints_0_lower);+}+iterator find(const t_tuple& t) const {+context h;+return find(t, h);+}+range<iterator> lowerUpperRange_0(const t_tuple& /* lower */, const t_tuple& /* upper */, context& /* h */) const {+return range<iterator>(ind_0.begin(),ind_0.end());+}+range<iterator> lowerUpperRange_0(const t_tuple& /* lower */, const t_tuple& /* upper */) const {+return range<iterator>(ind_0.begin(),ind_0.end());+}+range<t_ind_0::iterator> lowerUpperRange_1(const t_tuple& lower, const t_tuple& upper, context& h) const {+t_comparator_0 comparator;+int cmp = comparator(lower, upper);+if (cmp == 0) {+    auto pos = ind_0.find(lower, h.hints_0_lower);+    auto fin = ind_0.end();+    if (pos != fin) {fin = pos; ++fin;}+    return make_range(pos, fin);+}+if (cmp > 0) {+    return make_range(ind_0.end(), ind_0.end());+}+return make_range(ind_0.lower_bound(lower, h.hints_0_lower), ind_0.upper_bound(upper, h.hints_0_upper));+}+range<t_ind_0::iterator> lowerUpperRange_1(const t_tuple& lower, const t_tuple& upper) const {+context h;+return lowerUpperRange_1(lower,upper,h);+}+bool empty() const {+return ind_0.empty();+}+std::vector<range<iterator>> partition() const {+return ind_0.getChunks(400);+}+void purge() {+ind_0.clear();+}+iterator begin() const {+return ind_0.begin();+}+iterator end() const {+return ind_0.end();+}+void printStatistics(std::ostream& o) const {+o << " arity 1 direct b-tree index 0 lex-order [0]\n";+ind_0.printStats(o);+}+};+struct t_btree_uif__0_1_2__111 {+using t_tuple = Tuple<RamDomain, 3>;+struct t_comparator_0{+ int operator()(const t_tuple& a, const t_tuple& b) const {+  return (ramBitCast<RamUnsigned>(a[0]) < ramBitCast<RamUnsigned>(b[0])) ? -1 : (ramBitCast<RamUnsigned>(a[0]) > ramBitCast<RamUnsigned>(b[0])) ? 1 :((ramBitCast<RamSigned>(a[1]) < ramBitCast<RamSigned>(b[1])) ? -1 : (ramBitCast<RamSigned>(a[1]) > ramBitCast<RamSigned>(b[1])) ? 1 :((ramBitCast<RamFloat>(a[2]) < ramBitCast<RamFloat>(b[2])) ? -1 : (ramBitCast<RamFloat>(a[2]) > ramBitCast<RamFloat>(b[2])) ? 1 :(0)));+ }+bool less(const t_tuple& a, const t_tuple& b) const {+  return (ramBitCast<RamUnsigned>(a[0]) < ramBitCast<RamUnsigned>(b[0]))|| (ramBitCast<RamUnsigned>(a[0]) == ramBitCast<RamUnsigned>(b[0])) && ((ramBitCast<RamSigned>(a[1]) < ramBitCast<RamSigned>(b[1]))|| (ramBitCast<RamSigned>(a[1]) == ramBitCast<RamSigned>(b[1])) && ((ramBitCast<RamFloat>(a[2]) < ramBitCast<RamFloat>(b[2]))));+ }+bool equal(const t_tuple& a, const t_tuple& b) const {+return (ramBitCast<RamUnsigned>(a[0]) == ramBitCast<RamUnsigned>(b[0]))&&(ramBitCast<RamSigned>(a[1]) == ramBitCast<RamSigned>(b[1]))&&(ramBitCast<RamFloat>(a[2]) == ramBitCast<RamFloat>(b[2]));+ }+};+using t_ind_0 = btree_set<t_tuple,t_comparator_0>;+t_ind_0 ind_0;+using iterator = t_ind_0::iterator;+struct context {+t_ind_0::operation_hints hints_0_lower;+t_ind_0::operation_hints hints_0_upper;+};+context createContext() { return context(); }+bool insert(const t_tuple& t) {+context h;+return insert(t, h);+}+bool insert(const t_tuple& t, context& h) {+if (ind_0.insert(t, h.hints_0_lower)) {+return true;+} else return false;+}+bool insert(const RamDomain* ramDomain) {+RamDomain data[3];+std::copy(ramDomain, ramDomain + 3, data);+const t_tuple& tuple = reinterpret_cast<const t_tuple&>(data);+context h;+return insert(tuple, h);+}+bool insert(RamDomain a0,RamDomain a1,RamDomain a2) {+RamDomain data[3] = {a0,a1,a2};+return insert(data);+}+bool contains(const t_tuple& t, context& h) const {+return ind_0.contains(t, h.hints_0_lower);+}+bool contains(const t_tuple& t) const {+context h;+return contains(t, h);+}+std::size_t size() const {+return ind_0.size();+}+iterator find(const t_tuple& t, context& h) const {+return ind_0.find(t, h.hints_0_lower);+}+iterator find(const t_tuple& t) const {+context h;+return find(t, h);+}+range<iterator> lowerUpperRange_000(const t_tuple& /* lower */, const t_tuple& /* upper */, context& /* h */) const {+return range<iterator>(ind_0.begin(),ind_0.end());+}+range<iterator> lowerUpperRange_000(const t_tuple& /* lower */, const t_tuple& /* upper */) const {+return range<iterator>(ind_0.begin(),ind_0.end());+}+range<t_ind_0::iterator> lowerUpperRange_111(const t_tuple& lower, const t_tuple& upper, context& h) const {+t_comparator_0 comparator;+int cmp = comparator(lower, upper);+if (cmp == 0) {+    auto pos = ind_0.find(lower, h.hints_0_lower);+    auto fin = ind_0.end();+    if (pos != fin) {fin = pos; ++fin;}+    return make_range(pos, fin);+}+if (cmp > 0) {+    return make_range(ind_0.end(), ind_0.end());+}+return make_range(ind_0.lower_bound(lower, h.hints_0_lower), ind_0.upper_bound(upper, h.hints_0_upper));+}+range<t_ind_0::iterator> lowerUpperRange_111(const t_tuple& lower, const t_tuple& upper) const {+context h;+return lowerUpperRange_111(lower,upper,h);+}+bool empty() const {+return ind_0.empty();+}+std::vector<range<iterator>> partition() const {+return ind_0.getChunks(400);+}+void purge() {+ind_0.clear();+}+iterator begin() const {+return ind_0.begin();+}+iterator end() const {+return ind_0.end();+}+void printStatistics(std::ostream& o) const {+o << " arity 3 direct b-tree index 0 lex-order [0,1,2]\n";+ind_0.printStats(o);+}+};++class Sf_edge_cases : public SouffleProgram {+private:+static inline bool regex_wrapper(const std::string& pattern, const std::string& text) {+   bool result = false; +   try { result = std::regex_match(text, std::regex(pattern)); } catch(...) { +     std::cerr << "warning: wrong pattern provided for match(\"" << pattern << "\",\"" << text << "\").\n";+}+   return result;+}+private:+static inline std::string substr_wrapper(const std::string& str, size_t idx, size_t len) {+   std::string result; +   try { result = str.substr(idx,len); } catch(...) { +     std::cerr << "warning: wrong index position provided by substr(\"";+     std::cerr << str << "\"," << (int32_t)idx << "," << (int32_t)len << ") functor.\n";+   } return result;+}+public:+// -- initialize symbol table --+SymbolTable symTable{+	R"_()_",+	R"_(abc)_",+	R"_(long_string_from_DL:...............................................................................................................................................................................................................................................................................................end)_",+	R"_(∀)_",+	R"_(∀∀)_",+};// -- initialize record table --+RecordTable recordTable;+// -- Table: empty_strings+Own<t_btree_iii__0_1_2__111> rel_1_empty_strings = mk<t_btree_iii__0_1_2__111>();+souffle::RelationWrapper<0,t_btree_iii__0_1_2__111,Tuple<RamDomain,3>,3,0> wrapper_rel_1_empty_strings;+// -- Table: long_strings+Own<t_btree_i__0__1> rel_2_long_strings = mk<t_btree_i__0__1>();+souffle::RelationWrapper<1,t_btree_i__0__1,Tuple<RamDomain,1>,1,0> wrapper_rel_2_long_strings;+// -- Table: no_strings+Own<t_btree_uif__0_1_2__111> rel_3_no_strings = mk<t_btree_uif__0_1_2__111>();+souffle::RelationWrapper<2,t_btree_uif__0_1_2__111,Tuple<RamDomain,3>,3,0> wrapper_rel_3_no_strings;+// -- Table: unicode+Own<t_btree_i__0__1> rel_4_unicode = mk<t_btree_i__0__1>();+souffle::RelationWrapper<3,t_btree_i__0__1,Tuple<RamDomain,1>,1,0> wrapper_rel_4_unicode;+public:+Sf_edge_cases() : +wrapper_rel_1_empty_strings(*rel_1_empty_strings,symTable,"empty_strings",std::array<const char *,3>{{"s:symbol","s:symbol","i:number"}},std::array<const char *,3>{{"s","s2","n"}}),++wrapper_rel_2_long_strings(*rel_2_long_strings,symTable,"long_strings",std::array<const char *,1>{{"s:symbol"}},std::array<const char *,1>{{"s"}}),++wrapper_rel_3_no_strings(*rel_3_no_strings,symTable,"no_strings",std::array<const char *,3>{{"u:unsigned","i:number","f:float"}},std::array<const char *,3>{{"u","n","f"}}),++wrapper_rel_4_unicode(*rel_4_unicode,symTable,"unicode",std::array<const char *,1>{{"s:symbol"}},std::array<const char *,1>{{"s"}}){+addRelation("empty_strings",&wrapper_rel_1_empty_strings,true,true);+addRelation("long_strings",&wrapper_rel_2_long_strings,true,true);+addRelation("no_strings",&wrapper_rel_3_no_strings,true,true);+addRelation("unicode",&wrapper_rel_4_unicode,true,true);+}+~Sf_edge_cases() {+}+private:+std::string inputDirectory;+std::string outputDirectory;+bool performIO;+std::atomic<RamDomain> ctr{};++std::atomic<size_t> iter{};+void runFunction(std::string inputDirectoryArg = "", std::string outputDirectoryArg = "", bool performIOArg = false) {+this->inputDirectory = inputDirectoryArg;+this->outputDirectory = outputDirectoryArg;+this->performIO = performIOArg;+SignalHandler::instance()->set();+#if defined(_OPENMP)+if (getNumThreads() > 0) {omp_set_num_threads(getNumThreads());}+#endif++// -- query evaluation --+{+ std::vector<RamDomain> args, ret;+subroutine_0(args, ret);+}+{+ std::vector<RamDomain> args, ret;+subroutine_1(args, ret);+}+{+ std::vector<RamDomain> args, ret;+subroutine_2(args, ret);+}+{+ std::vector<RamDomain> args, ret;+subroutine_3(args, ret);+}++// -- relation hint statistics --+SignalHandler::instance()->reset();+}+public:+void run() override { runFunction("", "", false); }+public:+void runAll(std::string inputDirectoryArg = "", std::string outputDirectoryArg = "") override { runFunction(inputDirectoryArg, outputDirectoryArg, true);+}+public:+void printAll(std::string outputDirectoryArg = "") override {+try {std::map<std::string, std::string> directiveMap({{"IO","file"},{"attributeNames","s"},{"name","unicode"},{"operation","output"},{"output-dir","."},{"params","{\"records\": {}, \"relation\": {\"arity\": 1, \"auxArity\": 0, \"params\": [\"s\"]}}"},{"types","{\"ADTs\": {}, \"records\": {}, \"relation\": {\"arity\": 1, \"auxArity\": 0, \"types\": [\"s:symbol\"]}}"}});+if (!outputDirectoryArg.empty()) {directiveMap["output-dir"] = outputDirectoryArg;}+IOSystem::getInstance().getWriter(directiveMap, symTable, recordTable)->writeAll(*rel_4_unicode);+} catch (std::exception& e) {std::cerr << e.what();exit(1);}+try {std::map<std::string, std::string> directiveMap({{"IO","file"},{"attributeNames","s"},{"name","long_strings"},{"operation","output"},{"output-dir","."},{"params","{\"records\": {}, \"relation\": {\"arity\": 1, \"auxArity\": 0, \"params\": [\"s\"]}}"},{"types","{\"ADTs\": {}, \"records\": {}, \"relation\": {\"arity\": 1, \"auxArity\": 0, \"types\": [\"s:symbol\"]}}"}});+if (!outputDirectoryArg.empty()) {directiveMap["output-dir"] = outputDirectoryArg;}+IOSystem::getInstance().getWriter(directiveMap, symTable, recordTable)->writeAll(*rel_2_long_strings);+} catch (std::exception& e) {std::cerr << e.what();exit(1);}+try {std::map<std::string, std::string> directiveMap({{"IO","file"},{"attributeNames","u\tn\tf"},{"name","no_strings"},{"operation","output"},{"output-dir","."},{"params","{\"records\": {}, \"relation\": {\"arity\": 3, \"auxArity\": 0, \"params\": [\"u\", \"n\", \"f\"]}}"},{"types","{\"ADTs\": {}, \"records\": {}, \"relation\": {\"arity\": 3, \"auxArity\": 0, \"types\": [\"u:unsigned\", \"i:number\", \"f:float\"]}}"}});+if (!outputDirectoryArg.empty()) {directiveMap["output-dir"] = outputDirectoryArg;}+IOSystem::getInstance().getWriter(directiveMap, symTable, recordTable)->writeAll(*rel_3_no_strings);+} catch (std::exception& e) {std::cerr << e.what();exit(1);}+try {std::map<std::string, std::string> directiveMap({{"IO","file"},{"attributeNames","s\ts2\tn"},{"name","empty_strings"},{"operation","output"},{"output-dir","."},{"params","{\"records\": {}, \"relation\": {\"arity\": 3, \"auxArity\": 0, \"params\": [\"s\", \"s2\", \"n\"]}}"},{"types","{\"ADTs\": {}, \"records\": {}, \"relation\": {\"arity\": 3, \"auxArity\": 0, \"types\": [\"s:symbol\", \"s:symbol\", \"i:number\"]}}"}});+if (!outputDirectoryArg.empty()) {directiveMap["output-dir"] = outputDirectoryArg;}+IOSystem::getInstance().getWriter(directiveMap, symTable, recordTable)->writeAll(*rel_1_empty_strings);+} catch (std::exception& e) {std::cerr << e.what();exit(1);}+}+public:+void loadAll(std::string inputDirectoryArg = "") override {+try {std::map<std::string, std::string> directiveMap({{"IO","file"},{"attributeNames","s"},{"fact-dir","."},{"name","long_strings"},{"operation","input"},{"params","{\"records\": {}, \"relation\": {\"arity\": 1, \"auxArity\": 0, \"params\": [\"s\"]}}"},{"types","{\"ADTs\": {}, \"records\": {}, \"relation\": {\"arity\": 1, \"auxArity\": 0, \"types\": [\"s:symbol\"]}}"}});+if (!inputDirectoryArg.empty()) {directiveMap["fact-dir"] = inputDirectoryArg;}+IOSystem::getInstance().getReader(directiveMap, symTable, recordTable)->readAll(*rel_2_long_strings);+} catch (std::exception& e) {std::cerr << "Error loading data: " << e.what() << '\n';}+try {std::map<std::string, std::string> directiveMap({{"IO","file"},{"attributeNames","s"},{"fact-dir","."},{"name","unicode"},{"operation","input"},{"params","{\"records\": {}, \"relation\": {\"arity\": 1, \"auxArity\": 0, \"params\": [\"s\"]}}"},{"types","{\"ADTs\": {}, \"records\": {}, \"relation\": {\"arity\": 1, \"auxArity\": 0, \"types\": [\"s:symbol\"]}}"}});+if (!inputDirectoryArg.empty()) {directiveMap["fact-dir"] = inputDirectoryArg;}+IOSystem::getInstance().getReader(directiveMap, symTable, recordTable)->readAll(*rel_4_unicode);+} catch (std::exception& e) {std::cerr << "Error loading data: " << e.what() << '\n';}+try {std::map<std::string, std::string> directiveMap({{"IO","file"},{"attributeNames","u\tn\tf"},{"fact-dir","."},{"name","no_strings"},{"operation","input"},{"params","{\"records\": {}, \"relation\": {\"arity\": 3, \"auxArity\": 0, \"params\": [\"u\", \"n\", \"f\"]}}"},{"types","{\"ADTs\": {}, \"records\": {}, \"relation\": {\"arity\": 3, \"auxArity\": 0, \"types\": [\"u:unsigned\", \"i:number\", \"f:float\"]}}"}});+if (!inputDirectoryArg.empty()) {directiveMap["fact-dir"] = inputDirectoryArg;}+IOSystem::getInstance().getReader(directiveMap, symTable, recordTable)->readAll(*rel_3_no_strings);+} catch (std::exception& e) {std::cerr << "Error loading data: " << e.what() << '\n';}+try {std::map<std::string, std::string> directiveMap({{"IO","file"},{"attributeNames","s\ts2\tn"},{"fact-dir","."},{"name","empty_strings"},{"operation","input"},{"params","{\"records\": {}, \"relation\": {\"arity\": 3, \"auxArity\": 0, \"params\": [\"s\", \"s2\", \"n\"]}}"},{"types","{\"ADTs\": {}, \"records\": {}, \"relation\": {\"arity\": 3, \"auxArity\": 0, \"types\": [\"s:symbol\", \"s:symbol\", \"i:number\"]}}"}});+if (!inputDirectoryArg.empty()) {directiveMap["fact-dir"] = inputDirectoryArg;}+IOSystem::getInstance().getReader(directiveMap, symTable, recordTable)->readAll(*rel_1_empty_strings);+} catch (std::exception& e) {std::cerr << "Error loading data: " << e.what() << '\n';}+}+public:+void dumpInputs() override {+try {std::map<std::string, std::string> rwOperation;+rwOperation["IO"] = "stdout";+rwOperation["name"] = "long_strings";+rwOperation["types"] = "{\"relation\": {\"arity\": 1, \"auxArity\": 0, \"types\": [\"s:symbol\"]}}";+IOSystem::getInstance().getWriter(rwOperation, symTable, recordTable)->writeAll(*rel_2_long_strings);+} catch (std::exception& e) {std::cerr << e.what();exit(1);}+try {std::map<std::string, std::string> rwOperation;+rwOperation["IO"] = "stdout";+rwOperation["name"] = "unicode";+rwOperation["types"] = "{\"relation\": {\"arity\": 1, \"auxArity\": 0, \"types\": [\"s:symbol\"]}}";+IOSystem::getInstance().getWriter(rwOperation, symTable, recordTable)->writeAll(*rel_4_unicode);+} catch (std::exception& e) {std::cerr << e.what();exit(1);}+try {std::map<std::string, std::string> rwOperation;+rwOperation["IO"] = "stdout";+rwOperation["name"] = "no_strings";+rwOperation["types"] = "{\"relation\": {\"arity\": 3, \"auxArity\": 0, \"types\": [\"u:unsigned\", \"i:number\", \"f:float\"]}}";+IOSystem::getInstance().getWriter(rwOperation, symTable, recordTable)->writeAll(*rel_3_no_strings);+} catch (std::exception& e) {std::cerr << e.what();exit(1);}+try {std::map<std::string, std::string> rwOperation;+rwOperation["IO"] = "stdout";+rwOperation["name"] = "empty_strings";+rwOperation["types"] = "{\"relation\": {\"arity\": 3, \"auxArity\": 0, \"types\": [\"s:symbol\", \"s:symbol\", \"i:number\"]}}";+IOSystem::getInstance().getWriter(rwOperation, symTable, recordTable)->writeAll(*rel_1_empty_strings);+} catch (std::exception& e) {std::cerr << e.what();exit(1);}+}+public:+void dumpOutputs() override {+try {std::map<std::string, std::string> rwOperation;+rwOperation["IO"] = "stdout";+rwOperation["name"] = "unicode";+rwOperation["types"] = "{\"relation\": {\"arity\": 1, \"auxArity\": 0, \"types\": [\"s:symbol\"]}}";+IOSystem::getInstance().getWriter(rwOperation, symTable, recordTable)->writeAll(*rel_4_unicode);+} catch (std::exception& e) {std::cerr << e.what();exit(1);}+try {std::map<std::string, std::string> rwOperation;+rwOperation["IO"] = "stdout";+rwOperation["name"] = "long_strings";+rwOperation["types"] = "{\"relation\": {\"arity\": 1, \"auxArity\": 0, \"types\": [\"s:symbol\"]}}";+IOSystem::getInstance().getWriter(rwOperation, symTable, recordTable)->writeAll(*rel_2_long_strings);+} catch (std::exception& e) {std::cerr << e.what();exit(1);}+try {std::map<std::string, std::string> rwOperation;+rwOperation["IO"] = "stdout";+rwOperation["name"] = "no_strings";+rwOperation["types"] = "{\"relation\": {\"arity\": 3, \"auxArity\": 0, \"types\": [\"u:unsigned\", \"i:number\", \"f:float\"]}}";+IOSystem::getInstance().getWriter(rwOperation, symTable, recordTable)->writeAll(*rel_3_no_strings);+} catch (std::exception& e) {std::cerr << e.what();exit(1);}+try {std::map<std::string, std::string> rwOperation;+rwOperation["IO"] = "stdout";+rwOperation["name"] = "empty_strings";+rwOperation["types"] = "{\"relation\": {\"arity\": 3, \"auxArity\": 0, \"types\": [\"s:symbol\", \"s:symbol\", \"i:number\"]}}";+IOSystem::getInstance().getWriter(rwOperation, symTable, recordTable)->writeAll(*rel_1_empty_strings);+} catch (std::exception& e) {std::cerr << e.what();exit(1);}+}+public:+SymbolTable& getSymbolTable() override {+return symTable;+}+void executeSubroutine(std::string name, const std::vector<RamDomain>& args, std::vector<RamDomain>& ret) override {+if (name == "stratum_0") {+subroutine_0(args, ret);+return;}+if (name == "stratum_1") {+subroutine_1(args, ret);+return;}+if (name == "stratum_2") {+subroutine_2(args, ret);+return;}+if (name == "stratum_3") {+subroutine_3(args, ret);+return;}+fatal("unknown subroutine");+}+#ifdef _MSC_VER+#pragma warning(disable: 4100)+#endif // _MSC_VER+void subroutine_0(const std::vector<RamDomain>& args, std::vector<RamDomain>& ret) {+if (performIO) {+try {std::map<std::string, std::string> directiveMap({{"IO","file"},{"attributeNames","s\ts2\tn"},{"fact-dir","."},{"name","empty_strings"},{"operation","input"},{"params","{\"records\": {}, \"relation\": {\"arity\": 3, \"auxArity\": 0, \"params\": [\"s\", \"s2\", \"n\"]}}"},{"types","{\"ADTs\": {}, \"records\": {}, \"relation\": {\"arity\": 3, \"auxArity\": 0, \"types\": [\"s:symbol\", \"s:symbol\", \"i:number\"]}}"}});+if (!inputDirectory.empty()) {directiveMap["fact-dir"] = inputDirectory;}+IOSystem::getInstance().getReader(directiveMap, symTable, recordTable)->readAll(*rel_1_empty_strings);+} catch (std::exception& e) {std::cerr << "Error loading data: " << e.what() << '\n';}+}+SignalHandler::instance()->setMsg(R"_(empty_strings("","",42).+in file /home/luc/souffle-haskell/tests/fixtures/edge_cases.dl [20:1-20:27])_");+[&](){+CREATE_OP_CONTEXT(rel_1_empty_strings_op_ctxt,rel_1_empty_strings->createContext());+Tuple<RamDomain,3> tuple{{ramBitCast(RamSigned(0)),ramBitCast(RamSigned(0)),ramBitCast(RamSigned(42))}};+rel_1_empty_strings->insert(tuple,READ_OP_CONTEXT(rel_1_empty_strings_op_ctxt));+}+();SignalHandler::instance()->setMsg(R"_(empty_strings("","abc",42).+in file /home/luc/souffle-haskell/tests/fixtures/edge_cases.dl [21:1-21:30])_");+[&](){+CREATE_OP_CONTEXT(rel_1_empty_strings_op_ctxt,rel_1_empty_strings->createContext());+Tuple<RamDomain,3> tuple{{ramBitCast(RamSigned(0)),ramBitCast(RamSigned(1)),ramBitCast(RamSigned(42))}};+rel_1_empty_strings->insert(tuple,READ_OP_CONTEXT(rel_1_empty_strings_op_ctxt));+}+();SignalHandler::instance()->setMsg(R"_(empty_strings("abc","",42).+in file /home/luc/souffle-haskell/tests/fixtures/edge_cases.dl [22:1-22:30])_");+[&](){+CREATE_OP_CONTEXT(rel_1_empty_strings_op_ctxt,rel_1_empty_strings->createContext());+Tuple<RamDomain,3> tuple{{ramBitCast(RamSigned(1)),ramBitCast(RamSigned(0)),ramBitCast(RamSigned(42))}};+rel_1_empty_strings->insert(tuple,READ_OP_CONTEXT(rel_1_empty_strings_op_ctxt));+}+();if (performIO) {+try {std::map<std::string, std::string> directiveMap({{"IO","file"},{"attributeNames","s\ts2\tn"},{"name","empty_strings"},{"operation","output"},{"output-dir","."},{"params","{\"records\": {}, \"relation\": {\"arity\": 3, \"auxArity\": 0, \"params\": [\"s\", \"s2\", \"n\"]}}"},{"types","{\"ADTs\": {}, \"records\": {}, \"relation\": {\"arity\": 3, \"auxArity\": 0, \"types\": [\"s:symbol\", \"s:symbol\", \"i:number\"]}}"}});+if (!outputDirectory.empty()) {directiveMap["output-dir"] = outputDirectory;}+IOSystem::getInstance().getWriter(directiveMap, symTable, recordTable)->writeAll(*rel_1_empty_strings);+} catch (std::exception& e) {std::cerr << e.what();exit(1);}+}+}+#ifdef _MSC_VER+#pragma warning(default: 4100)+#endif // _MSC_VER+#ifdef _MSC_VER+#pragma warning(disable: 4100)+#endif // _MSC_VER+void subroutine_1(const std::vector<RamDomain>& args, std::vector<RamDomain>& ret) {+if (performIO) {+try {std::map<std::string, std::string> directiveMap({{"IO","file"},{"attributeNames","s"},{"fact-dir","."},{"name","long_strings"},{"operation","input"},{"params","{\"records\": {}, \"relation\": {\"arity\": 1, \"auxArity\": 0, \"params\": [\"s\"]}}"},{"types","{\"ADTs\": {}, \"records\": {}, \"relation\": {\"arity\": 1, \"auxArity\": 0, \"types\": [\"s:symbol\"]}}"}});+if (!inputDirectory.empty()) {directiveMap["fact-dir"] = inputDirectory;}+IOSystem::getInstance().getReader(directiveMap, symTable, recordTable)->readAll(*rel_2_long_strings);+} catch (std::exception& e) {std::cerr << "Error loading data: " << e.what() << '\n';}+}+SignalHandler::instance()->setMsg(R"_(long_strings("long_string_from_DL:...............................................................................................................................................................................................................................................................................................end").+in file /home/luc/souffle-haskell/tests/fixtures/edge_cases.dl [25:1-25:328])_");+[&](){+CREATE_OP_CONTEXT(rel_2_long_strings_op_ctxt,rel_2_long_strings->createContext());+Tuple<RamDomain,1> tuple{{ramBitCast(RamSigned(2))}};+rel_2_long_strings->insert(tuple,READ_OP_CONTEXT(rel_2_long_strings_op_ctxt));+}+();if (performIO) {+try {std::map<std::string, std::string> directiveMap({{"IO","file"},{"attributeNames","s"},{"name","long_strings"},{"operation","output"},{"output-dir","."},{"params","{\"records\": {}, \"relation\": {\"arity\": 1, \"auxArity\": 0, \"params\": [\"s\"]}}"},{"types","{\"ADTs\": {}, \"records\": {}, \"relation\": {\"arity\": 1, \"auxArity\": 0, \"types\": [\"s:symbol\"]}}"}});+if (!outputDirectory.empty()) {directiveMap["output-dir"] = outputDirectory;}+IOSystem::getInstance().getWriter(directiveMap, symTable, recordTable)->writeAll(*rel_2_long_strings);+} catch (std::exception& e) {std::cerr << e.what();exit(1);}+}+}+#ifdef _MSC_VER+#pragma warning(default: 4100)+#endif // _MSC_VER+#ifdef _MSC_VER+#pragma warning(disable: 4100)+#endif // _MSC_VER+void subroutine_2(const std::vector<RamDomain>& args, std::vector<RamDomain>& ret) {+if (performIO) {+try {std::map<std::string, std::string> directiveMap({{"IO","file"},{"attributeNames","s"},{"fact-dir","."},{"name","unicode"},{"operation","input"},{"params","{\"records\": {}, \"relation\": {\"arity\": 1, \"auxArity\": 0, \"params\": [\"s\"]}}"},{"types","{\"ADTs\": {}, \"records\": {}, \"relation\": {\"arity\": 1, \"auxArity\": 0, \"types\": [\"s:symbol\"]}}"}});+if (!inputDirectory.empty()) {directiveMap["fact-dir"] = inputDirectory;}+IOSystem::getInstance().getReader(directiveMap, symTable, recordTable)->readAll(*rel_4_unicode);+} catch (std::exception& e) {std::cerr << "Error loading data: " << e.what() << '\n';}+}+SignalHandler::instance()->setMsg(R"_(unicode("∀").+in file /home/luc/souffle-haskell/tests/fixtures/edge_cases.dl [30:1-30:16])_");+[&](){+CREATE_OP_CONTEXT(rel_4_unicode_op_ctxt,rel_4_unicode->createContext());+Tuple<RamDomain,1> tuple{{ramBitCast(RamSigned(3))}};+rel_4_unicode->insert(tuple,READ_OP_CONTEXT(rel_4_unicode_op_ctxt));+}+();SignalHandler::instance()->setMsg(R"_(unicode("∀∀").+in file /home/luc/souffle-haskell/tests/fixtures/edge_cases.dl [31:1-31:19])_");+[&](){+CREATE_OP_CONTEXT(rel_4_unicode_op_ctxt,rel_4_unicode->createContext());+Tuple<RamDomain,1> tuple{{ramBitCast(RamSigned(4))}};+rel_4_unicode->insert(tuple,READ_OP_CONTEXT(rel_4_unicode_op_ctxt));+}+();if (performIO) {+try {std::map<std::string, std::string> directiveMap({{"IO","file"},{"attributeNames","s"},{"name","unicode"},{"operation","output"},{"output-dir","."},{"params","{\"records\": {}, \"relation\": {\"arity\": 1, \"auxArity\": 0, \"params\": [\"s\"]}}"},{"types","{\"ADTs\": {}, \"records\": {}, \"relation\": {\"arity\": 1, \"auxArity\": 0, \"types\": [\"s:symbol\"]}}"}});+if (!outputDirectory.empty()) {directiveMap["output-dir"] = outputDirectory;}+IOSystem::getInstance().getWriter(directiveMap, symTable, recordTable)->writeAll(*rel_4_unicode);+} catch (std::exception& e) {std::cerr << e.what();exit(1);}+}+}+#ifdef _MSC_VER+#pragma warning(default: 4100)+#endif // _MSC_VER+#ifdef _MSC_VER+#pragma warning(disable: 4100)+#endif // _MSC_VER+void subroutine_3(const std::vector<RamDomain>& args, std::vector<RamDomain>& ret) {+if (performIO) {+try {std::map<std::string, std::string> directiveMap({{"IO","file"},{"attributeNames","u\tn\tf"},{"fact-dir","."},{"name","no_strings"},{"operation","input"},{"params","{\"records\": {}, \"relation\": {\"arity\": 3, \"auxArity\": 0, \"params\": [\"u\", \"n\", \"f\"]}}"},{"types","{\"ADTs\": {}, \"records\": {}, \"relation\": {\"arity\": 3, \"auxArity\": 0, \"types\": [\"u:unsigned\", \"i:number\", \"f:float\"]}}"}});+if (!inputDirectory.empty()) {directiveMap["fact-dir"] = inputDirectory;}+IOSystem::getInstance().getReader(directiveMap, symTable, recordTable)->readAll(*rel_3_no_strings);+} catch (std::exception& e) {std::cerr << "Error loading data: " << e.what() << '\n';}+}+SignalHandler::instance()->setMsg(R"_(no_strings(42,-100,1.5).+in file /home/luc/souffle-haskell/tests/fixtures/edge_cases.dl [33:1-33:27])_");+[&](){+CREATE_OP_CONTEXT(rel_3_no_strings_op_ctxt,rel_3_no_strings->createContext());+Tuple<RamDomain,3> tuple{{ramBitCast(RamUnsigned(42)),ramBitCast(RamSigned(-100)),ramBitCast(RamFloat(1.5))}};+rel_3_no_strings->insert(tuple,READ_OP_CONTEXT(rel_3_no_strings_op_ctxt));+}+();SignalHandler::instance()->setMsg(R"_(no_strings(123,-456,3.14).+in file /home/luc/souffle-haskell/tests/fixtures/edge_cases.dl [34:1-34:29])_");+[&](){+CREATE_OP_CONTEXT(rel_3_no_strings_op_ctxt,rel_3_no_strings->createContext());+Tuple<RamDomain,3> tuple{{ramBitCast(RamUnsigned(123)),ramBitCast(RamSigned(-456)),ramBitCast(RamFloat(3.1400001))}};+rel_3_no_strings->insert(tuple,READ_OP_CONTEXT(rel_3_no_strings_op_ctxt));+}+();if (performIO) {+try {std::map<std::string, std::string> directiveMap({{"IO","file"},{"attributeNames","u\tn\tf"},{"name","no_strings"},{"operation","output"},{"output-dir","."},{"params","{\"records\": {}, \"relation\": {\"arity\": 3, \"auxArity\": 0, \"params\": [\"u\", \"n\", \"f\"]}}"},{"types","{\"ADTs\": {}, \"records\": {}, \"relation\": {\"arity\": 3, \"auxArity\": 0, \"types\": [\"u:unsigned\", \"i:number\", \"f:float\"]}}"}});+if (!outputDirectory.empty()) {directiveMap["output-dir"] = outputDirectory;}+IOSystem::getInstance().getWriter(directiveMap, symTable, recordTable)->writeAll(*rel_3_no_strings);+} catch (std::exception& e) {std::cerr << e.what();exit(1);}+}+}+#ifdef _MSC_VER+#pragma warning(default: 4100)+#endif // _MSC_VER+};+SouffleProgram *newInstance_edge_cases(){return new Sf_edge_cases;}+SymbolTable *getST_edge_cases(SouffleProgram *p){return &reinterpret_cast<Sf_edge_cases*>(p)->symTable;}++#ifdef __EMBEDDED_SOUFFLE__+class factory_Sf_edge_cases: public souffle::ProgramFactory {+SouffleProgram *newInstance() {+return new Sf_edge_cases();+};+public:+factory_Sf_edge_cases() : ProgramFactory("edge_cases"){}+};+extern "C" {+factory_Sf_edge_cases __factory_Sf_edge_cases_instance;+}+}+#else+}+int main(int argc, char** argv)+{+try{+souffle::CmdOptions opt(R"(edge_cases.dl)",+R"()",+R"()",+false,+R"()",+1);+if (!opt.parse(argc,argv)) return 1;+souffle::Sf_edge_cases obj;+#if defined(_OPENMP) +obj.setNumThreads(opt.getNumJobs());++#endif+obj.runAll(opt.getInputFileDir(), opt.getOutputFileDir());+return 0;+} catch(std::exception &e) { souffle::SignalHandler::instance()->error(e.what());}+}++#endif