creating a list of head variables for a rule

This commit is contained in:
Felix Dilke 2026-01-27 14:55:52 +00:00
parent 2102767367
commit 210cae7ca6
2 changed files with 26 additions and 6 deletions

View File

@ -195,11 +195,11 @@ withFactsAndRules facts rules =
toConstraintElement :: RuleElement -> ConstraintElement toConstraintElement :: RuleElement -> ConstraintElement
toConstraintElement (RuleElementConstant constant) = ConstraintElementConstant constant toConstraintElement (RuleElementConstant constant) = ConstraintElementConstant constant
toConstraintElement (RuleElementVariable varName) = ConstraintElementIndex (varIndex varName) toConstraintElement (RuleElementVariable varName) = ConstraintElementIndex (varIndex varName)
extractVarName :: RuleElement -> Text extractVarName :: RuleElement -> Maybe Text
extractVarName (RuleElementVariable varName) = varName extractVarName (RuleElementVariable varName) = Just varName
extractVarName (RuleElementConstant constant) = throw $ UnexpectedConstantException constant extractVarName (RuleElementConstant constant) = Nothing
newRule = RelationRule { newRule = RelationRule {
headVariables = extractVarName <$> variables', headVariables = catMaybes $ extractVarName <$> variables',
bodyElements = fromBodyConstraint <$> (_bodyConstraints context'') bodyElements = fromBodyConstraint <$> (_bodyConstraints context'')
} where } where
fromBodyConstraint :: BodyConstraint -> RuleBodyElement fromBodyConstraint :: BodyConstraint -> RuleBodyElement

View File

@ -22,8 +22,6 @@ import qualified Data.Map as Map
spec :: Spec spec :: Spec
spec = do spec = do
describe "NaiveDatabase operations" $ do describe "NaiveDatabase operations" $ do
it "..." $ do
1 `shouldBe` (1 :: Int)
it "can ingest facts into relations & a universe" $ do it "can ingest facts into relations & a universe" $ do
let db = NaiveDatabase.withFacts let db = NaiveDatabase.withFacts
[ "parent(\"alice\", \"bob\")." [ "parent(\"alice\", \"bob\")."
@ -79,6 +77,28 @@ spec = do
("parent", parentRelation ) ("parent", parentRelation )
] ]
it "can ingest facts and rules with constants" $ do
let db = NaiveDatabase.withFactsAndRules
[]
[ "ancestor(X,\"patriarch\") :- ." ]
let ancestorRule = RelationRule {
headVariables = [ "X" ],
bodyElements = []
}
let ancestorRelation = Relation {
_arity = 2,
_name = "ancestor",
_tuples = Set.empty,
_rules = [ ancestorRule ]
}
relations db `shouldBe`
Map.fromList [
("ancestor", ancestorRelation)
]
constants db `shouldBe`
(Set.fromList $ Sym <$> ["patriarch"])
it "can do basic queries" $ do it "can do basic queries" $ do
let db = NaiveDatabase.withFacts let db = NaiveDatabase.withFacts
[ "parent(\"alice\", \"bob\")." [ "parent(\"alice\", \"bob\")."