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

eliminated duplicate variable lookup

Browse Source
This commit is contained in:
Felix Dilke 2026-01-28 11:55:08 +00:00
parent f2e68a455e
commit fb2699624f
1 changed files with 8 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -127,9 +127,7 @@ withFactsAndRules facts = foldr (addRule . extractRule) (withFacts facts)
variableNames = extractVariableNames terms
headTermToElement :: Term -> RuleElement
headTermToElement (Var name) =
case (elemIndex name) variableNames of
Just index -> RuleElementVariable index
Nothing -> throw $ VariableLookupException name variableNames
RuleElementVariable $ lookupVariable name variableNames
headTermToElement constant = RuleElementConstant constant
relationMap :: Map RelationId Relation = relations db
relationMap' = Map.insert relationName relation relationMap
@ -155,30 +153,23 @@ withFactsAndRules facts = foldr (addRule . extractRule) (withFacts facts)
subRelation = lookupRelation subRelationName relationMap newArity Set.empty
relationMap :: Map RelationId Relation = relations (_db context)
relationMap' = Map.insert subRelationName subRelation relationMap
-- extraVariables = bodyTermToElement <$> terms where
-- bodyTermToElement :: Term -> RuleElement
-- bodyTermToElement (Var name) =
-- case (elemIndex name) variableNames of
-- Just index -> RuleElementVariable index
-- Nothing -> throw $ VariableLookupException name variableNames
-- bodyTermToElement constant = RuleElementConstant constant
extraConstants = mapMaybe constantFromTerm subTerms where
constantFromTerm :: Term -> Maybe Constant
constantFromTerm (Var _) = Nothing
constantFromTerm constant = Just constant
-- variables' = nub $ _headEntries context ++ extraVariables
constants' = Set.union (constants (_db context)) $ Set.fromList extraConstants
constraints = _bodyConstraints context
newConstraint = BodyConstraint subRelation subRuleElements where
subRuleElements = toRuleElement <$> subTerms
toRuleElement :: Term -> RuleElement
toRuleElement (Var varName) = RuleElementVariable $ lookupVariable varName
toRuleElement (Var varName) = RuleElementVariable $ lookupVariable varName variableNames
toRuleElement constant = RuleElementConstant constant
lookupVariable :: Text -> Int
lookupVariable varName =
case (elemIndex varName) variableNames of
Just index -> index
Nothing -> throw $ VariableLookupException varName variableNames
lookupVariable :: Text -> [Text] -> Int
lookupVariable varName variableNames =
case (elemIndex varName) variableNames of
Just index -> index
Nothing -> throw $ VariableLookupException varName variableNames
addRule :: (Literal, [Literal]) -> NaiveDatabase -> NaiveDatabase
addRule (ruleHead, body) db =