diff --git a/haskell-experiments/src/Datalog/NaiveQE.hs b/haskell-experiments/src/Datalog/NaiveQE.hs index c9e54dc..4f1124e 100644 --- a/haskell-experiments/src/Datalog/NaiveQE.hs +++ b/haskell-experiments/src/Datalog/NaiveQE.hs @@ -21,6 +21,9 @@ import Utility.Utility import Control.Monad(guard) import Data.Set (Set) import Data.Set qualified as Set +import Data.Functor ((<&>)) +import Data.List (nub) +import qualified Data.List.NonEmpty as List data (DatalogDB db) => NaiveQE db = NaiveQE { @@ -68,20 +71,30 @@ computeHerbrand db = foldr amalgamateRule newFacts (_rules relation) where amalgamateRule :: RelationRule -> NewFacts -> NewFacts amalgamateRule (RelationRule headVars bodyElements) newFacts = - newFacts where - (facts, changed) = newFacts + if stillChanged then + (updatedFacts, True) + else newFacts + where + (facts, wasChanged) = newFacts + latestRelation = facts Map.! (_name relation) knownTuples :: Set [Constant] = - _tuples $ facts Map.! (_name relation) + _tuples $ latestRelation extraTuples = do varmap <- allMaps headVars (Set.toList $ allConstants db) let tuple = (\name -> varmap Map.! name) <$> headVars guard $ not $ Set.member tuple knownTuples - let twig :: Int -> Int -> Int - twig x y = x + y - satisfied :: RuleBodyElement -> Bool - satisfied (RuleBodyElement subRelationId ruleElements) = all (satisfiedSub (facts Map.! subRelationId)) ruleElements - satisfiedSub :: Relation -> RuleElement -> Bool - satisfiedSub subRelation ruleElement = True + let satisfied :: RuleBodyElement -> Bool + satisfied (RuleBodyElement subRelationId ruleElements) = + let subRelation = facts Map.! subRelationId + mappedTuple = ruleElements <&> \ruleElement -> + case ruleElement of + RuleElementConstant constant -> constant + RuleElementVariable index -> tuple !! index + in Set.member mappedTuple (_tuples subRelation) guard $ all satisfied bodyElements - return varmap + return tuple + stillChanged = wasChanged || (not (null extraTuples)) + updatedTuples = Set.union knownTuples $ Set.fromList extraTuples + updatedFacts = Map.insert (_name relation) ( + latestRelation { _tuples = updatedTuples }) facts