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

sorting out the lookup functions

Browse Source
This commit is contained in:
Felix Dilke 2026-01-30 16:16:06 +00:00
parent 05b6aefabe
commit 970afa2b61
2 changed files with 30 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
haskell-experiments/src/Datalog/DatalogDB.hs
View File

@ -2,6 +2,7 @@
{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# LANGUAGE BlockArguments #-}
module Datalog.DatalogDB where module Datalog.DatalogDB where
@ -70,6 +71,16 @@ lookupRelationArity relationName db newArity tuples =
in relation { _tuples = newTuples } in relation { _tuples = newTuples }
else throw $ BadArityException relationName newArity else throw $ BadArityException relationName newArity
lookupRelationArity0 :: DatalogDB db => Text -> db -> Int -> (Relation -> Relation) -> db
lookupRelationArity0 relationName db newArity update =
insertRelation db (update newRelation)
where
newRelation = case lookupRelation db relationName of
Nothing -> Relation relationName newArity Set.empty []
Just relation ->
if _arity relation == newArity then relation
else throw $ BadArityException relationName newArity
addFact :: (DatalogDB db) => Literal -> db -> db addFact :: (DatalogDB db) => Literal -> db -> db
addFact (Literal neg relationName terms) db = addFact (Literal neg relationName terms) db =
insertRelation (addConstants db extraConstants) newRelation insertRelation (addConstants db extraConstants) newRelation
@ -78,3 +89,22 @@ addFact (Literal neg relationName terms) db =
newRelation = lookupRelationArity relationName db newArity (Set.singleton terms) newRelation = lookupRelationArity relationName db newArity (Set.singleton terms)
extraConstants = Set.fromList terms extraConstants = Set.fromList terms
lookupRelation00 :: DatalogDB db =>
Text -> db -> Int -> (Relation -> Relation) -> db
lookupRelation00 relationName db newArity update =
insertRelation db (update newRelation)
where
newRelation = case lookupRelation db relationName of
Nothing -> Relation relationName newArity Set.empty []
Just relation ->
if _arity relation == newArity then
relation
else throw $ BadArityException relationName newArity
lookupRelation000 :: DatalogDB db =>
Text -> db -> Int -> Set [Constant] -> (Relation -> Relation) -> db
lookupRelation000 relationName db newArity tuples update =
lookupRelation00 relationName db newArity \relation ->
update relation {
_tuples = Set.union tuples $ _tuples relation
}

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

@ -45,26 +45,6 @@ instance DatalogDB InMemoryDB where
constants = Set.union newConstants (constants db) constants = Set.union newConstants (constants db)
} }
lookupRelation00 :: DatalogDB db =>
Text -> db -> Int -> (Relation -> Relation) -> db
lookupRelation00 relationName db newArity update =
insertRelation db (update newRelation)
where
newRelation = case lookupRelation db relationName of
Nothing -> Relation relationName newArity Set.empty []
Just relation ->
if _arity relation == newArity then
relation
else throw $ BadArityException relationName newArity
lookupRelation000 :: DatalogDB db =>
Text -> db -> Int -> Set [Constant] -> (Relation -> Relation) -> db
lookupRelation000 relationName db newArity tuples update =
lookupRelation00 relationName db newArity \relation ->
update relation {
_tuples = Set.union tuples $ _tuples relation
}
withFacts :: DatalogDB db => [Text] -> db withFacts :: DatalogDB db => [Text] -> db
withFacts = withFacts =
foldr (addFact . extractFact) emptyDB foldr (addFact . extractFact) emptyDB