added an API to extract the constants
This commit is contained in:
parent
dfdb43699e
commit
6848663caf
@ -61,6 +61,7 @@ class DatalogDB db where
|
|||||||
lookupRelation :: db -> Text -> Maybe Relation
|
lookupRelation :: db -> Text -> Maybe Relation
|
||||||
insertRelation :: db -> Relation -> db
|
insertRelation :: db -> Relation -> db
|
||||||
addConstants :: db -> Set Constant -> db
|
addConstants :: db -> Set Constant -> db
|
||||||
|
allConstants :: db -> Set Constant
|
||||||
|
|
||||||
lookupRelationArity :: DatalogDB db => Text -> db -> Int -> Set [Constant] -> Relation
|
lookupRelationArity :: DatalogDB db => Text -> db -> Int -> Set [Constant] -> Relation
|
||||||
lookupRelationArity relationName db newArity tuples =
|
lookupRelationArity relationName db newArity tuples =
|
||||||
|
|||||||
@ -48,6 +48,9 @@ instance DatalogDB InMemoryDB where
|
|||||||
relationNames :: InMemoryDB -> [Text]
|
relationNames :: InMemoryDB -> [Text]
|
||||||
relationNames db = keys (_relations db)
|
relationNames db = keys (_relations db)
|
||||||
|
|
||||||
|
allConstants :: InMemoryDB -> Set Constant
|
||||||
|
allConstants db = _constants db
|
||||||
|
|
||||||
withFacts :: [Text] -> InMemoryDB
|
withFacts :: [Text] -> InMemoryDB
|
||||||
withFacts =
|
withFacts =
|
||||||
foldr (addFact . extractFact) emptyDB
|
foldr (addFact . extractFact) emptyDB
|
||||||
|
|||||||
@ -17,6 +17,7 @@ import Datalog.DatalogDB
|
|||||||
import Datalog.DatalogParser
|
import Datalog.DatalogParser
|
||||||
import Control.Exception
|
import Control.Exception
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
|
import Utility.Utility
|
||||||
|
|
||||||
data (DatalogDB db) => NaiveQE db = NaiveQE
|
data (DatalogDB db) => NaiveQE db = NaiveQE
|
||||||
{
|
{
|
||||||
@ -64,5 +65,6 @@ computeHerbrand db =
|
|||||||
foldr amalgamateRule newFacts (_rules relation) where
|
foldr amalgamateRule newFacts (_rules relation) where
|
||||||
amalgamateRule :: RelationRule -> NewFacts -> NewFacts
|
amalgamateRule :: RelationRule -> NewFacts -> NewFacts
|
||||||
amalgamateRule (RelationRule headVars body) newFacts =
|
amalgamateRule (RelationRule headVars body) newFacts =
|
||||||
|
-- allMaps headVars (allConstants db)
|
||||||
newFacts
|
newFacts
|
||||||
|
|
||||||
|
|||||||
@ -31,7 +31,7 @@ spec = do
|
|||||||
[ "parent(\"alice\", \"bob\")."
|
[ "parent(\"alice\", \"bob\")."
|
||||||
, "parent(\"bob\", \"carol\")."
|
, "parent(\"bob\", \"carol\")."
|
||||||
]
|
]
|
||||||
_constants db
|
allConstants db
|
||||||
`shouldBe` Set.fromList (Sym <$> ["alice", "bob", "carol"])
|
`shouldBe` Set.fromList (Sym <$> ["alice", "bob", "carol"])
|
||||||
_relations db
|
_relations db
|
||||||
`shouldBe` Map.fromList
|
`shouldBe` Map.fromList
|
||||||
@ -79,7 +79,7 @@ spec = do
|
|||||||
, _rules = [ancestorRule, ancestorRule2]
|
, _rules = [ancestorRule, ancestorRule2]
|
||||||
}
|
}
|
||||||
|
|
||||||
_constants db
|
allConstants db
|
||||||
`shouldBe` Set.fromList (Sym <$> ["alice", "bob", "carol"])
|
`shouldBe` Set.fromList (Sym <$> ["alice", "bob", "carol"])
|
||||||
|
|
||||||
_relations db
|
_relations db
|
||||||
@ -109,7 +109,7 @@ spec = do
|
|||||||
_relations db
|
_relations db
|
||||||
`shouldBe` Map.singleton "ancestor" ancestorRelation
|
`shouldBe` Map.singleton "ancestor" ancestorRelation
|
||||||
|
|
||||||
_constants db
|
allConstants db
|
||||||
`shouldBe` Set.fromList (Sym <$> ["patriarch"])
|
`shouldBe` Set.fromList (Sym <$> ["patriarch"])
|
||||||
Set.fromList (relationNames db) `shouldBe` Set.fromList [ "ancestor" ]
|
Set.fromList (relationNames db) `shouldBe` Set.fromList [ "ancestor" ]
|
||||||
|
|
||||||
@ -133,7 +133,7 @@ spec = do
|
|||||||
_relations db
|
_relations db
|
||||||
`shouldBe` Map.singleton "equivalent" equivalentRelation
|
`shouldBe` Map.singleton "equivalent" equivalentRelation
|
||||||
|
|
||||||
_constants db
|
allConstants db
|
||||||
`shouldBe` Set.empty
|
`shouldBe` Set.empty
|
||||||
relationNames db `shouldBe` [ "equivalent" ]
|
relationNames db `shouldBe` [ "equivalent" ]
|
||||||
|
|
||||||
@ -174,7 +174,7 @@ spec = do
|
|||||||
_relations db
|
_relations db
|
||||||
`shouldBe` Map.singleton "equivalent" equivalentRelation
|
`shouldBe` Map.singleton "equivalent" equivalentRelation
|
||||||
|
|
||||||
_constants db
|
allConstants db
|
||||||
`shouldBe` Set.empty
|
`shouldBe` Set.empty
|
||||||
Set.fromList (relationNames db) `shouldBe` Set.fromList [ "equivalent" ]
|
Set.fromList (relationNames db) `shouldBe` Set.fromList [ "equivalent" ]
|
||||||
|
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user