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

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

@ -25,8 +25,7 @@ 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\")."
] ]
@ -40,8 +39,7 @@ 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\")."
] ]
@ -111,16 +109,36 @@ 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
[]
["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(\"alice\", \"bob\")."
, "parent(\"bob\", \"carol\")." , "parent(\"bob\", \"carol\")."
] ]