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

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

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