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

digestHead refactor

Browse Source
This commit is contained in:
Felix Dilke 2026-01-30 11:00:24 +00:00
parent d8d2c51dec
commit 6dda089bfe
1 changed files with 5 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -126,10 +126,6 @@ data RuleContext = RuleContext
, _db :: NaiveDatabase , _db :: NaiveDatabase
} }
withFactsAndRules :: [Text] -> [Text] -> NaiveDatabase
withFactsAndRules facts = foldr (addRule . extractRule) (withFacts facts)
where
digestHead :: NaiveDatabase -> Relation -> Literal -> RuleContext digestHead :: NaiveDatabase -> Relation -> Literal -> RuleContext
digestHead db relation (Literal neg relationName terms) = digestHead db relation (Literal neg relationName terms) =
RuleContext RuleContext
@ -137,7 +133,7 @@ digestHead db relation (Literal neg relationName terms) =
, _variableNames = variableNames , _variableNames = variableNames
, _headEntries = entries' , _headEntries = entries'
, _bodyConstraints = [] , _bodyConstraints = []
, _db = NaiveDatabase relationMap' constants' , _db = insertRelation (addConstants db extraConstants) relation
} }
where where
variableNames = nub $ extractVariableNames terms variableNames = nub $ extractVariableNames terms
@ -145,16 +141,12 @@ digestHead db relation (Literal neg relationName terms) =
headTermToElement (Var name) = headTermToElement (Var name) =
RuleElementVariable $ lookupVariable name variableNames RuleElementVariable $ lookupVariable name variableNames
headTermToElement constant = RuleElementConstant constant headTermToElement constant = RuleElementConstant constant
-- db' = insertRelation db relation
relationMap :: Map RelationId Relation = relations db
relationMap' = Map.insert relationName relation relationMap
extraVariables = headTermToElement <$> terms extraVariables = headTermToElement <$> terms
entries' = nub extraVariables entries' = nub extraVariables
extraConstants = mapMaybe extractConstant entries' where extraConstants = Set.fromList $ mapMaybe extractConstant entries' where
extractConstant :: RuleElement -> Maybe Constant extractConstant :: RuleElement -> Maybe Constant
extractConstant (RuleElementConstant constant) = Just constant extractConstant (RuleElementConstant constant) = Just constant
extractConstant _ = Nothing extractConstant _ = Nothing
constants' = Set.union (constants db) $ Set.fromList extraConstants
digestBody :: Literal -> RuleContext -> RuleContext digestBody :: Literal -> RuleContext -> RuleContext
digestBody (Literal neg subRelationName subTerms) context = digestBody (Literal neg subRelationName subTerms) context =
context { context {
@ -185,6 +177,9 @@ lookupVariable varName variableNames =
Just index -> index Just index -> index
Nothing -> throw $ VariableLookupException varName variableNames Nothing -> throw $ VariableLookupException varName variableNames
withFactsAndRules :: [Text] -> [Text] -> NaiveDatabase
withFactsAndRules facts = foldr (addRule . extractRule) (withFacts facts)
query :: NaiveDatabase -> Text -> Text query :: NaiveDatabase -> Text -> Text
query db qText = query db qText =
case parseDatalog qText of case parseDatalog qText of