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

minor fix

Browse Source
This commit is contained in:
Felix Dilke 2026-01-27 18:01:30 +00:00
parent 429d64ee73
commit 43e7d8afed
1 changed files with 6 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -116,8 +116,7 @@ maybeConstant (RuleElementConstant constant) = Just constant
maybeConstant _ = Nothing maybeConstant _ = Nothing
withFactsAndRules :: [Text] -> [Text] -> NaiveDatabase withFactsAndRules :: [Text] -> [Text] -> NaiveDatabase
withFactsAndRules facts = withFactsAndRules facts = foldr (addRule . extractRule) (withFacts facts)
foldr (addRule . extractRule) (withFacts facts)
where where
extractRule :: Text -> (Literal, [Literal]) extractRule :: Text -> (Literal, [Literal])
extractRule ruleText = extractRule ruleText =
@ -179,18 +178,18 @@ withFactsAndRules facts =
terms = arguments ruleHead terms = arguments ruleHead
newArity = length terms newArity = length terms
relation = lookupRelation relationName (relations db) newArity Set.empty relation = lookupRelation relationName (relations db) newArity Set.empty
context' = digestHead db relation ruleHead context = digestHead db relation ruleHead
context'' = foldl digestBody context' body context' = foldl digestBody context body
db' = _db context'' db' = _db context'
relationMap = relations db' relationMap = relations db'
variables' = _headEntries context'' variables' = _headEntries context'
extractVarName :: RuleElement -> Maybe Text extractVarName :: RuleElement -> Maybe Text
extractVarName (RuleElementVariable varName) = Just varName extractVarName (RuleElementVariable varName) = Just varName
extractVarName (RuleElementConstant constant) = Nothing extractVarName (RuleElementConstant constant) = Nothing
newRule = newRule =
RelationRule RelationRule
{ headVariables = mapMaybe extractVarName variables' { headVariables = mapMaybe extractVarName variables'
, bodyElements = fromBodyConstraint <$> _bodyConstraints context'' , bodyElements = fromBodyConstraint <$> _bodyConstraints context'
} }
where where
fromBodyConstraint :: BodyConstraint -> RuleBodyElement fromBodyConstraint :: BodyConstraint -> RuleBodyElement