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

adding typeclass APIs

Browse Source
This commit is contained in:
Felix Dilke 2026-01-29 17:02:27 +00:00
parent fe899bbb0c
commit 069733e474
2 changed files with 12 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -33,14 +33,16 @@ instance DatalogDB NaiveDatabase where
, constants = Set.empty -- the Herbrand universe
}
-- lookupRelation :: NaiveDatabase -> Text -> Maybe Relation -> NaiveDatabase
-- lookupRelation = _
lookupRelation :: NaiveDatabase -> Text -> Maybe Relation
lookupRelation db relationName =
Map.lookup relationName $ relations db
-- insertRelation :: NaiveDatabase -> Text -> Relation -> NaiveDatabase
-- insertRelation = _
lookupRelation :: RelationId -> Map RelationId Relation -> Int -> Set [Term] -> Relation
lookupRelation relationName relationMap newArity tuples =
case Map.lookup relationName relationMap of
lookupRelation0 :: RelationId -> NaiveDatabase -> Int -> Set [Term] -> Relation
lookupRelation0 relationName db newArity tuples =
case lookupRelation db relationName of
Nothing -> Relation relationName newArity tuples []
Just relation ->
if _arity relation == newArity then
@ -59,11 +61,11 @@ withFacts =
Right otherStatement -> throw $ NonFactException factText otherStatement
Left ex -> throw $ CannotParseStatementException factText ex
addFact :: Literal -> NaiveDatabase -> NaiveDatabase
addFact (Literal neg relationName terms) (NaiveDatabase relationMap constantSet) =
addFact (Literal neg relationName terms) db@(NaiveDatabase relationMap constantSet) =
NaiveDatabase newRelationMap newConstantSet
where
newArity = length terms
newRelation = lookupRelation relationName relationMap newArity (Set.singleton terms)
newRelation = lookupRelation0 relationName db newArity (Set.singleton terms)
newRelationMap = Map.insert relationName newRelation relationMap
newConstantSet = Set.union constantSet $ Set.fromList terms
@ -142,7 +144,7 @@ digestBody (Literal neg subRelationName subTerms) context =
where
variableNames = nub $ _variableNames context ++ extractVariableNames subTerms
newArity = length subTerms
subRelation = lookupRelation subRelationName relationMap newArity Set.empty
subRelation = lookupRelation0 subRelationName (_db context) newArity Set.empty
relationMap :: Map RelationId Relation = relations (_db context)
relationMap' = Map.insert subRelationName subRelation relationMap
extraConstants = mapMaybe constantFromTerm subTerms where
@ -168,7 +170,7 @@ addRule (ruleHead, body) db =
relationName = predName ruleHead
terms = arguments ruleHead
newArity = length terms
relation = lookupRelation relationName (relations db) newArity Set.empty
relation = lookupRelation0 relationName db newArity Set.empty
context = digestHead db relation ruleHead
context' = foldr digestBody context body
db' = _db context'

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

@ -49,5 +49,5 @@ type RelationId = Text
class DatalogDB db where
emptyDB :: db
-- lookupRelation :: db -> Text -> Maybe Relation -> db
lookupRelation :: db -> Text -> Maybe Relation
-- insertRelation :: db -> Text -> Relation -> db