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 +31/−2
- README.md +6/−0
- benchmarks/bench.hs +183/−0
- benchmarks/fixtures/bench.cpp +891/−0
- cbits/souffle.cpp +418/−110
- cbits/souffle.h +16/−144
- lib/Language/Souffle/Class.hs +12/−4
- lib/Language/Souffle/Compiled.hs +351/−107
- lib/Language/Souffle/Experimental.hs +0/−1104
- lib/Language/Souffle/Internal.hs +29/−109
- lib/Language/Souffle/Internal/Bindings.hs +21/−194
- lib/Language/Souffle/Internal/Constraints.hs +5/−2
- lib/Language/Souffle/Interpreted.hs +28/−3
- lib/Language/Souffle/Marshal.hs +19/−4
- souffle-haskell.cabal +84/−7
- tests/Test/Language/Souffle/CompiledSpec.hs +34/−0
- tests/Test/Language/Souffle/Experimental/Fixtures.hs +0/−31
- tests/Test/Language/Souffle/Experimental/FixturesCompiled.hs +0/−22
- tests/Test/Language/Souffle/ExperimentalSpec.hs +0/−1117
- tests/Test/Language/Souffle/MarshalSpec.hs +344/−46
- tests/fixtures/edge_cases.cpp +698/−0
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