39
40:- module(clpcd_ordering,
41 [
42 clp_type/2,
43 get_or_add_class/2,
44 ordering/1,
45 var_intern/4,
46 arrangement/2
47 ]). 48
49:- use_module(library(clpcd/class)). 50:- use_module(library(clpcd/combine)). 51:- use_module(library(ugraphs)). 52
53ordering(X) :-
54 var(X),
55 !,
56 fail.
57ordering(A>B) :-
58 !,
59 ordering(B<A).
60ordering(A<B) :-
61 join_class([A,B],Class),
62 class_get_prio(Class,Ga),
63 !,
64 add_edges([],[A-B],Gb),
65 combine(Ga,Gb,Gc),
66 class_put_prio(Class,Gc).
67ordering(Pb) :-
68 Pb = [_|Xs],
69 join_class(Pb,Class),
70 class_get_prio(Class,Ga),
71 !,
72 ( Xs = [],
73 add_vertices([],Pb,Gb)
74 ; Xs=[_|_],
75 gen_edges(Pb,Es,[]),
76 add_edges([],Es,Gb)
77 ),
78 combine(Ga,Gb,Gc),
79 class_put_prio(Class,Gc).
80ordering(_).
81
82arrangement(Class,Arr) :-
83 class_get_prio(Class,G),
84 normalize(G,Gn),
85 top_sort(Gn,Arr),
86 !.
87arrangement(_,_) :- throw(unsatisfiable_ordering).
88
92
93var_intern(CLP,Type,Var,Strict) :-
94 var_intern(CLP,Type,Var,Strict,_Class).
95
96var_intern(CLP,Type,Var,Strict,Class) :-
97 put_attr(Var,clpcd_itf,t(CLP,type(Type),strictness(Strict),
98 lin([0,0,l(Var*1,Ord)]),order(Ord),n,n,n,n,n,n)),
99 get_or_add_class(Var,Class).
100
104
105var_intern(_CLP,Var,Class) :- 106 get_attr(Var,clpcd_itf,Att),
107 arg(2,Att,type(_)),
108 arg(4,Att,lin(_)),
109 !,
110 get_or_add_class(Var,Class).
111var_intern(CLP,Var,Class) :-
112 var_intern(CLP,t_none,Var,0,Class).
113
118
119get_or_add_class(X,Class) :-
120 get_attr(X,clpcd_itf,Att),
121 arg(1,Att,CLP),
122 ( arg(6,Att,class(ClassX))
123 -> ClassX = Class
124 ; setarg(6,Att,class(Class)),
125 class_new(Class,CLP,[X|Tail],Tail,[])
126 ).
127
128join_class([],_).
129join_class([X|Xs],Class) :-
130 ( var(X)
131 -> clp_type(X,CLP),
132 var_intern(CLP, X, Class)
133 ; true
134 ),
135 join_class(Xs,Class).
136
137clp_type(Var,Type) :-
138 ( get_attr(Var,clpcd_itf,Att)
139 -> arg(1,Att,Type)
140 ; get_attr(Var,clpcd_geler,Att)
141 -> arg(1,Att,Type)
142 ).
143
144gen_edges([]) --> [].
145gen_edges([X|Xs]) -->
146 gen_edges(Xs,X),
147 gen_edges(Xs).
148
149gen_edges([],_) --> [].
150gen_edges([Y|Ys],X) -->
151 [X-Y],
152 gen_edges(Ys,X).
153
154 157:- multifile
158 sandbox:safe_primitive/1. 159
160sandbox:safe_primitive(clpcd_ordering:ordering(_)).
161sandbox:safe_primitive(clpcd_ordering:clp_type(_,_))