sorting out the lookup functions
This commit is contained in:
parent
05b6aefabe
commit
970afa2b61
@ -2,6 +2,7 @@
|
||||
{-# LANGUAGE ImportQualifiedPost #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
|
||||
{-# LANGUAGE BlockArguments #-}
|
||||
|
||||
module Datalog.DatalogDB where
|
||||
|
||||
@ -70,6 +71,16 @@ lookupRelationArity relationName db newArity tuples =
|
||||
in relation { _tuples = newTuples }
|
||||
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 (Literal neg relationName terms) db =
|
||||
insertRelation (addConstants db extraConstants) newRelation
|
||||
@ -78,3 +89,22 @@ addFact (Literal neg relationName terms) db =
|
||||
newRelation = lookupRelationArity relationName db newArity (Set.singleton 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
|
||||
}
|
||||
|
||||
@ -45,26 +45,6 @@ instance DatalogDB InMemoryDB where
|
||||
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 =
|
||||
foldr (addFact . extractFact) emptyDB
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user