-
-
Notifications
You must be signed in to change notification settings - Fork 2
/
planner.pl
110 lines (78 loc) · 3.33 KB
/
planner.pl
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
/*
Author: Pieter Van den Abeele
E-mail: [email protected]
Copyright (c) 2005-2024, Pieter Van den Abeele
Distributed under the terms of the LICENSE file in the root directory of this
project.
*/
/** <module> PLANNER
The Builder takes a plan from the Planner and executes it.
Given a proof, consider it as graph, apply the following algorithm,
based on topological sort:
1. For each rule, determine weight
2. Filter out rules with zero weight
3. Continue weighting until there are no more edges in the graph
*/
:- module(planner, []).
% ********************
% PLANNER declarations
% ********************
%! planner:zerorules(+List,-List,+List,+List,-List)
%
% Iteratively filter out the rules in a list with zero weight
planner:zerorules([],Weights,Weights,[],[]) :- !.
planner:zerorules([constraint(_)|Rest],ZeroWeights,TempZeroWeights,ZeroRules,NonZeroRules) :-
!,
planner:zerorules(Rest,ZeroWeights,TempZeroWeights,ZeroRules,NonZeroRules).
planner:zerorules([assumed(rule(Head,Body))|Rest],ZeroWeights,[Head|TempZeroWeights],[assumed(rule(Head,Body))|ZeroRules],NonZeroRules) :-
planner:is_zero(Body,ZeroWeights),!,
planner:zerorules(Rest,ZeroWeights,TempZeroWeights,ZeroRules,NonZeroRules).
planner:zerorules([rule(Head,Body)|Rest],ZeroWeights,[Head|TempZeroWeights],[rule(Head,Body)|ZeroRules],NonZeroRules) :-
planner:is_zero(Body,ZeroWeights),!,
planner:zerorules(Rest,ZeroWeights,TempZeroWeights,ZeroRules,NonZeroRules).
planner:zerorules([Rule|Rest],ZeroWeights,TempZeroWeights,ZeroRules,[Rule|NonZeroRules]) :-
!,
planner:zerorules(Rest,ZeroWeights,TempZeroWeights,ZeroRules,NonZeroRules).
%! planner:is_zero(+Body,+Weights)
%
% Check whether a body has zero weight
planner:is_zero([],_) :- !.
% planner:is_zero([constraint(_)|R],W) :- !, planner:is_zero(R,W).
planner:is_zero([E|R],W) :- memberchk(E,[constraint(_)|W]),!, planner:is_zero(R,W).
%! planner:plan(+Rules,+Weights,+OldPlan,+NewPlan)
%
% Creates a plan by weighting rules
planner:plan([],_,OldPlan,OldPlan) :- !.
planner:plan(Rules,InitialWeights,OldPlan,[ZeroRules|TempPlan]) :-
planner:zerorules(Rules,InitialWeights,NewWeights,ZeroRules,NonZeroRules),
ZeroRules \= [],!,
planner:plan(NonZeroRules,NewWeights,OldPlan,TempPlan).
%! planner:test(+Repository)
%
% Creates a plan for every entry in a repository, reports on progress in default style
planner:test(Repository) :-
config:test_style(Style),
planner:test(Repository,Style).
%! planner:test(+Repository,+Style)
%
% Creates a plan for every entry in a repository, reports on progress in given style
planner:test(Repository,Style) :-
config:proving_target(Action),
tester:test(Style,
'Planning',
Repository://Entry,
(Repository:entry(Entry)),
(prover:prove(Repository://Entry:Action,[],Proof,[],_,[],_),
planner:plan(Proof,[],[],_))),!.
%! planner:test_latest(+Repository,+Style)
%
% Same as planner:test(+Repository,+Style), but only tests highest version
% of every package.
planner:test_latest(Repository,Style) :-
config:proving_target(Action),
tester:test(Style,
'Planning latest',
Repository://Entry,
(Repository:package(C,N),once(Repository:ebuild(Entry,C,N,_))),
(prover:prove(Repository://Entry:Action,[],Proof,[],_,[],_),
planner:plan(Proof,[],[],_))),!.