1 % (c) 2020-2026 Lehrstuhl fuer Softwaretechnik und Programmiersprachen,
2 % Heinrich Heine Universitaet Duesseldorf
3 % This software is licenced under EPL 1.0 (http://www.eclipse.org/org/documents/epl-v10.html
4
5 :- module(well_def_tools, [rename_norm_term/3, member_in_norm_conjunction/2, not_occurs/2, occurs/2]).
6
7 :- use_module(probsrc(module_information),[module_info/2]).
8 :- module_info(group,well_def_prover).
9 :- module_info(description,'This module provides utilities for the WD prover.').
10
11
12 :- use_module(probsrc(debug)).
13 % --------------------
14 % tools for normalized expressions:
15
16 % check if a known/bound ID occurs in a normalized expression
17 ?not_occurs(Expr,ID) :- (occurs(Expr,ID) -> debug_println(19,occurs_in(ID,Expr)),fail ; true).
18 occurs('$'(ID1),ID2) :- !, ID1 = ID2.
19 ?occurs(conjunct(A,B),ID) :- !, (occurs(A,ID) ; occurs(B,ID)).
20 occurs(couple(A,B),ID) :- !, (occurs(A,ID) ; occurs(B,ID)).
21 ?occurs(equal(A,B),ID) :- !, (occurs(A,ID) ; occurs(B,ID)).
22 occurs(field(_,A),ID) :- !, occurs(A,ID).
23 occurs(function(A,B),ID) :- !, (occurs(A,ID) ; occurs(B,ID)).
24 occurs(interval(A,B),ID) :- !, (occurs(A,ID) ; occurs(B,ID)).
25 occurs(member(A,B),ID) :- !, (occurs(A,ID) ; occurs(B,ID)).
26 occurs(record_field(A,B),ID) :- !, (occurs(A,ID) ; occurs(B,ID)).
27 occurs(value(_),_ID) :- !, fail.
28 occurs(string(_),_ID) :- !, fail.
29 occurs(reverse(A),ID) :- !, occurs(A,ID).
30 ?occurs(domain(A),ID) :- !, occurs(A,ID).
31 occurs(range(A),ID) :- !, occurs(A,ID).
32 occurs(comprehension_set(Paras,Body),ID) :- !,
33 (member('$'(ID),Paras) -> fail % ID becomes invisible
34 ? ; occurs(Body,ID)).
35 % TO DO: treat other bound IDs exists,... [but not crucial, as we err on the safe side here]
36 ?occurs([H|T],ID) :- !, (occurs(H,ID) -> true ; occurs(T,ID)).
37 occurs(boolean_true,_) :- !,fail.
38 occurs(boolean_false,_) :- !,fail.
39 occurs(empty_set,_) :- !,fail.
40 ?occurs(Expr,ID) :- Expr =.. [_|Args], member(A,Args), occurs(A,ID).
41
42 member_in_norm_conjunction(Pred,Pred).
43 member_in_norm_conjunction(conjunct(A,B),Pred) :-
44 ? member_in_norm_conjunction(A,Pred) ; member_in_norm_conjunction(B,Pred).
45
46
47 :- use_module(library(lists),[exclude/3]).
48
49 % apply a substitution to a normalised term:
50 rename_norm_term('$'(X),Subst,Res) :- !,
51 ? (member(rename(X,NewTerm),Subst) % TODO : use ord_member
52 -> Res=NewTerm
53 ; Res='$'(X)).
54 rename_norm_term(conjunct(A,B),Subst,conjunct(SA,SB)) :- !,
55 rename_norm_term(A,Subst,SA), rename_norm_term(B,Subst,SB).
56 rename_norm_term(if_then_else(A,B,C),Subst,if_then_else(SA,SB,SC)) :- !,
57 rename_norm_term(A,Subst,SA), rename_norm_term(B,Subst,SB), rename_norm_term(C,Subst,SC).
58 rename_norm_term(if_predicate(A,B,C),Subst,if_predicate(SA,SB,SC)) :- !,
59 rename_norm_term(A,Subst,SA), rename_norm_term(B,Subst,SB), rename_norm_term(C,Subst,SC).
60 rename_norm_term(equal(A,B),Subst,equal(SA,SB)) :- !,
61 rename_norm_term(A,Subst,SA), rename_norm_term(B,Subst,SB).
62 rename_norm_term(function(A,B),Subst,function(SA,SB)) :- !,
63 rename_norm_term(A,Subst,SA), rename_norm_term(B,Subst,SB).
64 rename_norm_term(field(F,B),Subst,field(F,SB)) :- !,
65 rename_norm_term(B,Subst,SB).
66 rename_norm_term(record_field(Rec,FieldName),Subst,record_field(Rec,FieldName)) :- !,
67 rename_norm_term(Rec,Subst,Rec).
68 rename_norm_term(member(A,B),Subst,member(SA,SB)) :- !,
69 rename_norm_term(A,Subst,SA), rename_norm_term(B,Subst,SB).
70 rename_norm_term(rec(F),Subst,rec(SF)) :- !,
71 l_rename_norm_terms(F,Subst,SF).
72 ?rename_norm_term(Nr,_,Res) :- simple_norm_term(Nr),!,Res=Nr.
73 rename_norm_term(QOP,Subst,RQOP) :-
74 quantified_op(QOP,Functor,Ids,Exprs,Bodies),!,
75 l_rename_norm_terms(Exprs,Subst,RExprs),
76 sort(Ids,SIds),
77 % TO DO: also ensure Subst is sorted and use linear algo
78 exclude(clash_with_new(SIds),Subst,NSubst),
79 %print(clashing(SIds,Subst,NSubst,Bodies)),nl,
80 l_rename_norm_terms(Bodies,NSubst,RBodies),
81 quantified_op(RQOP,Functor,Ids,RExprs,RBodies).
82 rename_norm_term(Term,Subst,RenTerm) :- functor(Term,BOP,2), bin_op(BOP),!,
83 functor(RenTerm,BOP,2),
84 arg(1,Term,A), arg(1,RenTerm,RA), rename_norm_term(A,Subst,RA),
85 arg(2,Term,B), arg(2,RenTerm,RB), rename_norm_term(B,Subst,RB).
86 rename_norm_term(Term,Subst,RenTerm) :- functor(Term,UOP,1), un_op(UOP),!,
87 functor(RenTerm,UOP,1),
88 ? arg(1,Term,A), arg(1,RenTerm,RA), rename_norm_term(A,Subst,RA).
89 rename_norm_term(Term,Subst,RenTerm) :- list_op(Term,Kind,List),!,
90 ? list_op(RenTerm,Kind,RList),
91 l_rename_norm_terms(List,Subst,RList).
92 rename_norm_term(A,_,_) :- print(uncovered_renaming(A)),nl,fail.
93
94 % uncovered_renaming(external_function_call(STRING_CODES,[$(s)]))
95
96 :- use_module(library(ordsets),[ord_member/2]).
97 clash_with_new(SortedIDs,rename(ID,_)) :- ord_member($(ID),SortedIDs).
98
99 l_rename_norm_terms([],_,[]).
100 l_rename_norm_terms([H|T],Subst,[RH|RT]) :-
101 rename_norm_term(H,Subst,RH),!,
102 l_rename_norm_terms(T,Subst,RT).
103
104
105 list_op(set_extension(L),set_extension,L).
106 list_op(sequence_extension(L),sequence_extension,L).
107 list_op(external_function_call(Name,Args),external_function_call(Name),Args).
108
109 % quantified_op(Term, ListOfDollarIDs, ListOfExprsOutsideOfScope, ListExpressionInNewScope)
110 quantified_op(comprehension_set(IDS,Body),comprehension_set,IDS,[],[Body]).
111 quantified_op(exists(IDS,Body),exists,IDS,[],[Body]).
112 quantified_op(forall(IDS,LHS,RHS),forall,IDS,[],[LHS,RHS]).
113 quantified_op(let_expression(IDS,Exprs,Body),let_expression,IDS,Exprs,[Body]).
114 quantified_op(let_predicate(IDS,Exprs,Body),let_predicate,IDS,Exprs,[Body]).
115 quantified_op(general_product(IDS,P,E),general_product,IDS,[],[P,E]).
116 quantified_op(general_sum(IDS,P,E),general_sum,IDS,[],[P,E]).
117 % lazy_let_pred, ...
118
119
120 % TO DO: add more bin and unary ops; records, quantified operators
121 bin_op(add).
122 bin_op(add_real).
123 bin_op(card).
124 bin_op(cartesian_product).
125 bin_op(composition).
126 bin_op(concat).
127 bin_op(couple).
128 bin_op(div).
129 bin_op(div_real).
130 bin_op(disjunct).
131 bin_op(domain_restriction).
132 bin_op(domain_subtraction).
133 bin_op(equivalence).
134 bin_op(greater).
135 bin_op(greater_equal).
136 bin_op(floored_div).
137 bin_op(function).
138 bin_op(image).
139 bin_op(implication).
140 bin_op(insert_front).
141 bin_op(insert_tail).
142 bin_op(intersection).
143 bin_op(interval).
144 bin_op(iteration).
145 bin_op(less).
146 bin_op(less_equal).
147 bin_op(less_real).
148 bin_op(less_equal_real).
149 bin_op(minus).
150 bin_op(minus_real).
151 bin_op(modulo).
152 bin_op(multiplication).
153 bin_op(multiplication_real).
154 bin_op(overwrite).
155 bin_op(not_equal).
156 bin_op(not_member).
157 bin_op(partial_bijection).
158 bin_op(partial_function).
159 bin_op(partial_injection).
160 bin_op(partial_surjection).
161 bin_op(power_of).
162 bin_op(power_of_real).
163 bin_op(range_restriction).
164 bin_op(range_subtraction).
165 bin_op(relations).
166 bin_op(restrict_front).
167 bin_op(restrict_tail).
168 bin_op(set_subtraction).
169 bin_op(size).
170 bin_op(subset).
171 bin_op(subset_strict).
172 bin_op(surjection_relation).
173 bin_op(total_function).
174 bin_op(total_injection).
175 bin_op(total_surjection).
176 bin_op(total_relation).
177 bin_op(total_surjection_relation).
178 bin_op(union).
179
180 un_op(bag_items).
181 un_op(card).
182 un_op(closure). % closure1
183 un_op(compaction).
184 un_op(convert_bool).
185 un_op(convert_real).
186 un_op(convert_int_floor).
187 un_op(convert_int_ceiling).
188 un_op(domain).
189 un_op(finite).
190 un_op(fin_subset).
191 un_op(fin1_subset).
192 un_op(first_of_pair).
193 un_op(front).
194 un_op(identity).
195 %un_op(integer). % should normally be stripped away by norm_pred_check
196 un_op(iseq).
197 un_op(iseq1).
198 un_op(last).
199 un_op(negation).
200 un_op(max).
201 un_op(max_real).
202 un_op(min).
203 un_op(min_real).
204 un_op(mu).
205 un_op(perm).
206 un_op(pow_subset).
207 un_op(pow1_subset).
208 un_op(range).
209 %un_op(real). % is stripped away by norm_pred_check
210 un_op(rev).
211 un_op(reverse).
212 un_op(reflexive_closure).
213 un_op(second_of_pair).
214 un_op(seq).
215 un_op(seq1).
216 un_op(size).
217 un_op(tail).
218 un_op(unary_minus).
219 un_op(unary_minus_real).
220
221 % do not require renaming:
222 simple_norm_term(truth).
223 simple_norm_term(boolean_true).
224 simple_norm_term(boolean_false).
225 simple_norm_term(bool_set).
226 simple_norm_term(float_set).
227 simple_norm_term(real_set).
228 simple_norm_term(string_set).
229 simple_norm_term(typeset).
230 simple_norm_term(value(_)).
231 simple_norm_term(string(_)).
232 simple_norm_term(empty_set).
233 simple_norm_term(empty_sequence).
234 simple_norm_term(max_int).
235 simple_norm_term(min_int).
236 simple_norm_term('NATURAL').
237 simple_norm_term('NATURAL1').
238 simple_norm_term(lazy_lookup_pred(_)).
239 simple_norm_term(lazy_lookup_expr(_)).
240 simple_norm_term(Nr) :- number(Nr).