added names for relations
This commit is contained in:
parent
04dcb4e8f7
commit
219ff26a90
@ -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]
|
||||||
|
|||||||
@ -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"]
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user