fdilke/pyrites
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

correctly handling duplicate head entries

Browse Source
This commit is contained in:
Felix Dilke 2026-01-28 17:40:40 +00:00
parent 3c7c587045
commit 76bbd1e13e
2 changed files with 41 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
haskell-experiments/src/Datalog/NaiveDatabase.hs
View File

@ -120,7 +120,7 @@ withFactsAndRules facts = foldr (addRule . extractRule) (withFacts facts)
, _db = NaiveDatabase relationMap' constants' , _db = NaiveDatabase relationMap' constants'
} }
where where
variableNames = extractVariableNames terms variableNames = nub $ extractVariableNames terms
headTermToElement :: Term -> RuleElement headTermToElement :: Term -> RuleElement
headTermToElement (Var name) = headTermToElement (Var name) =
RuleElementVariable $ lookupVariable name variableNames RuleElementVariable $ lookupVariable name variableNames

62
haskell-experiments/test/Test/Datalog/NaiveDatabaseSpec.hs
View File

@ -25,11 +25,10 @@ spec :: Spec
spec = do spec = do
describe "NaiveDatabase operations" do describe "NaiveDatabase operations" do
it "can ingest facts into relations & a universe" $ do it "can ingest facts into relations & a universe" $ do
let db = let db = NaiveDatabase.withFacts
NaiveDatabase.withFacts [ "parent(\"alice\", \"bob\")."
[ "parent(\"alice\", \"bob\")." , "parent(\"bob\", \"carol\")."
, "parent(\"bob\", \"carol\")." ]
]
constants db constants db
`shouldBe` Set.fromList (Sym <$> ["alice", "bob", "carol"]) `shouldBe` Set.fromList (Sym <$> ["alice", "bob", "carol"])
relations db relations db
@ -40,15 +39,14 @@ spec = do
) )
] ]
it "can ingest facts and rules" do it "can ingest facts and rules" do
let db = let db = NaiveDatabase.withFactsAndRules
NaiveDatabase.withFactsAndRules [ "parent(\"alice\", \"bob\")."
[ "parent(\"alice\", \"bob\")." , "parent(\"bob\", \"carol\")."
, "parent(\"bob\", \"carol\")." ]
] [
[ "ancestor(X,Y) :- parent(X,Z), ancestor(Z,Y)."
"ancestor(X,Y) :- parent(X,Z), ancestor(Z,Y)." , "ancestor(X,Y) :- parent(X,Y)."
, "ancestor(X,Y) :- parent(X,Y)." ]
]
parentRelation = parentRelation =
Relation Relation
{ _name = "parent" { _name = "parent"
@ -111,19 +109,39 @@ spec = do
, _rules = [ancestorRule] , _rules = [ancestorRule]
} }
relations db relations db
`shouldBe` Map.fromList `shouldBe` Map.singleton "ancestor" ancestorRelation
[ ("ancestor", ancestorRelation)
]
constants db constants db
`shouldBe` Set.fromList (Sym <$> ["patriarch"]) `shouldBe` Set.fromList (Sym <$> ["patriarch"])
it "can do basic queries" do it "can ingest facts and rules with duplicate head entries" do
let db = let db =
NaiveDatabase.withFacts NaiveDatabase.withFactsAndRules
[ "parent(\"alice\", \"bob\")." []
, "parent(\"bob\", \"carol\")." ["equivalent(Q,Q) :- ."]
] equivalentRule =
RelationRule
{ headVariables = ["Q"]
, bodyElements = []
}
equivalentRelation =
Relation
{ _arity = 2
, _name = "equivalent"
, _tuples = Set.empty
, _rules = [equivalentRule]
}
relations db
`shouldBe` Map.singleton "equivalent" equivalentRelation
constants db
`shouldBe` Set.empty
it "can do basic queries" do
let db = NaiveDatabase.withFacts
[ "parent(\"alice\", \"bob\")."
, "parent(\"bob\", \"carol\")."
]
query db "?- parent(alice,X)." `shouldBe` "#NYI" -- ideally, 'bob' query db "?- parent(alice,X)." `shouldBe` "#NYI" -- ideally, 'bob'
(<<$>>) :: (Functor f1, Functor f2) => (a -> b) -> f1 (f2 a) -> f1 (f2 b) (<<$>>) :: (Functor f1, Functor f2) => (a -> b) -> f1 (f2 a) -> f1 (f2 b)