From 7bc407536a8c9da795ddf31886816370def86d0a Mon Sep 17 00:00:00 2001 From: Felix Dilke Date: Fri, 30 Jan 2026 16:32:49 +0000 Subject: [PATCH] commented out some experimental lookupdate methods that the world isn't quite ready for --- haskell-experiments/src/Datalog/DatalogDB.hs | 58 ++++++++++---------- haskell-experiments/src/Datalog/Rules.hs | 3 +- 2 files changed, 31 insertions(+), 30 deletions(-) diff --git a/haskell-experiments/src/Datalog/DatalogDB.hs b/haskell-experiments/src/Datalog/DatalogDB.hs index a0cba40..3b110a6 100644 --- a/haskell-experiments/src/Datalog/DatalogDB.hs +++ b/haskell-experiments/src/Datalog/DatalogDB.hs @@ -71,16 +71,6 @@ 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 @@ -89,22 +79,34 @@ 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 +-- the world isn't quite ready for these, as the 'update relation' pattern doesn't fir - maybe use a lens? +-- 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 +-- } + +-- 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 -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 - } diff --git a/haskell-experiments/src/Datalog/Rules.hs b/haskell-experiments/src/Datalog/Rules.hs index 10ffff7..754e58f 100644 --- a/haskell-experiments/src/Datalog/Rules.hs +++ b/haskell-experiments/src/Datalog/Rules.hs @@ -89,7 +89,7 @@ digestBody (Literal neg subRelationName subTerms) context = context { _variableNames = variableNames , _bodyConstraints = newConstraint : constraints - , _db = insertRelation (addConstants db constants') subRelation + , _db = insertRelation (addConstants db (Set.fromList extraConstants)) subRelation } where db = _db context @@ -100,7 +100,6 @@ digestBody (Literal neg subRelationName subTerms) context = constantFromTerm :: Term -> Maybe Constant constantFromTerm (Var _) = Nothing constantFromTerm constant = Just constant - constants' = Set.fromList extraConstants constraints = _bodyConstraints context newConstraint = BodyConstraint subRelation subRuleElements where subRuleElements = toRuleElement <$> subTerms