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

tidier digestHead

Browse Source
This commit is contained in:
Felix Dilke 2026-01-30 11:24:44 +00:00
parent 136412a4dd
commit 55b12f5c00
1 changed files with 13 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -126,6 +126,14 @@ data (DatalogDB db) => RuleContext db = RuleContext
, _db :: db
}
-- | equivalent(Q,Q) :- . |
-- could be equivalent(Q, 3, 'zzz, Q, R)
-- terms = Var Q, Num 3, Sym zzz, Var Q, Var R
-- want to convert this to:
-- (need constants 3, 'zzz)
-- entries = [RuleElement] = (RuleElement 0), RuleElement Num 3, RuleElement Sym zzz, (RuleElement 0), (RuleElement 1)
-- variableNames = ["Q" "R"]
digestHead :: forall db . (DatalogDB db) => db -> Relation -> Literal -> RuleContext db
digestHead db relation (Literal neg relationName terms) =
RuleContext
@ -137,12 +145,7 @@ digestHead db relation (Literal neg relationName terms) =
}
where
variableNames = nub $ extractVariableNames terms
headTermToElement :: Term -> RuleElement
headTermToElement (Var name) =
RuleElementVariable $ lookupVariable name variableNames
headTermToElement constant = RuleElementConstant constant
extraVariables = headTermToElement <$> terms
entries' = nub extraVariables
entries' = nub $ (headTermToElement variableNames) <$> terms
extraConstants = Set.fromList $ mapMaybe extractConstant entries' where
extractConstant :: RuleElement -> Maybe Constant
extractConstant (RuleElementConstant constant) = Just constant
@ -176,6 +179,10 @@ lookupVariable varName variableNames =
case elemIndex varName variableNames of
Just index -> index
Nothing -> throw $ VariableLookupException varName variableNames
headTermToElement :: [Text] -> Term -> RuleElement
headTermToElement variableNames (Var name) =
RuleElementVariable $ lookupVariable name variableNames
headTermToElement variableNames constant = RuleElementConstant constant
withFactsAndRules :: [Text] -> [Text] -> NaiveDatabase
withFactsAndRules facts = foldr (addRule . extractRule) (withFacts facts)