Prolog-Meta-Interpreter/ebg.pl at main · gabe-rbo/Prolog-Meta-Interpreter · GitHub

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
ebg(Goal, GenGoal, (GenGoal :- GenBody)) :-
    prolog_current_choice(ChoicePoint),
    ebg(Goal, GenGoal, GenBody, ChoicePoint).

ebg(true, true, true, _ChoicePoint) :- !.

ebg(!, !, true, ChoicePoint) :-
    prolog_cut_to(ChoicePoint).

ebg((A, B), (GenA, GenB), NewRule, ChoicePoint) :- !,
    ebg(A, GenA, NewRuleA, ChoicePoint),
    ebg(B, GenB, NewRuleB, ChoicePoint),
    simplify((NewRuleA, NewRuleB), NewRule).

ebg((A -> B), (GenA -> GenB), NewRule, ChoicePoint) :- !,
    ebg(A, GenA, NewRuleA), !,
    ebg(B, GenB, NewRuleB, ChoicePoint),
    simplify((NewRuleA -> NewRuleB), NewRule).

ebg((A -> B; _), (GenA -> GenB), NewRule, ChoicePoint) :-
    ebg(A, GenA, NewRuleA), !,
    ebg(B, GenB, NewRuleB, ChoicePoint),
    simplify((NewRuleA -> NewRuleB), NewRule).

ebg((_ -> _; C), GenC, NewRuleC, ChoicePoint) :- !,
    ebg(C, GenC, NewRuleC, ChoicePoint).

ebg((A; B), (GenA; GenB), NewRule, ChoicePoint) :- !,
    (ebg(A, GenA, NewRuleA, ChoicePoint);
     ebg(B, GenB, NewRuleB, ChoicePoint)),
    simplify((NewRuleA; NewRuleB), NewRule).

ebg(Goal, GenGoal, NewRule, _ChoicePoint) :-
    not(operational(Goal)), not(predicate_property(Goal, built_in)),
    prolog_current_choice(ChoicePoint),
    clause(GenGoal, GenBody),
    copy_term((GenGoal :- GenBody), (Goal :- Body)),
    ebg(Body, GenBody, NewRule, ChoicePoint).

ebg(Goal, GenGoal, GenGoal, _ChoicePoint) :-
	operational(GenGoal), !, call(Goal).

ebg(Goal, GenGoal, GenGoal, _ChoicePoint) :-
    predicate_property(Goal, built_in), call(Goal).

simplify((true, NewRuleB), NewRuleB) :- !.
simplify((NewRuleA, true), NewRuleA) :- !.
simplify((NewRuleA, NewRuleB), (NewRuleA, NewRuleB)) :- !.

simplify((true -> NewRuleB), NewRuleB) :- !.
simplify((NewRuleA -> true), NewRuleA) :- !.
simplify((NewRuleA -> NewRuleB), (NewRuleA -> NewRuleB)).

simplify((A;true), A) :- !.
simplify((A;B), A) :- var(B). % B was not yet instanciated.
simplify((true;B), (true;B)).