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

delinting

Browse Source
This commit is contained in:
Felix Dilke 2026-02-11 18:02:15 +00:00
parent 6255e7e4f2
commit d17b33567d
5 changed files with 15 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
haskell-experiments/src/Datalog/InMemoryDB.hs
View File

@ -49,7 +49,7 @@ instance DatalogDB InMemoryDB where
relationNames db = keys (_relations db) relationNames db = keys (_relations db)
allConstants :: InMemoryDB -> Set Constant allConstants :: InMemoryDB -> Set Constant
allConstants db = _constants db allConstants = _constants
withFacts :: [Text] -> InMemoryDB withFacts :: [Text] -> InMemoryDB
withFacts = withFacts =

10
haskell-experiments/src/Datalog/NaiveQE.hs
View File

@ -77,23 +77,21 @@ computeHerbrand db =
where where
(facts, wasChanged) = newFacts (facts, wasChanged) = newFacts
latestRelation = facts Map.! (_name relation) latestRelation = facts Map.! (_name relation)
knownTuples :: Set [Constant] = knownTuples :: Set [Constant] = _tuples latestRelation
_tuples $ latestRelation
extraTuples = do extraTuples = do
varmap <- allMaps headVars (Set.toList $ allConstants db) varmap <- allMaps headVars (Set.toList $ allConstants db)
let tuple = (\name -> varmap Map.! name) <$> headVars let tuple = (varmap Map.!) <$> headVars
guard $ not $ Set.member tuple knownTuples guard $ not $ Set.member tuple knownTuples
let satisfied :: RuleBodyElement -> Bool let satisfied :: RuleBodyElement -> Bool
satisfied (RuleBodyElement subRelationId ruleElements) = satisfied (RuleBodyElement subRelationId ruleElements) =
let subRelation = facts Map.! subRelationId let subRelation = facts Map.! subRelationId
mappedTuple = ruleElements <&> \ruleElement -> mappedTuple = ruleElements <&> \case
case ruleElement of
RuleElementConstant constant -> constant RuleElementConstant constant -> constant
RuleElementVariable index -> tuple !! index RuleElementVariable index -> tuple !! index
in Set.member mappedTuple (_tuples subRelation) in Set.member mappedTuple (_tuples subRelation)
guard $ all satisfied bodyElements guard $ all satisfied bodyElements
return tuple return tuple
stillChanged = wasChanged || (not (null extraTuples)) stillChanged = wasChanged || not (null extraTuples)
updatedTuples = Set.union knownTuples $ Set.fromList extraTuples updatedTuples = Set.union knownTuples $ Set.fromList extraTuples
updatedFacts = Map.insert (_name relation) ( updatedFacts = Map.insert (_name relation) (
latestRelation { _tuples = updatedTuples }) facts latestRelation { _tuples = updatedTuples }) facts

8
haskell-experiments/test/Test/Datalog/DigestedQuerySpec.hs
View File

@ -11,8 +11,12 @@ module Test.Datalog.DigestedQuerySpec where
import Test.Hspec import Test.Hspec
import Datalog.DatalogParser import Datalog.DatalogParser
import Datalog.DigestedQuery (DigestedQuery(..), DigestedQueryCondition(..), DigestedQueryEntry(..)) import Datalog.DigestedQuery
import Datalog.DigestedQuery (digestQuery) ( DigestedQuery(..),
DigestedQueryCondition(..),
DigestedQueryEntry(..),
digestQuery )
spec :: Spec spec :: Spec
spec = do spec = do

5
haskell-experiments/test/Test/Datalog/NaiveQESpec.hs
View File

@ -16,10 +16,7 @@ module Test.Datalog.NaiveQESpec where
import Test.Hspec import Test.Hspec
import Datalog.InMemoryDB (InMemoryDB) import Datalog.InMemoryDB (InMemoryDB)
import qualified Datalog.InMemoryDB as InMemoryDB import qualified Datalog.InMemoryDB as InMemoryDB
import Datalog.QueryEngine (QueryEngine(query)) import Datalog.QueryEngine (QueryEngine(query), queryEngine)
import qualified Datalog.QueryEngine as QueryEngine
import qualified Datalog.NaiveQE as NaiveQE
import Datalog.QueryEngine (queryEngine)
import Datalog.NaiveQE import Datalog.NaiveQE
spec :: Spec spec :: Spec

2
haskell-experiments/test/Test/Utility/UtilitySpec.hs
View File

@ -26,7 +26,7 @@ spec = do
allMaps @Int @Int [] [1] `shouldBe` [Map.empty] allMaps @Int @Int [] [1] `shouldBe` [Map.empty]
allMaps @Int @Int [1] [] `shouldBe` [] allMaps @Int @Int [1] [] `shouldBe` []
allMaps [1] [True] `shouldBe` [Map.singleton 1 True] allMaps [1] [True] `shouldBe` [Map.singleton 1 True]
uncharacteristic <$> (allMaps [1, 2, 3] [True, False]) `shouldMatchList` [ uncharacteristic <$> allMaps [1, 2, 3] [True, False] `shouldMatchList` [
[1,2,3], [1,2], [1,3], [1], [2, 3], [2], [3], [] [1,2,3], [1,2], [1,3], [1], [2, 3], [2], [3], []
] ]