added an API to extract the constants

This commit is contained in:
Felix Dilke 2026-02-10 14:55:45 +00:00
parent dfdb43699e
commit 6848663caf
4 changed files with 11 additions and 5 deletions

View File

@ -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 =

View File

@ -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

View File

@ -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

View File

@ -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" ]