diff --git a/haskell-experiments/src/Datalog/DatalogDB.hs b/haskell-experiments/src/Datalog/DatalogDB.hs index 2e2f6ff..598370b 100644 --- a/haskell-experiments/src/Datalog/DatalogDB.hs +++ b/haskell-experiments/src/Datalog/DatalogDB.hs @@ -61,6 +61,7 @@ class DatalogDB db where lookupRelation :: db -> Text -> Maybe Relation insertRelation :: db -> Relation -> db addConstants :: db -> Set Constant -> db + allConstants :: db -> Set Constant lookupRelationArity :: DatalogDB db => Text -> db -> Int -> Set [Constant] -> Relation lookupRelationArity relationName db newArity tuples = diff --git a/haskell-experiments/src/Datalog/InMemoryDB.hs b/haskell-experiments/src/Datalog/InMemoryDB.hs index ca5a91f..e90ef8c 100644 --- a/haskell-experiments/src/Datalog/InMemoryDB.hs +++ b/haskell-experiments/src/Datalog/InMemoryDB.hs @@ -48,6 +48,9 @@ instance DatalogDB InMemoryDB where relationNames :: InMemoryDB -> [Text] relationNames db = keys (_relations db) + allConstants :: InMemoryDB -> Set Constant + allConstants db = _constants db + withFacts :: [Text] -> InMemoryDB withFacts = foldr (addFact . extractFact) emptyDB diff --git a/haskell-experiments/src/Datalog/NaiveQE.hs b/haskell-experiments/src/Datalog/NaiveQE.hs index 07da548..226be63 100644 --- a/haskell-experiments/src/Datalog/NaiveQE.hs +++ b/haskell-experiments/src/Datalog/NaiveQE.hs @@ -17,6 +17,7 @@ import Datalog.DatalogDB import Datalog.DatalogParser import Control.Exception import Data.Maybe +import Utility.Utility data (DatalogDB db) => NaiveQE db = NaiveQE { @@ -64,5 +65,6 @@ computeHerbrand db = foldr amalgamateRule newFacts (_rules relation) where amalgamateRule :: RelationRule -> NewFacts -> NewFacts amalgamateRule (RelationRule headVars body) newFacts = + -- allMaps headVars (allConstants db) newFacts diff --git a/haskell-experiments/test/Test/Datalog/InMemoryDBSpec.hs b/haskell-experiments/test/Test/Datalog/InMemoryDBSpec.hs index dc42644..b4b4286 100644 --- a/haskell-experiments/test/Test/Datalog/InMemoryDBSpec.hs +++ b/haskell-experiments/test/Test/Datalog/InMemoryDBSpec.hs @@ -31,7 +31,7 @@ spec = do [ "parent(\"alice\", \"bob\")." , "parent(\"bob\", \"carol\")." ] - _constants db + allConstants db `shouldBe` Set.fromList (Sym <$> ["alice", "bob", "carol"]) _relations db `shouldBe` Map.fromList @@ -79,7 +79,7 @@ spec = do , _rules = [ancestorRule, ancestorRule2] } - _constants db + allConstants db `shouldBe` Set.fromList (Sym <$> ["alice", "bob", "carol"]) _relations db @@ -109,7 +109,7 @@ spec = do _relations db `shouldBe` Map.singleton "ancestor" ancestorRelation - _constants db + allConstants db `shouldBe` Set.fromList (Sym <$> ["patriarch"]) Set.fromList (relationNames db) `shouldBe` Set.fromList [ "ancestor" ] @@ -133,7 +133,7 @@ spec = do _relations db `shouldBe` Map.singleton "equivalent" equivalentRelation - _constants db + allConstants db `shouldBe` Set.empty relationNames db `shouldBe` [ "equivalent" ] @@ -174,7 +174,7 @@ spec = do _relations db `shouldBe` Map.singleton "equivalent" equivalentRelation - _constants db + allConstants db `shouldBe` Set.empty Set.fromList (relationNames db) `shouldBe` Set.fromList [ "equivalent" ]