/
Rule.elm
128 lines (99 loc) · 3.34 KB
/
Rule.elm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
module Datalog.Rule exposing (Problem(..), Rule, body, fact, head, isFact, rule, toString)
import Datalog.Atom as Atom exposing (Atom)
import Datalog.Negatable as Negatable exposing (Direction(..), Negatable(..))
import Datalog.Term as Term
import Sort.Set as Set
type Rule
= Rule Atom (List (Negatable Atom))
type Problem
= NotRangeRestricted
| UnnamedHeadVariable
| VariableAppearsNegatedButNotPositive
rule : Atom -> List (Negatable Atom) -> Result Problem Rule
rule head_ body_ =
let
candidate =
Rule head_ body_
in
if hasUnnamedHeadVariable candidate then
Err UnnamedHeadVariable
else if not (isRangeRestricted candidate) then
Err NotRangeRestricted
else if not (isNegationSafe candidate) then
Err VariableAppearsNegatedButNotPositive
else
Ok candidate
fact : Atom -> Result Problem Rule
fact fact_ =
rule fact_ []
isFact : Rule -> Bool
isFact (Rule head_ body_) =
Atom.isGround head_ && List.isEmpty body_
hasUnnamedHeadVariable : Rule -> Bool
hasUnnamedHeadVariable (Rule head_ _) =
List.any Term.isAnonymous (Atom.variables head_)
{-| Do all the variables in the head occur in the body?
-}
isRangeRestricted : Rule -> Bool
isRangeRestricted (Rule head_ body_) =
let
bodyVars =
List.concatMap (Negatable.value >> Atom.variables) body_
in
List.all
(\headVar -> List.member headVar bodyVars)
(Atom.variables head_)
{-| Do all the variables in negated expressions also appear in positive
expressions?
-}
isNegationSafe : Rule -> Bool
isNegationSafe (Rule _ body_) =
body_
|> List.foldl
(\(Negatable direction atom) occurrences_ ->
List.foldl
(\variable occurrences ->
case direction of
Positive ->
{ occurrences | positive = Set.insert variable occurrences.positive }
Negative ->
{ occurrences | negative = Set.insert variable occurrences.negative }
)
occurrences_
(Atom.variables atom)
)
{ positive = Set.empty Term.variableSorter
, negative = Set.empty Term.variableSorter
}
|> (\{ positive, negative } ->
negative
|> Set.dropIf (Set.memberOf positive)
|> Set.dropIf ((==) Term.Anonymous)
|> Set.isEmpty
)
head : Rule -> Atom
head (Rule head_ _) =
head_
body : Rule -> List (Negatable Atom)
body (Rule _ body_) =
body_
toString : Rule -> String
toString (Rule head_ body_) =
case body_ of
[] ->
Atom.toString head_ ++ "."
_ ->
Atom.toString head_
++ " :- "
++ String.join ", "
(List.map
(\negatableAtom ->
case negatableAtom of
Negatable Positive atom ->
Atom.toString atom
Negatable Negative atom ->
"not " ++ Atom.toString atom
)
body_
)
++ "."