added names for relations

This commit is contained in:
Felix Dilke 2026-01-26 12:20:19 +00:00
parent 04dcb4e8f7
commit 219ff26a90
2 changed files with 9 additions and 3 deletions

View File

@ -39,6 +39,7 @@ data RelationRule = RelationRule {
} deriving (Show, Eq) } deriving (Show, Eq)
data Relation = Relation { data Relation = Relation {
_name :: Text,
_arity :: Int, _arity :: Int,
_tuples :: Set [Constant], _tuples :: Set [Constant],
_rules :: [RelationRule] _rules :: [RelationRule]
@ -80,10 +81,10 @@ withFacts facts =
lookupRelation :: RelationId -> Map RelationId Relation -> Int -> [Term] -> Relation lookupRelation :: RelationId -> Map RelationId Relation -> Int -> [Term] -> Relation
lookupRelation relationName relationMap newArity terms = lookupRelation relationName relationMap newArity terms =
case Map.lookup relationName relationMap of case Map.lookup relationName relationMap of
Nothing -> Relation newArity (Set.singleton terms) [] Nothing -> Relation relationName newArity (Set.singleton terms) []
Just relation -> Just relation ->
if (_arity relation == newArity) if (_arity relation == newArity)
then Relation (length terms) (Set.singleton terms) [] then Relation relationName (length terms) (Set.singleton terms) []
else throw $ BadArityException relationName newArity else throw $ BadArityException relationName newArity
data ConstraintElement = -- entry occurring in a rule body constraint - constant or variable index data ConstraintElement = -- entry occurring in a rule body constraint - constant or variable index
@ -217,6 +218,7 @@ withFactsAndRules facts rules =
-- _relation :: Relation, -- _relation :: Relation,
-- _elements :: [ConstraintElement] -- _elements :: [ConstraintElement]
relation' = Relation { relation' = Relation {
_name = _name relation,
_arity = newArity, _arity = newArity,
_tuples = _tuples relation, _tuples = _tuples relation,
_rules = (_rules relation) ++ [newRule] _rules = (_rules relation) ++ [newRule]

View File

@ -33,7 +33,7 @@ spec = do
relations db `shouldBe` relations db `shouldBe`
Map.fromList [ Map.fromList [
("parent", ("parent",
Relation 2 (Set.fromList ([Sym <$> ["bob", "carol"]])) [] ) Relation "parent" 2 (Set.fromList ([Sym <$> ["bob", "carol"]])) [] )
] ]
it "can ingest facts and rules" $ do it "can ingest facts and rules" $ do
let db = NaiveDatabase.withFactsAndRules let db = NaiveDatabase.withFactsAndRules
@ -48,6 +48,7 @@ spec = do
("ancestor", ("ancestor",
Relation { Relation {
_arity = 2, _arity = 2,
_name = "ancestor",
_tuples = Set.fromList [ _tuples = Set.fromList [
[Var "X", Var "Y"] [Var "X", Var "Y"]
], ],
@ -57,6 +58,7 @@ spec = do
body = [ body = [
( (
Relation { Relation {
_name = "parent",
_arity = 2, _arity = 2,
_tuples = Set.fromList [ _tuples = Set.fromList [
[Var "X",Var "Z" ] [Var "X",Var "Z" ]
@ -68,6 +70,7 @@ spec = do
] ]
),( ),(
Relation { Relation {
_name = "ancestor",
_arity = 2, _arity = 2,
_tuples = Set.fromList [ _tuples = Set.fromList [
[Var "Z",Var "Y"] [Var "Z",Var "Y"]
@ -85,6 +88,7 @@ spec = do
), ),
("parent", ("parent",
Relation { Relation {
_name = "parent",
_arity = 2, _arity = 2,
_tuples = Set.fromList [ _tuples = Set.fromList [
[Var "X",Var "Z"] [Var "X",Var "Z"]