| 1 | % (c) 2025-2025 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(b2asp,[solve_pred_with_clingo/5, run_clingo_on_formula/1, test/1]). | |
| 6 | :- use_module(probsrc(module_information),[module_info/2]). | |
| 7 | :- module_info(group,b2asp). | |
| 8 | :- module_info(description,'Solve B formulas with clingo ASP solver.'). | |
| 9 | ||
| 10 | % first attempt at translator from B AST to ASP | |
| 11 | % started May 7th 2025, Michael Leuschel, based on analysis of B to ASP translations by Maxime Zielinger | |
| 12 | % Michael Leuschel, Maxime Zielinger | |
| 13 | ||
| 14 | % Current restrictions: | |
| 15 | % * higher-order values (sets of sets, ...) are not supported | |
| 16 | % * universal quantification: | |
| 17 | % - only scalar identifiers can be quantified | |
| 18 | % - no use of existential quantifiers inside forall yet (gen_clingo_set_identifier cannot yet take Env into account) | |
| 19 | % - no use of set comprehensions inside forall yet (ditto) | |
| 20 | % * only certain SIGMA patterns supported: SIGMA(ID).(ID:SET|ID) | |
| 21 | % * variable clash limitations: no nesting of existential quantifiers with same name | |
| 22 | % | |
| 23 | % Still required: | |
| 24 | % * avoid passing quantified variables (forall) as arguments to Clingo predicates if not necessary | |
| 25 | % * scope/interval analysis to determine base types for unbounded integer variables | |
| 26 | % * we could try and inline/partially evaluate the program to avoid redundant intermediate predicates | |
| 27 | ||
| 28 | ||
| 29 | :- use_module(library(lists)). | |
| 30 | :- use_module(library(codesio), [format_to_codes/3,write_to_codes/2]). | |
| 31 | ||
| 32 | ||
| 33 | %:- op(700,fx,not). % add operator declaration, as we need to print not without parentheses for Clingo | |
| 34 | ||
| 35 | :- use_module(clingo_interface). | |
| 36 | :- use_module(bounds_analysis,[infer_bounds/4]). | |
| 37 | ||
| 38 | :- if(current_module(error_manager)). | |
| 39 | :- use_module(probsrc(error_manager)). | |
| 40 | :- use_module(probsrc(debug)). | |
| 41 | :- use_module(probsrc(preferences)). | |
| 42 | :- use_module(probsrc(b_global_sets),[b_get_fd_type_bounds/3, lookup_global_constant/2]). | |
| 43 | :- use_module(probsrc(tools_strings),[ajoin/2,ajoin_path/3]). | |
| 44 | :- use_module(probsrc(bsyntaxtree),[get_texpr_id/2, get_texpr_type/2, create_couple/2]). | |
| 45 | :- use_module(probsrc(version), [version_str/1]). | |
| 46 | :- use_module(probsrc(translate),[translate_bexpression_with_limit/3]). | |
| 47 | :- use_module(probsrc(btypechecker), [couplise_list/2]). | |
| 48 | ||
| 49 | add_b2asp_error(Msg,Args) :- add_error(b2asp,Msg,Args). | |
| 50 | add_b2asp_error(Msg,Args,Span) :- add_error(b2asp,Msg,Args,Span). | |
| 51 | add_b2asp_warning(Msg,Args) :- add_warning(b2asp,Msg,Args). | |
| 52 | get_min_int(X) :- get_preference(minint,X). | |
| 53 | get_max_int(X) :- get_preference(maxint,X). | |
| 54 | get_clingo_out_file(File) :- | |
| 55 | get_preference(tmpdir, TmpDir), | |
| 56 | ajoin_path(TmpDir, 'prob_clingo_translation.lp', File). | |
| 57 | % see get_temporary_filename, open_temp_file | |
| 58 | :- else. | |
| 59 | add_b2asp_error(Msg,Args,_) :- add_b2asp_error(Msg,Args). | |
| 60 | add_b2asp_error(Msg,Args) :- | |
| 61 | write(user_error,Msg), write(user_error,Args), nl(user_error). | |
| 62 | add_b2asp_warning(Msg,Args) :- | |
| 63 | add_b2asp_error(Msg,Args). | |
| 64 | debug_mode(on). | |
| 65 | debug_format(_,FS,A) :- format(user_output,FS,A). | |
| 66 | get_min_int(-128). | |
| 67 | get_max_int(127). | |
| 68 | get_clingo_out_file('out.lp'). | |
| 69 | b_get_fd_type_bounds(_,_,_) :- fail. | |
| 70 | lookup_global_constant(_,_) :- fail. | |
| 71 | get_texpr_id(identifier(X,_),X). | |
| 72 | get_texpr_type(b(_,T,_),T). | |
| 73 | create_couple([A],A). | |
| 74 | create_couple([A,B],couple(A,B)). | |
| 75 | version_str('b2asp module'). | |
| 76 | translate_bexpression_with_limit(Formula,_,Str) :- Str=Formula. | |
| 77 | :- endif. | |
| 78 | ||
| 79 | ||
| 80 | % ------------------------------ | |
| 81 | % translating PREDICATES | |
| 82 | ||
| 83 | % a top-level translation of predicates | |
| 84 | % asserts translations as integrity constraint (aka query) | |
| 85 | ||
| 86 | %top_level_translate_predicate(Formula) :- | |
| 87 | % trans_pred_positive(Formula,Prop), | |
| 88 | % gen_clingo_ic_constraint( not(Prop) ). % assert main is false, and Formula is true | |
| 89 | top_level_translate_predicate(Formula) :- | |
| 90 | create_new_local_id_env(Env), | |
| 91 | trans_not_pred(Formula,Env,Prop), | |
| 92 | gen_clingo_ic_constraint( Prop ). | |
| 93 | ||
| 94 | is_predicate(b(_,pred,_)). % ProB typed AST node | |
| 95 | is_predicate(BOP) :- bin_op_pred_single_call(BOP,_,_,_). | |
| 96 | is_predicate(X) :- negate_pred(X,_) ; negate_pred(NX,X), NX \= negation(_). | |
| 97 | is_predicate(BOP) :- negate_scalar_binary_pred(BOP,_,_,_). | |
| 98 | is_predicate(conjunct(_,_)). | |
| 99 | is_predicate(disjunct(_,_)). | |
| 100 | is_predicate(implication(_,_)). | |
| 101 | is_predicate(equivalence(_,_)). | |
| 102 | ||
| 103 | % translating a predicate into a proposition that is true if predicate is true | |
| 104 | % not sure if we need it | |
| 105 | %trans_pred_positive(BOP,Env,Prop) :- | |
| 106 | % bin_op_pred_single_call(BOP,A,B,ClingoOp), | |
| 107 | % translate_scalar(A,Env,ValA,CallA), | |
| 108 | % translate_scalar(B,Env,ValB,CallB), | |
| 109 | % ClingoCall =.. [ClingoOp,ValA,ValB], | |
| 110 | % gensym_if_necessary(pred,Prop), | |
| 111 | % gen_clingo_clause(Prop,[], (CallA,CallB, ClingoCall) ). | |
| 112 | ||
| 113 | ||
| 114 | % translating a predicate into a proposition that is true if predicate is true | |
| 115 | % it is currently use for the left-hand-side of universal quantifiers | |
| 116 | % not sure that it is really required; it can provide a few optimized translation rules, avoiding negation | |
| 117 | trans_pos_pred(b(Pred,pred,_Infos),Env,Prop) :- !, % format(user_output,' pred --> ~w~n',[Pred]), | |
| 118 | trans_pos_pred(Pred,Env,Prop). | |
| 119 | trans_pos_pred(truth,Env,Prop) :- !, | |
| 120 | gensym_if_necessary(truth,Prop), | |
| 121 | gen_clingo_fact(Prop,[],Env). | |
| 122 | trans_pos_pred(member(A,B),Env,Prop) :- \+ specific_member_rule_exists(B), !, % otherwise use negation | |
| 123 | translate_scalar(A,Env,X1,CallA), | |
| 124 | trans_set(B,Env,P2), | |
| 125 | clingo_format_comment('% member predicate (positive)~n',[]), | |
| 126 | gen_clingo_pred_clause(member,Prop,[],Env, | |
| 127 | (CallA, ecall(P2,[X1],Env) )). % :- P1(X), P2(X). (same as subset) | |
| 128 | trans_pos_pred(Arith,Env,Prop) :- | |
| 129 | scalar_binary_pred(Arith,A,B,ClingoOp),!, | |
| 130 | translate_top_level_scalar(A,Env,X1,CallA), | |
| 131 | translate_top_level_scalar(B,Env,X2,CallB), | |
| 132 | clingo_format_comment('% arithmetic predicate (positive) ~w~n',[ClingoOp]), | |
| 133 | gen_clingo_pred_clause(arith,Prop,[],Env, (CallA, CallB, call(ClingoOp,X1,X2) )). | |
| 134 | trans_pos_pred(conjunct(P1,P2),Env,Prop) :- !, | |
| 135 | trans_pos_pred(P1,Env,TrueP1), | |
| 136 | trans_pos_pred(P2,Env,TrueP2), | |
| 137 | clingo_format_comment('% conjunction (positive)~n',[]), | |
| 138 | gen_clingo_pred_clause(conjunct,Prop,[],Env, (ecall(TrueP1,Env) , ecall(TrueP2,Env)) ). | |
| 139 | trans_pos_pred(X,Env,Prop) :- | |
| 140 | trans_not_pred(negation(X),Env,Prop). | |
| 141 | ||
| 142 | specific_member_rule_exists(b(E,_,_)) :- !, specific_member_rule_exists(E). | |
| 143 | specific_member_rule_exists(pow_subset(_)). | |
| 144 | specific_member_rule_exists(pow1_subset(_)). | |
| 145 | specific_member_rule_exists(relations(_,_)). | |
| 146 | specific_member_rule_exists(partial_function(_,_)). | |
| 147 | specific_member_rule_exists(partial_injection(_,_)). | |
| 148 | specific_member_rule_exists(total_relation(_,_)). | |
| 149 | specific_member_rule_exists(total_function(_,_)). | |
| 150 | specific_member_rule_exists(total_injection(_,_)). | |
| 151 | specific_member_rule_exists(surjection_relation(_,_)). | |
| 152 | specific_member_rule_exists(partial_surjection(_,_)). | |
| 153 | specific_member_rule_exists(total_surjection_relation(_,_)). | |
| 154 | specific_member_rule_exists(total_surjection(_,_)). | |
| 155 | specific_member_rule_exists(partial_bijection(_,_)). | |
| 156 | specific_member_rule_exists(total_bijection(_,_)). | |
| 157 | specific_member_rule_exists(seq(_)). | |
| 158 | specific_member_rule_exists(iseq(_)). | |
| 159 | specific_member_rule_exists(seq1(_)). | |
| 160 | specific_member_rule_exists(iseq1(_)). | |
| 161 | specific_member_rule_exists(perm(_)). | |
| 162 | ||
| 163 | % translating a predicate into a proposition that is false if predicate is true and can be used as ic constraint | |
| 164 | % not sure if we need both positive and negative translations | |
| 165 | trans_not_pred(b(Pred,pred,_Infos),Env,Prop) :- !, % format(user_output,' pred --> ~w~n',[Pred]), | |
| 166 | trans_not_pred(Pred,Env,Prop). | |
| 167 | trans_not_pred(exists(Paras,Pred),Env,Prop) :- !, | |
| 168 | (member(b(identifier(ID),_,_),Paras), | |
| 169 | generated_id(ID,_), % TODO: register paras in Env, rather than using generated_id/2 facts | |
| 170 | add_b2asp_error('Identifier clash (B2ASP does not yet support multiple uses of same id): ',ID),fail | |
| 171 | ; true), | |
| 172 | check_empty_env(Env,Paras,Pred), % at the moment we do not support exists inside forall | |
| 173 | infer_bounds_within_env(Paras,Pred,Env,BI), | |
| 174 | format(user_output,'exists bounds_info: ~w~n',[BI]), | |
| 175 | (BI = contradiction_found | |
| 176 | -> trans_not_pred(falsity,Env,Prop) % no solution for body | |
| 177 | ; add_new_local_id_bounds(BI,Env,Env2), | |
| 178 | trans_not_pred(Pred,Env2,Prop) | |
| 179 | ). | |
| 180 | trans_not_pred(forall(Ids,LHS,RHS),Env,Prop) :- !, | |
| 181 | infer_bounds_within_env(Ids,LHS,Env,BI), | |
| 182 | add_message(b2asp,'Forall bounds info: ',BI,LHS), | |
| 183 | trans_not_pred(forall_with_precomputed_bounds(Ids,BI,LHS,RHS),Env,Prop). | |
| 184 | trans_not_pred(forall_with_precomputed_bounds(Ids,BI,LHS,RHS),Env,Prop) :- !, | |
| 185 | (BI = contradiction_found | |
| 186 | -> trans_not_pred(truth,Env,Prop) % no solution for LHS; forall is true | |
| 187 | ; add_local_typed_ids(Ids,BI,Env,LocalIdSetupCode,NewEnv), | |
| 188 | trans_pos_pred(LHS,NewEnv,P1), | |
| 189 | trans_not_pred(RHS,NewEnv,NotP2), | |
| 190 | clingo_format_comment('% forall (negative)~n',[]), | |
| 191 | gen_clingo_pred_clause(not_forall,Prop,[], Env, % this must be Env and not NewEnv ! | |
| 192 | (LocalIdSetupCode ,ecall(P1,NewEnv) , ecall(NotP2,NewEnv)) ) | |
| 193 | ). | |
| 194 | trans_not_pred(truth,Env,Prop) :- !, | |
| 195 | gen_clingo_pred_clause(falsity,Prop,[],Env, 1=2 ). | |
| 196 | trans_not_pred(falsity,Env,Prop) :- !, | |
| 197 | gensym_if_necessary(truth,Prop), | |
| 198 | gen_clingo_fact(Prop,[],Env). | |
| 199 | trans_not_pred(subset(A,B),Env,Prop) :- !, | |
| 200 | trans_set(A,Env,P1), trans_set(B,Env,P2), | |
| 201 | clingo_format_comment('% subset (negative)~n',[]), | |
| 202 | gen_clingo_pred_clause(not_subset,Prop,[], Env, | |
| 203 | (ecall(P1,[X],Env), not(ecall(P2,[X],Env)) )). % :- P1(X), not P2(X). | |
| 204 | trans_not_pred(subset_strict(A,B),Env,Prop) :- !, | |
| 205 | precompile_set(A,Env,TA), % to avoid translating A twice | |
| 206 | precompile_set(B,Env,TB), % to avoid translating A twice | |
| 207 | trans_not_pred(conjunct(subset(TA,TB),not_set_equal(TA,TB)),Env,Prop). | |
| 208 | trans_not_pred(member(A,B),Env,Prop) :- !, | |
| 209 | trans_not_member_pred(A,B,Env,Prop). % dedicated code for translating membership | |
| 210 | trans_not_pred(set_equal(A,B),Env,Prop) :- !, % could be also translated into conjunction of subset | |
| 211 | % Note: does not exist as such in B AST: is equal with typing info = set(_) | |
| 212 | % this could also works with scalars (i.e., if P1/P2 have exactly one solution) | |
| 213 | trans_set(A,Env,P1), trans_set(B,Env,P2), | |
| 214 | CallA = ecall(P1,[X],Env), CallB = ecall(P2,[X],Env), | |
| 215 | clingo_format_comment('% set equality (negative)~n',[]), | |
| 216 | gen_clingo_pred_clause(not_set_equal,Prop,[],Env, (CallA, not(CallB) )), % :- P1(X), not P2(X). | |
| 217 | gen_clingo_clause(Prop,[],Env, (CallB, not(CallA) )). % :- P2(X), not P1(X). | |
| 218 | trans_not_pred(equal(A,B),Env,Prop) :- A = b(_,set(_),_),!, | |
| 219 | trans_not_pred(set_equal(A,B),Env,Prop). | |
| 220 | trans_not_pred(not_equal(A,B),Env,Prop) :- A = b(_,set(_),_),!, | |
| 221 | trans_not_pred(not_set_equal(A,B),Env,Prop). | |
| 222 | trans_not_pred(is_partial_function(A),Env,Prop) :- !, | |
| 223 | trans_set(A,Env,P1), | |
| 224 | clingo_format_comment('% is_partial_function (negative)~n',[]), | |
| 225 | gen_clingo_pred_clause(not_pfun,Prop,[],Env, | |
| 226 | (ecall(P1,[(X,Y)],Env), ecall(P1,[(X,Z)],Env), '!='(Y,Z)) ). % :- P1((X,Y)),P1((X,Z)), Y!=Z. | |
| 227 | trans_not_pred(is_injective(A),Env,Prop) :- !, | |
| 228 | trans_set(A,Env,P1), | |
| 229 | clingo_format_comment('% is_injective (negative)~n',[]), | |
| 230 | gen_clingo_pred_clause(not_inj,Prop,[],Env, | |
| 231 | (ecall(P1,[(Y,X)],Env), ecall(P1,[(Z,X)],Env), '!='(Y,Z)) ). % :- P1((Y,X)),P1((Z,X)), Y!=Z. | |
| 232 | trans_not_pred(is_sequence_domain(A),Env,Prop) :- !, | |
| 233 | trans_set(A,Env,P1), | |
| 234 | clingo_format_comment('% is_sequence_domain (negative)~n',[]), | |
| 235 | gen_clingo_pred_clause(not_seq,Prop,[],Env, | |
| 236 | (ecall(P1,[X],Env), '<'(X,1) )), % :- P1(X), X < 1. (sequences start at 1) | |
| 237 | gen_clingo_clause(Prop,[],Env, | |
| 238 | (ecall(P1,[X],Env), '>'(X,1), '='(X1,X-1), not(ecall(P1,[X1],Env))) ). % :- P1(X), not P1(X-1). | |
| 239 | trans_not_pred(Arith,Env,Prop) :- | |
| 240 | negate_scalar_binary_pred(Arith,A,B,ClingoOp),!, | |
| 241 | translate_top_level_scalar(A,Env,X1,CallA), | |
| 242 | translate_top_level_scalar(B,Env,X2,CallB), | |
| 243 | clingo_format_comment('% arithmetic predicate (negative) ~w~n',[ClingoOp]), | |
| 244 | gen_clingo_pred_clause(arith,Prop,[],Env, (CallA, CallB, call(ClingoOp,X1,X2) )). | |
| 245 | trans_not_pred(conjunct(P1,P2),Env,Prop) :- !, % not(P1 & P2) <=> not(P1) or not(P2) | |
| 246 | conjunction_to_list(conjunct(P1,P2),LP12,[]), | |
| 247 | l_trans_not_pred(LP12,Env,[NotP1|NotLP2]), | |
| 248 | clingo_format_comment('% conjunction (negative)~n',[]), | |
| 249 | gen_clingo_pred_clause(not_conjunct,Prop,[],Env, ecall(NotP1,Env) ), | |
| 250 | ( member(NotP2,NotLP2), | |
| 251 | gen_clingo_clause(Prop,[],Env, ecall(NotP2,Env) ), fail | |
| 252 | ; true). | |
| 253 | trans_not_pred(disjunct(P1,P2),Env,Prop) :- !, % not(P1 or P2) <=> not(P1) & not(P2) | |
| 254 | trans_not_pred(P1,Env,NotP1), | |
| 255 | trans_not_pred(P2,Env,NotP2), | |
| 256 | clingo_format_comment('% disjunction (negative)~n',[]), | |
| 257 | gen_clingo_pred_clause(not_disjunct,Prop,[],Env, (ecall(NotP1,Env) , ecall(NotP2,Env)) ). | |
| 258 | trans_not_pred(implication(P1,P2),Env,Prop) :- !, % not(P1 => P2) <=> P1 & not(P2) | |
| 259 | trans_pos_pred(P1,Env,PosP1), | |
| 260 | trans_not_pred(P2,Env,NotP2), | |
| 261 | clingo_format_comment('% implication (negative)~n',[]), | |
| 262 | gen_clingo_pred_clause(not_implication,Prop,[],Env, (ecall(PosP1,Env) , ecall(NotP2,Env)) ). | |
| 263 | trans_not_pred(equivalence(P1,P2),Env,Prop) :- !, % not(P1 <=> P2) <=> (P1 & not(P2)) or (not(P1) & P2) | |
| 264 | trans_not_pred(P1,Env,NotP1), | |
| 265 | trans_not_pred(P2,Env,NotP2), | |
| 266 | gensym_if_necessary(not_equiv,Prop), | |
| 267 | gen_clingo_clause(Prop,[],Env, (not(ecall(NotP1,Env)) , ecall(NotP2,Env)) ), | |
| 268 | gen_clingo_clause(Prop,[],Env, (ecall(NotP1,Env) , not(ecall(NotP2,Env))) ). | |
| 269 | trans_not_pred(partition(Set,ListOfSets),Env,Prop) :- | |
| 270 | maplist(trans_set_4map(Env),ListOfSets,TransSets), | |
| 271 | trans_not_pred(set_equal(Set,clingo_union(TransSets)),Env,P1), % Set = union(ListOfSets) | |
| 272 | clingo_format_comment('% partition predicate (negative)~n',[]), | |
| 273 | gen_clingo_pred_clause(not_partition,Prop,[],Env, P1 ), | |
| 274 | (append(_,[T1|T],TransSets), | |
| 275 | member(T2,T), % choose T1, T2 amongst list of translated sets | |
| 276 | gen_clingo_clause(Prop,[],Env, | |
| 277 | (ecall(T1,[X],Env), ecall(T2,[X],Env)) ), % succeed if common element, i.e., not disjoint | |
| 278 | fail ; true). | |
| 279 | trans_not_pred(Pred,Env,Prop) :- | |
| 280 | negate_pred(Pred,NotPred),!, | |
| 281 | trans_not_pred(NotPred,Env,NegProp), % translate negation and create auxiliary proposition for it | |
| 282 | clingo_format_comment('% negation~n',[]), | |
| 283 | gen_clingo_pred_clause(negated,Prop,[],Env, not(ecall(NegProp,Env)) ). % negate the proposition | |
| 284 | trans_not_pred(X,Env,Prop) :- | |
| 285 | add_b2asp_error('Ignoring unsupported predicate: ',X), | |
| 286 | functor(X,F,A), format(user_error,'Functor = ~w/~w~n',[F,A]), | |
| 287 | trans_not_pred(truth,Env,Prop). | |
| 288 | ||
| 289 | ||
| 290 | % variation of version in bsyntaxtree, also ok with special clingo subgoals | |
| 291 | conjunction_to_list(conjunct(A,B)) --> !, conjunction_to_list(A),conjunction_to_list(B). | |
| 292 | conjunction_to_list(b(conjunct(A,B),pred,_)) --> !, conjunction_to_list(A),conjunction_to_list(B). | |
| 293 | conjunction_to_list(X) --> [X]. | |
| 294 | ||
| 295 | l_trans_not_pred([],_,[]). | |
| 296 | l_trans_not_pred([P1|TP],Env,[Prop1|TProps]) :- | |
| 297 | trans_not_pred(P1,Env,Prop1), | |
| 298 | l_trans_not_pred(TP,Env,TProps). | |
| 299 | ||
| 300 | % create clingo predicates for local identifiers and generate code that sets up the local ids | |
| 301 | add_local_typed_ids([],_,Env,true,Env). | |
| 302 | add_local_typed_ids([TID|T],BoundsInfo,OldEnv, ( Constraint, TSetupCode) ,OutEnv) :- | |
| 303 | get_texpr_id(TID,ID), | |
| 304 | !, | |
| 305 | get_texpr_type(TID,BaseType), | |
| 306 | %gen_clingo_scalar_identifier(ID,BaseType,OldEnv,ClingoPred), | |
| 307 | (select(bound_id_info(ID,_,InferredBaseType),BoundsInfo,BI2) | |
| 308 | -> true %, write(user_output,b(ID,BoundsInfo)), nl(user_output), nl(user_output) | |
| 309 | ; BI2= BoundsInfo, InferredBaseType = BaseType, | |
| 310 | add_warning(b2asp,'No bounds info for : ',ID,TID) | |
| 311 | ), | |
| 312 | make_finite(InferredBaseType,ID,FiniteBaseType), % make finite here; to avoid multiple warnings later | |
| 313 | gen_base_type_constraint(FiniteBaseType,FRESHVAR,Constraint), | |
| 314 | add_new_local_id(ID,BaseType,FiniteBaseType,FRESHVAR,OldEnv,IntEnv), | |
| 315 | add_local_typed_ids(T,BI2,IntEnv,TSetupCode, OutEnv). | |
| 316 | ||
| 317 | ||
| 318 | % translate A : TB membership predicate | |
| 319 | trans_not_member_pred(A,TB,Env,Prop) :- (TB=b(B,_,_) -> true ; TB=B), | |
| 320 | specific_trans_not_member_pred(B,A,Env,Prop),!. % specific rule can be applied | |
| 321 | trans_not_member_pred(A,B,Env,Prop) :- % generic translation rule: | |
| 322 | translate_scalar(A,Env,X1,CallA), | |
| 323 | trans_set(B,Env,P2), | |
| 324 | clingo_format_comment('% member generic (negative)~n',[]), | |
| 325 | gen_clingo_pred_clause(not_member,Prop,[],Env, | |
| 326 | (CallA, not(ecall(P2,[X1],Env)) )). % :- P1(X), not P2(X). (same as subset) | |
| 327 | ||
| 328 | ||
| 329 | % special translation rules for member checks: | |
| 330 | % specific_trans_not_member_pred(Set,Element,ClingoPred) if successful Element:Set can be translated to ClingoPred | |
| 331 | specific_trans_not_member_pred(pow_subset(B),A,Env,Prop) :- !, | |
| 332 | trans_not_pred(subset(A,B),Env,Prop). % A:POW(B) <=> A <: B | |
| 333 | specific_trans_not_member_pred(pow1_subset(B),A,Env,Prop) :- !, | |
| 334 | precompile_set(A,Env,TA), % to avoid translating A twice | |
| 335 | trans_not_pred(conjunct(subset(TA,B),not_set_equal(TA,empty_set)),Env,Prop). % A:POW1(B) <=> A <: B & A /= {} | |
| 336 | specific_trans_not_member_pred(relations(Dom,Ran),A,Env,Prop) :- !, | |
| 337 | trans_not_pred(subset(A,cartesian_product(Dom,Ran)),Env,Prop). % A: Dom <-> Ran <=> A <: (Dom*Ran) | |
| 338 | specific_trans_not_member_pred(partial_function(Dom,Ran),A,Env,Prop) :- !, | |
| 339 | % A : Dom +-> Ran <=> A <: (Dom*Ran) & A: TypeDom +-> TypeRan | |
| 340 | precompile_set(A,Env,TA), % to avoid translating A twice | |
| 341 | trans_not_pred(conjunct(subset(TA,cartesian_product(Dom,Ran)), | |
| 342 | is_partial_function(TA)), | |
| 343 | Env,Prop). | |
| 344 | specific_trans_not_member_pred(partial_injection(Dom,Ran),A,Env,Prop) :- !, | |
| 345 | % A : Dom >+> Ran <=> A <: (Dom*Ran) & A: TypeDom +-> TypeRan & A~:TypeRan +-> TypeDom | |
| 346 | precompile_set(A,Env,TA), | |
| 347 | trans_not_pred(conjunct(subset(TA,cartesian_product(Dom,Ran)), | |
| 348 | conjunct(is_partial_function(TA), | |
| 349 | is_injective(TA))), | |
| 350 | Env,Prop). | |
| 351 | specific_trans_not_member_pred(total_relation(Dom,Ran),A,Env,Prop) :- !, | |
| 352 | % A : Dom <<-> Ran <=> A <: (Dom*Ran) & Dom <: domain(A) | |
| 353 | precompile_set(A,Env,TA), | |
| 354 | trans_not_pred(conjunct(subset(TA,cartesian_product(Dom,Ran)), | |
| 355 | subset(Dom,domain(TA))), | |
| 356 | Env,Prop). | |
| 357 | specific_trans_not_member_pred(total_function(Dom,Ran),A,Env,Prop) :- !, | |
| 358 | % A : Dom --> Ran <=> A <: (Dom*Ran) & A: TypeDom +-> TypeRan & Dom <: domain(A) | |
| 359 | precompile_set(A,Env,TA), | |
| 360 | trans_not_pred(conjunct(subset(TA,cartesian_product(Dom,Ran)), | |
| 361 | conjunct(is_partial_function(TA), | |
| 362 | subset(Dom,domain(TA)))), | |
| 363 | Env,Prop). | |
| 364 | specific_trans_not_member_pred(total_injection(Dom,Ran),A,Env,Prop) :- !, | |
| 365 | % A : Dom >-> Ran <=> A <: (Dom*Ran) & A: TypeDom +-> TypeRan & Dom <: domain(A) & A~:TypeRan +-> TypeDom | |
| 366 | precompile_set(A,Env,TA), | |
| 367 | trans_not_pred(conjunct(subset(TA,cartesian_product(Dom,Ran)), | |
| 368 | conjunct(is_partial_function(TA), | |
| 369 | conjunct(subset(Dom,domain(TA)), | |
| 370 | is_injective(TA)))), | |
| 371 | Env,Prop). | |
| 372 | specific_trans_not_member_pred(surjection_relation(Dom,Ran),A,Env,Prop) :- !, | |
| 373 | % A : Dom <->> Ran <=> A <: (Dom*Ran) & Ran <: range(A) | |
| 374 | precompile_set(A,Env,TA), | |
| 375 | trans_not_pred(conjunct(subset(TA,cartesian_product(Dom,Ran)), | |
| 376 | subset(Ran,range(TA))), | |
| 377 | Env,Prop). | |
| 378 | specific_trans_not_member_pred(partial_surjection(Dom,Ran),A,Env,Prop) :- !, | |
| 379 | % A : Dom +->> Ran <=> A <: (Dom*Ran) & A: TypeDom +-> TypeRan & Ran <: range(A) | |
| 380 | precompile_set(A,Env,TA), | |
| 381 | trans_not_pred(conjunct(subset(TA,cartesian_product(Dom,Ran)), | |
| 382 | conjunct(is_partial_function(TA), | |
| 383 | subset(Ran,range(TA)))), | |
| 384 | Env,Prop). | |
| 385 | specific_trans_not_member_pred(total_surjection_relation(Dom,Ran),A,Env,Prop) :- !, | |
| 386 | % A : Dom -->> Ran <=> A <: (Dom*Ran) & Dom <: domain(A) & Ran <: range(A) | |
| 387 | precompile_set(A,Env,TA), | |
| 388 | trans_not_pred(conjunct(subset(A,cartesian_product(Dom,Ran)), | |
| 389 | conjunct(subset(Dom,domain(TA)), | |
| 390 | subset(Ran,range(TA)))), | |
| 391 | Env,Prop). | |
| 392 | specific_trans_not_member_pred(total_surjection(Dom,Ran),A,Env,Prop) :- !, | |
| 393 | % A : Dom -->> Ran <=> A <: (Dom*Ran) & A: TypeDom +-> TypeRan & Dom <: domain(A) & Ran <: range(A) | |
| 394 | precompile_set(A,Env,TA), | |
| 395 | trans_not_pred(conjunct(subset(A,cartesian_product(Dom,Ran)), | |
| 396 | conjunct(is_partial_function(TA), | |
| 397 | conjunct(subset(Dom,domain(TA)), | |
| 398 | subset(Ran,range(TA))))), | |
| 399 | Env,Prop). | |
| 400 | specific_trans_not_member_pred(partial_bijection(Dom,Ran),A,Env,Prop) :- !, | |
| 401 | % A : Dom >+>> Ran <=> A : Dom +->> Ran & injective(A) | |
| 402 | precompile_set(A,Env,TA), | |
| 403 | trans_not_pred(conjunct(subset(A,cartesian_product(Dom,Ran)), | |
| 404 | conjunct(is_partial_function(TA), | |
| 405 | conjunct(is_injective(TA), | |
| 406 | subset(Ran,range(TA))))), | |
| 407 | Env,Prop). | |
| 408 | specific_trans_not_member_pred(total_bijection(Dom,Ran),A,Env,Prop) :- !, | |
| 409 | % A : Dom >->> Ran <=> A : Dom -->> Ran & injective(A) | |
| 410 | precompile_set(A,Env,TA), | |
| 411 | trans_not_pred(conjunct(subset(A,cartesian_product(Dom,Ran)), | |
| 412 | conjunct(is_partial_function(TA), | |
| 413 | conjunct(is_injective(TA), | |
| 414 | conjunct(subset(Dom,domain(TA)), | |
| 415 | subset(Ran,range(TA)))))), | |
| 416 | Env,Prop). | |
| 417 | specific_trans_not_member_pred(seq(Ran),A,Env,Prop) :- !, | |
| 418 | % A : seq(Ran) <=> ran(A) <: Ran & A: INTEGER +-> TypeRan & domain(A) = 1..N (for some N = size(A)) | |
| 419 | precompile_set(A,Env,TA), | |
| 420 | trans_not_pred(conjunct(is_sequence_domain(domain(TA)), | |
| 421 | conjunct(is_partial_function(TA), | |
| 422 | subset(range(TA),Ran))), | |
| 423 | Env,Prop). | |
| 424 | specific_trans_not_member_pred(iseq(Ran),A,Env,Prop) :- !, | |
| 425 | % A : iseq(Ran) <=> A: seq(Ran) & injective(A) | |
| 426 | precompile_set(A,Env,TA), | |
| 427 | trans_not_pred(conjunct(is_sequence_domain(domain(TA)), | |
| 428 | conjunct(is_partial_function(TA), | |
| 429 | conjunct(is_injective(TA), | |
| 430 | subset(range(TA),Ran)))), | |
| 431 | Env,Prop). | |
| 432 | specific_trans_not_member_pred(seq1(Ran),A,Env,Prop) :- !, | |
| 433 | % A : seq1(Ran) <=> A: seq(Ran) & A /= {} | |
| 434 | precompile_set(A,Env,TA), | |
| 435 | trans_not_pred(conjunct(is_sequence_domain(domain(TA)), | |
| 436 | conjunct(is_partial_function(TA), | |
| 437 | conjunct(not_set_equal(TA,empty_set), | |
| 438 | subset(range(TA),Ran)))), | |
| 439 | Env,Prop). | |
| 440 | specific_trans_not_member_pred(iseq1(Ran),A,Env,Prop) :- !, | |
| 441 | % A : iseq1(Ran) <=> A: iseq(Ran) & A /= {} | |
| 442 | precompile_set(A,Env,TA), | |
| 443 | trans_not_pred(conjunct(is_sequence_domain(domain(TA)), | |
| 444 | conjunct(is_partial_function(TA), | |
| 445 | conjunct(not_set_equal(TA,empty_set), | |
| 446 | conjunct(is_injective(TA), | |
| 447 | subset(range(TA),Ran))))), | |
| 448 | Env,Prop). | |
| 449 | specific_trans_not_member_pred(perm(Ran),A,Env,Prop) :- !, | |
| 450 | % A : perm(Ran) <=> A: iseq(Ran) & Ran <: range(A) | |
| 451 | precompile_set(A,Env,TA), | |
| 452 | precompile_set(range(TA),Env,RTA), | |
| 453 | trans_not_pred(conjunct(is_sequence_domain(domain(TA)), | |
| 454 | conjunct(is_partial_function(TA), | |
| 455 | conjunct(is_injective(TA), | |
| 456 | conjunct(subset(Ran,RTA), | |
| 457 | subset(RTA,Ran))))), | |
| 458 | Env,Prop). | |
| 459 | ||
| 460 | negate_pred(negation(Pred),Pred). | |
| 461 | negate_pred(not_set_equal(A,B),set_equal(A,B)). | |
| 462 | negate_pred(not_subset(A,B),subset(A,B)). | |
| 463 | negate_pred(not_subset_strict(A,B),subset_strict(A,B)). | |
| 464 | negate_pred(not_member(A,B),member(A,B)). | |
| 465 | ||
| 466 | % arithmetic comparison binary operators along with a translation in Clingo | |
| 467 | scalar_binary_pred(less(A,B),A,B,'<'). | |
| 468 | scalar_binary_pred(greater(A,B),A,B,'>'). | |
| 469 | scalar_binary_pred(less_equal(A,B),A,B,'<='). % note this is different from Prolog =< comparison syntax | |
| 470 | scalar_binary_pred(greater_equal(A,B),A,B,'>='). | |
| 471 | % can also apply to scalars other than integers: | |
| 472 | %scalar_binary_pred(equal(A,B),A,B,'='). % use code in trans_not_pred to handle set equality! | |
| 473 | %scalar_binary_pred(not_equal(A,B),A,B,'!='). % ditto | |
| 474 | ||
| 475 | % arithmetic comparison binary operators along with a translation of the negation to Clingo | |
| 476 | negate_scalar_binary_pred(less(A,B),A,B,'>='). | |
| 477 | negate_scalar_binary_pred(greater(A,B),A,B,'<='). % note this is different from Prolog =< comparison syntax | |
| 478 | negate_scalar_binary_pred(less_equal(A,B),A,B,'>'). | |
| 479 | negate_scalar_binary_pred(greater_equal(A,B),A,B,'<'). | |
| 480 | % can also apply to scalars other than integers: | |
| 481 | negate_scalar_binary_pred(equal(A,B),A,B,'!='). | |
| 482 | negate_scalar_binary_pred(not_equal(A,B),A,B,'='). | |
| 483 | ||
| 484 | % binary predicate operators that can be translated into a single constraint | |
| 485 | bin_op_pred_single_call(equal(A,B),A,B,'='). % equality for scalar | |
| 486 | bin_op_pred_single_call(not_equal(A,B),A,B,'!='). | |
| 487 | ||
| 488 | % ------------------------------ | |
| 489 | % translating SET EXPRESSIONS | |
| 490 | % ------------------------------ | |
| 491 | ||
| 492 | :- use_module(probsrc(bsyntaxtree),[is_set_type/2]). | |
| 493 | ||
| 494 | % translate a B set value to a Clingo predicate and wrap it into a special BAST constructor | |
| 495 | % useful to avoid re-translating the same set multiple times, e.g., in partial_function, ... | |
| 496 | precompile_set(BAST,Env,clingo_set(ClingoPred)) :- trans_set(BAST,Env,ClingoPred). | |
| 497 | ||
| 498 | trans_set_4map(Env,BAST,ClingoPred) :- trans_set(BAST,Env,ClingoPred). | |
| 499 | ||
| 500 | :- mode trans_set(+BAST,+LocalID_Env,-ClingoPred). | |
| 501 | % translate a B set value (of scalars) to a Clingo predicate Pred(X). | |
| 502 | % Pred(X) is true if X represents an element of the B set | |
| 503 | trans_set(b(Expr,Type,_Infos),Env,Pred) :- % format(user_output,' set --> ~w~n',[Expr]), | |
| 504 | (is_set_type(Type,BaseType) | |
| 505 | -> ( Expr = identifier(ID) -> | |
| 506 | NExpr=identifier(ID,Bounds), | |
| 507 | find_bounds_info(ID,set(BaseType),Env,set(Bounds)) | |
| 508 | ; Expr = comprehension_set(TIds,Body) -> NExpr = comprehension_set(TIds,BaseType,Body) | |
| 509 | ; NExpr = Expr) | |
| 510 | ; add_b2asp_error('Type of expression is not a set: ',Type), fail | |
| 511 | ), | |
| 512 | !, | |
| 513 | trans_set(NExpr,Env,Pred). | |
| 514 | trans_set(empty_set,Env,Pred) :- !, | |
| 515 | DummyArg = 0, % Clingo does not like unbound variables in head?? | |
| 516 | gensym_if_necessary(empty,Pred), | |
| 517 | gen_clingo_clause(Pred,[DummyArg],Env, 1=2 ). | |
| 518 | trans_set(bool_set,Env,Pred) :- !, | |
| 519 | trans_set(set_extension([pred_false,pred_true]),Env,Pred). | |
| 520 | trans_set(value(V),Env,Pred) :- V==[], !, trans_set(empty_set,Env,Pred). | |
| 521 | trans_set(value(AVL),Env,Pred) :- | |
| 522 | custom_explicit_sets:expand_custom_set_to_list_now(AVL,L),!, % this creates Value list not set_extension list ! TODO | |
| 523 | trans_set(set_extension(L),Env,Pred). | |
| 524 | trans_set(sequence_extension(L),Env,Pred) :- !, | |
| 525 | add_indices(L,1,Set), | |
| 526 | trans_set(set_extension(Set),Env,Pred). | |
| 527 | trans_set(set_extension(L),Env,Pred) :- !, | |
| 528 | gensym_if_necessary(set_ext,Pred), | |
| 529 | maplist(trans_scalar4map(Env,Pred),L). | |
| 530 | trans_set(union(A,B),Env,Pred) :- !, | |
| 531 | trans_set(A,Env,P1), | |
| 532 | trans_set(B,Env,P2), | |
| 533 | clingo_format_comment('% union of sets~n',[]), | |
| 534 | gen_clingo_pred_clause(union,Pred,[X],Env, (ecall(P1,[X],Env)) ), | |
| 535 | gen_clingo_clause(Pred,[X],Env, (ecall(P2,[X],Env)) ). | |
| 536 | trans_set(clingo_union([P1|T]),Env,Pred) :- !, % a union of a list of already translated sets; used for partition | |
| 537 | clingo_format_comment('% union of clingo sets~n',[]), | |
| 538 | gen_clingo_pred_clause(unions,Pred,[X],Env, (ecall(P1,[X],Env)) ), | |
| 539 | (member(P2,T), | |
| 540 | gen_clingo_clause(Pred,[X],Env, (ecall(P2,[X],Env)) ), | |
| 541 | fail ; true). | |
| 542 | trans_set(clingo_set(P),_Env,Pred) :- !, Pred=P. % already translated set | |
| 543 | trans_set(intersection(A,B),Env,Pred) :- !, | |
| 544 | trans_set(A,Env,P1), | |
| 545 | trans_set(B,Env,P2), | |
| 546 | clingo_format_comment('% intersection of sets~n',[]), | |
| 547 | gen_clingo_pred_clause(inter,Pred,[X],Env, (ecall(P1,[X],Env),ecall(P2,[X],Env)) ). | |
| 548 | trans_set(set_subtraction(A,B),Env,Pred) :- !, % difference set in B | |
| 549 | trans_set(A,Env,P1), | |
| 550 | trans_set(B,Env,P2), | |
| 551 | clingo_format_comment('% difference of sets~n',[]), | |
| 552 | gen_clingo_pred_clause(diff,Pred,[X],Env, | |
| 553 | (ecall(P1,[X],Env),not(ecall(P2,[X],Env))) ). % Pred(X) :- P1(X), not P2(X). | |
| 554 | trans_set(cartesian_product(A,B),Env,Pred) :- !, | |
| 555 | trans_set(A,Env,P1), | |
| 556 | trans_set(B,Env,P2), | |
| 557 | clingo_format_comment('% Cartesian product~n',[]), | |
| 558 | gen_clingo_pred_clause(cart,Pred,[(X,Y)],Env, (ecall(P1,[X],Env),ecall(P2,[Y],Env)) ). % Pred((X,Y)) :- P1(X), P2(Y). | |
| 559 | trans_set(domain(A),Env,Pred) :- !, | |
| 560 | trans_set(A,Env,P1), | |
| 561 | clingo_format_comment('% domain of relation~n',[]), | |
| 562 | gen_clingo_pred_clause(domain,Pred,[X],Env, ecall(P1,[(X,_)],Env) ). % Pred(X) :- P1((X,_)). | |
| 563 | trans_set(range(A),Env,Pred) :- !, | |
| 564 | trans_set(A,Env,P1), | |
| 565 | clingo_format_comment('% range of relation~n',[]), | |
| 566 | gen_clingo_pred_clause(range,Pred,[X],Env, ecall(P1,[(_,X)],Env) ). % Pred(X) :- P1((_,X)). | |
| 567 | trans_set(image(Rel,Set),Env,Pred) :- !, % relational image B operator | |
| 568 | trans_set(Rel,Env,P1), | |
| 569 | trans_set(Set,Env,P2), | |
| 570 | clingo_format_comment('% relational image~n',[]), | |
| 571 | gen_clingo_pred_clause(image,Pred,[Y],Env, | |
| 572 | (ecall(P2,[X],Env),ecall(P1,[(X,Y)],Env)) ). % Pred(Y) :- P1(X), P2((X,Y)). | |
| 573 | trans_set(domain_restriction(Set,Rel),Env,Pred) :- !, % domain restriction B operator Set <| Rel | |
| 574 | trans_set(Set,Env,P1), | |
| 575 | trans_set(Rel,Env,P2), | |
| 576 | clingo_format_comment('% domain restriction of relation~n',[]), | |
| 577 | gen_clingo_pred_clause(dres,Pred,[(X,Y)],Env, | |
| 578 | (ecall(P1,[X],Env),ecall(P2,[(X,Y)],Env)) ). % Pred((X,Y)) :- P1(X), P2((X,Y)). | |
| 579 | trans_set(domain_subtraction(Set,Rel),Env,Pred) :- !, % domain subtraction B operator Set <<| Rel | |
| 580 | trans_set(Set,Env,P1), | |
| 581 | trans_set(Rel,Env,P2), | |
| 582 | clingo_format_comment('% domain subtraction of relation~n',[]), | |
| 583 | gen_clingo_pred_clause(dsub,Pred,[(X,Y)],Env, | |
| 584 | (ecall(P2,[(X,Y)],Env),not(ecall(P1,[X],Env))) ). % Pred((X,Y)) :- P2((X,Y)), not P(X). | |
| 585 | trans_set(range_restriction(Rel,Set),Env,Pred) :- !, % range restriction B operator Rel |> Set | |
| 586 | trans_set(Set,Env,P1), | |
| 587 | trans_set(Rel,Env,P2), | |
| 588 | clingo_format_comment('% range restriction of relation~n',[]), | |
| 589 | gen_clingo_pred_clause(rres,Pred,[(X,Y)],Env, | |
| 590 | (ecall(P1,[Y],Env),ecall(P2,[(X,Y)],Env)) ). % Pred((X,Y)) :- P1(Y), P2((X,Y)). | |
| 591 | trans_set(range_subtraction(Rel,Set),Env,Pred) :- !, % range subtraction B operator Rel |>> Set | |
| 592 | trans_set(Set,Env,P1), | |
| 593 | trans_set(Rel,Env,P2), | |
| 594 | clingo_format_comment('% range subtraction of relation~n',[]), | |
| 595 | gen_clingo_pred_clause(rsub,Pred,[(X,Y)],Env, | |
| 596 | (ecall(P2,[(X,Y)],Env), not(ecall(P1,[Y],Env))) ). % Pred((X,Y)) :- P2((X,Y)), not P1(Y). | |
| 597 | trans_set(composition(A,B),Env,Pred) :- !, % relational composition operator | |
| 598 | trans_set(A,Env,P1), | |
| 599 | trans_set(B,Env,P2), | |
| 600 | clingo_format_comment('% relational composition~n',[]), | |
| 601 | gen_clingo_pred_clause(comp,Pred,[(X,Z)],Env, | |
| 602 | (ecall(P1,[(X,Y)],Env),ecall(P2,[(Y,Z)],Env)) ). % Pred((X,Z)) :- P1((X,Y)), P2((Y,Z)). | |
| 603 | trans_set(closure(A),Env,Pred) :- !, % closure1 transitive operator | |
| 604 | trans_set(A,Env,P1), | |
| 605 | clingo_format_comment('% transitive closure of relation~n',[]), | |
| 606 | gen_clingo_pred_clause(closure1,Pred,[(X,Y)],Env, ecall(P1,[(X,Y)],Env) ), % Pred((X,Y)) :- P1((X,Y)). | |
| 607 | gen_clingo_clause(Pred,[(X,Z)],Env, | |
| 608 | ( ecall(P1,[(X,Y)],Env) , ecall(Pred,[(Y,Z)],Env)) ). % Pred((X,Z)) :- P1((X,Y)), Pred((Y,Z)). | |
| 609 | trans_set(iteration(A,B),Env,Pred) :- !, % iterate(Rel,Nr) operator | |
| 610 | trans_set(A,Env,P1), | |
| 611 | trans_scalar(B,Env,P2), | |
| 612 | clingo_format_comment('% iterate over relation~n',[]), | |
| 613 | gen_clingo_pred_clause(iterate_recursion,RecP,[(X,Y),1],Env, ecall(P1,[(X,Y)],Env) ), % RecP((X,Y),1) :- P1((X,Y)). | |
| 614 | gen_clingo_clause(RecP,[(X,X),0],Env, ( ecall(P1,[(X,_)],Env) ) ), % reflexive closure, using domain elements | |
| 615 | gen_clingo_clause(RecP,[(X,X),0],Env, ( ecall(P1,[(_,X)],Env) ) ) , % + range elements (not B-Book semantics) | |
| 616 | gen_clingo_clause(RecP,[(X,Z),Nr],Env, | |
| 617 | ( Nr>1, ecall(P2,[Lim],Env), '<='(Nr,Lim), N1 = Nr-1, ecall(P1,[(X,Y)],Env) , ecall(RecP,[(Y,Z),N1],Env)) ), | |
| 618 | % RecP((X,Z),Nr) :-Nr>1, N1 is N-1, P1((X,Y)), RecP((Y,Z),N1). | |
| 619 | gen_clingo_pred_clause(iterate,Pred,[X],Env, (ecall(P2,[Nr],Env), ecall(RecP,[X,Nr],Env)) ). % Pred(X) :- RecP(X,Nr). | |
| 620 | trans_set(overwrite(A,B),Env,Pred) :- !, % relational override operator | |
| 621 | trans_set(A,Env,P1), | |
| 622 | trans_set(B,Env,P2), | |
| 623 | trans_set(domain(B),Env,P3), % we need to create a separate domain encoding to be able to use it inside the "not" below | |
| 624 | clingo_format_comment('% relational override~n',[]), | |
| 625 | gen_clingo_pred_clause(overwr,Pred,[(X,Y)],Env, ecall(P2,[(X,Y)],Env) ), % Pred((X,Y)) :- P2((X,Y)). | |
| 626 | gen_clingo_clause(Pred,[(X,Y)],Env, | |
| 627 | (ecall(P1,[(X,Y)],Env),not(ecall(P3,[X],Env))) ). % Pred((X,Y)) :- P1((X,Y)), not P3(X). | |
| 628 | trans_set(identity(A),Env,Pred) :- !, % identity operator | |
| 629 | trans_set(A,Env,P1), | |
| 630 | clingo_format_comment('% identity relation~n',[]), | |
| 631 | gen_clingo_pred_clause(id,Pred,[(X,X)],Env, ecall(P1,[X],Env) ). % Pred((X,X)) :- P1(X). | |
| 632 | trans_set(reverse(A),Env,Pred) :- !, % reverse B operator r~ | |
| 633 | trans_set(A,Env,P1), | |
| 634 | clingo_format_comment('% relational inverse~n',[]), | |
| 635 | gen_clingo_pred_clause(rev,Pred,[(Y,X)],Env, (ecall(P1,[(X,Y)],Env))). % Pred((Y,X)) :- P1((X,Y)). | |
| 636 | trans_set(interval(A,B),Env,Pred) :- !, | |
| 637 | translate_scalar(A,Env,X1,C1), | |
| 638 | translate_scalar(B,Env,X2,C2), | |
| 639 | clingo_format_comment('% interval~n',[]), | |
| 640 | gen_clingo_pred_clause(interval,Pred,[X],Env, (C1,C2,'='(X,'..'(X1,X2))) ). | |
| 641 | trans_set(if_then_else(Test,Then,Else),Env,Pred) :- !, | |
| 642 | trans_pos_pred(Test,Env,TestProp), | |
| 643 | trans_set(Then,Env,PX), trans_set(Else,Env,PY), | |
| 644 | clingo_format_comment('% IF-THEN-ELSE (for sets)~n',[]), | |
| 645 | gen_clingo_pred_clause(ifte,Pred,[X],Env, (ecall(TestProp,[],Env), ecall(PX,[X],Env) ) ), | |
| 646 | gen_clingo_clause( Pred,[Y],Env, (ecall(PY,[Y],Env), not(ecall(TestProp,[],Env)) ) ). | |
| 647 | trans_set(global(ID),Env,Pred) :- % B value for entire global enumerated/deferred set ID | |
| 648 | b_get_fd_type_bounds(ID,Low,Up),!, | |
| 649 | trans_set(interval(Low,Up),Env,Pred). | |
| 650 | trans_set(identifier(ID,global(ID)),Env,Pred) :- % TODO: proper checking of scoping | |
| 651 | b_get_fd_type_bounds(ID,Low,Up),!, | |
| 652 | trans_set(interval(Low,Up),Env,Pred). | |
| 653 | trans_set(identifier(ID,_BaseType1),Env,Pred) :- clingo_local_id(ID,Env,_BaseType2,_Var), !, | |
| 654 | add_b2asp_warning('Local identifier used as set (probably not supported):',ID), | |
| 655 | Pred = fail. | |
| 656 | trans_set(identifier(ID,BaseType),_Env,Pred) :- !, | |
| 657 | gen_clingo_set_identifier(ID,BaseType,Pred). | |
| 658 | trans_set(comprehension_set(TIds,BaseType,Body),Env,Pred) :- !, | |
| 659 | check_empty_env(Env,TIds,Body), | |
| 660 | infer_bounds_within_env(TIds,Body,Env,BoundsInfo), | |
| 661 | format(user_output,'~n Comprehension set: ~w~n ~w~n ~w~n',[TIds,BoundsInfo,BaseType]), | |
| 662 | findall(RestrictedType,member(bound_id_info(_,_,RestrictedType),BoundsInfo),ArgTypes), | |
| 663 | couplise_list(ArgTypes,RestrictedBaseType), | |
| 664 | gensym(comprehension_set,CompID), | |
| 665 | gen_clingo_set_identifier(CompID,RestrictedBaseType,Pred,comprehension_set), % create a new id to represent the set | |
| 666 | create_couple(TIds,Couple), | |
| 667 | trans_not_pred(conjunct( % state that the set contains exactly the solutions to Body | |
| 668 | forall_with_precomputed_bounds(TIds,BoundsInfo,member(Couple,clingo_set(Pred)), Body), | |
| 669 | forall_with_precomputed_bounds(TIds,BoundsInfo,Body, member(Couple,clingo_set(Pred)))), Env, ICProp), | |
| 670 | gen_clingo_ic_constraint( ICProp ). | |
| 671 | ||
| 672 | trans_set(X,_Env,Pred) :- %write(user_error,X),nl(user_error), | |
| 673 | add_b2asp_error('Unsupported set: ',X),Pred=fail. | |
| 674 | ||
| 675 | ||
| 676 | check_empty_env(env([],_),_,_) :- !. | |
| 677 | check_empty_env(_,Term,Span) :- add_b2asp_error('Unsupported nesting: ',Term,Span),fail. | |
| 678 | ||
| 679 | ||
| 680 | % add indices to sequence extension list: | |
| 681 | add_indices([],_,[]). | |
| 682 | add_indices([H|T],Nr,[couple(integer(Nr),H)|CT]) :- N1 is Nr+1, | |
| 683 | add_indices(T,N1,CT). | |
| 684 | ||
| 685 | ||
| 686 | translate_top_level_scalar(Lit,Env,ClingoValue,ClingoCall) :- | |
| 687 | valid_top_level_literal(Lit,Env,ClingoCst),!, | |
| 688 | % set aggregates can only be used as literals at the top-level; #max(...) + #max(..) is not allowed | |
| 689 | ClingoValue=ClingoCst, ClingoCall=true. | |
| 690 | translate_top_level_scalar(Lit,Env,ClingoValue,ClingoCall) :- translate_scalar(Lit,Env,ClingoValue,ClingoCall). | |
| 691 | ||
| 692 | :- mode translate_scalar(+BAST,+LocalID_Env,-ClingoValue,-ClingoPred). | |
| 693 | % an optimised version of translate scalar | |
| 694 | % may produce true as ClingoCall if value can be represented as Clingo Constant | |
| 695 | % running ClingoCall in clingo will produce result in ClingoValue | |
| 696 | translate_scalar(Lit,Env,ClingoValue,ClingoCall) :- | |
| 697 | valid_literal_or_local_id(Lit,Env,ClingoCst),!, | |
| 698 | ClingoValue=ClingoCst, ClingoCall=true. | |
| 699 | translate_scalar(BOP,Env,ClingoExpr,C12) :- bin_op(BOP,A,B,OP), !, | |
| 700 | translate_scalar(A,Env,X1,C1), | |
| 701 | translate_scalar(B,Env,X2,C2), | |
| 702 | conj(C1,C2,C12), | |
| 703 | ClingoExpr =.. [OP,X1,X2]. | |
| 704 | translate_scalar(Lit,Env,ClingoValue,ClingoCall) :- | |
| 705 | trans_scalar(Lit,Env,Pred), | |
| 706 | ClingoCall = ecall(Pred,[ClingoValue],Env). | |
| 707 | % TODO: for identifiers we should also pass an environment storing which Clingo Predicate is mapped to which identifier | |
| 708 | % ditto for set translation | |
| 709 | ||
| 710 | ||
| 711 | scalar_type(real). % not supported | |
| 712 | scalar_type(string). | |
| 713 | scalar_type(boolean). | |
| 714 | scalar_type(integer). | |
| 715 | scalar_type(global(_)). | |
| 716 | scalar_type(couple(A,B)) :- scalar_type(A), scalar_type(B). | |
| 717 | ||
| 718 | ||
| 719 | % ------------------------------ | |
| 720 | % translating SCALAR EXPRESSIONS | |
| 721 | ||
| 722 | % special version for maplist: | |
| 723 | trans_scalar4map(Env,Pred,El) :- trans_scalar(El,Env,Pred). | |
| 724 | ||
| 725 | ||
| 726 | :- mode trans_scalar(+BAST,+LocalID_Env,-ClingoPred). | |
| 727 | % translate a scalar B value V (integers, booleans, strings, ...) to a Clingo predicate Pred(X). | |
| 728 | % Pred(X) is true if X corresponds to the B value V | |
| 729 | ||
| 730 | trans_scalar(b(Expr,Type,_Infos),Env,Pred) :- | |
| 731 | (scalar_type(Type) | |
| 732 | -> (Expr = identifier(ID) -> NExpr=identifier(ID,Bounds), | |
| 733 | find_bounds_info(ID,Type,Env,Bounds) | |
| 734 | ; NExpr = Expr) | |
| 735 | ; is_set_type(Type,_) -> add_b2asp_error('Set expression is not supported here, scalar expected: ',Type), fail | |
| 736 | ; add_b2asp_error('Type of expression is not a scalar: ',Type), fail | |
| 737 | ), | |
| 738 | !, | |
| 739 | trans_scalar(NExpr,Env,Pred). | |
| 740 | trans_scalar(Lit,Env,Pred) :- valid_literal(Lit,Env,ClingoCst), !, | |
| 741 | % cannot deal with local ID, as this result is a variable; we could create proj. function TODO | |
| 742 | gensym_if_necessary(lit,Pred), | |
| 743 | gen_clingo_fact(Pred,[ClingoCst],Env). | |
| 744 | trans_scalar(BOP,Env,Pred) :- bin_op(BOP,A,B,OP), !, | |
| 745 | translate_scalar(A,Env,X1,C1), | |
| 746 | translate_scalar(B,Env,X2,C2), | |
| 747 | ClingoExpr =.. [OP,X1,X2], | |
| 748 | clingo_format_comment('% scalar binary operator ~w~n',[OP]), | |
| 749 | gen_clingo_pred_clause(bop,Pred,[X],Env, (C1,C2,'='(X,ClingoExpr)) ). % TODO: '=' and '==' both seem to work, :=/2 ?? | |
| 750 | trans_scalar(UnOP,Env,Pred) :- un_op(UnOP,A,OP), !, | |
| 751 | translate_scalar(A,Env,X1,C1), | |
| 752 | ClingoExpr =.. [OP,X1], | |
| 753 | clingo_format_comment('% scalar unary operator ~w~n',[OP]), | |
| 754 | gen_clingo_pred_clause(unop,Pred,[X],Env, (C1,'='(X,ClingoExpr)) ). % TODO: '=' and '==' both seem to work | |
| 755 | trans_scalar(Aggr,Env,Pred) :- set_aggregate(Aggr,Set,ClingoAggr,Prefix),!, | |
| 756 | trans_set(Set,Env,P1), | |
| 757 | gen_clingo_count_aggregate(ClingoAggr,P1,Env,P1Aggregate), | |
| 758 | clingo_format_comment('% set aggregate ~w~n',[ClingoAggr]), | |
| 759 | gen_clingo_pred_clause(Prefix,Pred,[X],Env, '='(X,P1Aggregate) ). % Count = #count{Var : node(Var)} ,.... | |
| 760 | trans_scalar(first_of_pair(A),Env,Pred) :- !, % prj1 (same translation as domain) | |
| 761 | translate_scalar(A,Env,Couple,C1), Couple = (X,_), | |
| 762 | clingo_format_comment('% projection 1 of pair~n',[]), | |
| 763 | gen_clingo_pred_clause(prj1,Pred,[X],Env, C1 ). % Pred(X) :- P1((X,_)). | |
| 764 | trans_scalar(second_of_pair(A),Env,Pred) :- !, % prj2 (same translation as range) | |
| 765 | translate_scalar(A,Env,Couple,C1), Couple = (_,X), | |
| 766 | clingo_format_comment('% projection 2 of pair~n',[]), | |
| 767 | gen_clingo_pred_clause(prj2,Pred,[X],Env, C1 ). % Pred(X) :- P1((_,X)). | |
| 768 | trans_scalar(function(Rel,Arg),Env,Pred) :- !, % function application operator; same translation as image | |
| 769 | trans_set(Rel,Env,P1), | |
| 770 | translate_scalar(Arg,Env,X,C2), | |
| 771 | clingo_format_comment('% function application~n',[]), | |
| 772 | gen_clingo_pred_clause(apply,Pred,[Y],Env, | |
| 773 | (C2, ecall(P1,[(X,Y)],Env)) ). % Pred(Y) :- P1(X), P2((X,Y)). | |
| 774 | trans_scalar(if_then_else(Test,Then,Else),Env,Pred) :- !, % see also set version | |
| 775 | trans_pos_pred(Test,Env,TestProp), | |
| 776 | translate_scalar(Then,Env,X,CX), translate_scalar(Else,Env,Y,CY), | |
| 777 | clingo_format_comment('% IF-THEN-ELSE~n',[]), | |
| 778 | gen_clingo_pred_clause(ifte,Pred,[X],Env, ( ecall(TestProp,[],Env), CX ) ), | |
| 779 | gen_clingo_clause( Pred,[Y],Env, ( CY, not(ecall(TestProp,[],Env)) ) ). | |
| 780 | trans_scalar(string(String),Env,Pred) :- !, | |
| 781 | get_string_nr(String,Nr), | |
| 782 | trans_scalar(Nr,Env,Pred). | |
| 783 | trans_scalar(fd(Nr,GS),Env,Pred) :- integer(Nr), % enumerated/deferred set element member as B value | |
| 784 | b_get_fd_type_bounds(GS,Low,Up), Nr>=Low, Nr=<Up, !, | |
| 785 | trans_scalar(Nr,Env,Pred). | |
| 786 | trans_scalar(identifier(ID,_BaseType),Env,Pred) :- clingo_local_id(ID,Env, __BaseType,Var), !, | |
| 787 | % generate a Clingo projection predicate that picks the Var from the Env | |
| 788 | atom_concat(local_id_,ID,Prefix), | |
| 789 | clingo_format_comment('% projection for local variable ~w~n',[ID]), | |
| 790 | gen_clingo_pred_clause(Prefix,Pred,[X],Env, (X = Var) ). | |
| 791 | trans_scalar(identifier(ID,global(GS)),Env,Pred) :- % TODO: proper checking of scoping and add case to translate_scalar | |
| 792 | lookup_global_constant(ID,fd(Nr,GS)),!, | |
| 793 | trans_scalar(Nr,Env,Pred). | |
| 794 | trans_scalar(identifier(ID,BaseType),Env,Pred) :- !, | |
| 795 | gen_clingo_scalar_identifier(ID,BaseType,Env,IdPred), | |
| 796 | (var(Pred) -> Pred=IdPred | |
| 797 | ; clingo_format_comment('% scalar identifier ~w~n',[ID]), % mainly for set_extensions | |
| 798 | gen_clingo_pred_clause(id_scalar,Pred,[X],Env, ecall(IdPred,[X],Env) )). % Pred(X) :- Id(X) | |
| 799 | trans_scalar(X,_,P) :- %write(user_error,X),nl(user_error), | |
| 800 | add_b2asp_error('Unsupported scalar: ',X), P=fail. | |
| 801 | ||
| 802 | % B set aggregates which can be translated to Clingo aggregates: | |
| 803 | set_aggregate(card(Set),Set,'#count',count). | |
| 804 | set_aggregate(min(Set),Set,'#min',min). | |
| 805 | set_aggregate(max(Set),Set,'#max',max). | |
| 806 | set_aggregate(GeneralSum,Set,'#sum',sum) :- detect_set_summation(GeneralSum,Set). | |
| 807 | % Clingo also supports avg | |
| 808 | ||
| 809 | detect_set_summation(Expr,SET) :- % detect special pattern SIGMA(ID).(ID:SET|ID) | |
| 810 | Expr = general_sum([TID1],b(member(TID2,SET),pred,_),TID3), | |
| 811 | get_texpr_id(TID1,ID), get_texpr_id(TID2,ID), get_texpr_id(TID3,ID). | |
| 812 | ||
| 813 | ||
| 814 | % binary operators and their Clingo Translation | |
| 815 | bin_op(b(BOP,_,_),A,B,Op) :- bin_op(BOP,A,B,Op). | |
| 816 | bin_op(A+B,A,B,+). | |
| 817 | bin_op(add(A,B),A,B,+). | |
| 818 | bin_op(A-B,A,B,-). | |
| 819 | bin_op(minus(A,B),A,B,-). | |
| 820 | bin_op(A*B,A,B,*). | |
| 821 | bin_op(multiplication(A,B),A,B,*). | |
| 822 | bin_op(power_of(A,B),A,B,'**'). | |
| 823 | bin_op(A/B,A,B,/). | |
| 824 | bin_op(div(A,B),A,B,/). | |
| 825 | % TODO: floored_div | |
| 826 | bin_op(A mod B,A,B,\). | |
| 827 | bin_op(modulo(A,B),A,B,\). | |
| 828 | bin_op((A,B),A,B,','). | |
| 829 | bin_op(couple(A,B),A,B,','). | |
| 830 | ||
| 831 | % unary operators and their Clingo Translation | |
| 832 | un_op(unary_minus(A),A,-). | |
| 833 | ||
| 834 | ||
| 835 | :- mode valid_literal_or_local_id(+BAST,+LocalID_Environment,-ClingoLiteral). | |
| 836 | valid_literal_or_local_id(TID,Env,Res) :- is_identifier(TID,ID), | |
| 837 | clingo_local_id(ID,Env,_BaseType,Var),!, | |
| 838 | Res = Var. % not really a literal, but local id | |
| 839 | valid_literal_or_local_id(BAST,Env, ClingoLiteral) :- valid_literal(BAST, Env,ClingoLiteral). | |
| 840 | ||
| 841 | is_identifier(identifier(ID),ID). | |
| 842 | is_identifier(b(TID,_,_),ID) :- is_identifier(TID,ID). | |
| 843 | ||
| 844 | :- mode valid_literal(+BAST,+Env,-ClingoLiteral). | |
| 845 | % is true if the B AST directly represents a valid Clingo literal | |
| 846 | valid_literal(b(Lit,_,_),Env,Res) :- !, valid_literal(Lit,Env,Res). | |
| 847 | valid_literal(Lit,_,Nr) :- number(Lit),!,Nr=Lit. | |
| 848 | valid_literal(identifier(ID),_,Nr) :- !,deterministic_id_value(ID,Nr). | |
| 849 | valid_literal(fd(LitNr,_GS),_,Nr) :- !, Nr=LitNr. | |
| 850 | valid_literal(pred_true,_,pred_true). | |
| 851 | valid_literal(pred_false,_,pred_false). | |
| 852 | valid_literal(boolean_true,_,pred_true). % AST node for TRUE | |
| 853 | valid_literal(boolean_false,_,pred_false). % AST node for FALSE | |
| 854 | valid_literal(string(S),_,Nr) :- !, get_string_nr(S,Nr). | |
| 855 | valid_literal(integer(Lit),_,Nr) :- number(Lit),!,Nr=Lit. | |
| 856 | valid_literal(int(Lit),_,Nr) :- number(Lit),!,Nr=Lit. % from B values rather than AST's | |
| 857 | valid_literal(max_int,_,Nr) :- get_preference(maxint,Nr). | |
| 858 | valid_literal(min_int,_,Nr) :- get_preference(minint,Nr). | |
| 859 | valid_literal(value(V),Env,Nr) :- nonvar(V),!, valid_literal(V,Env,Nr). | |
| 860 | valid_literal(BOP,Env,Nr) :- binary_arith_op(BOP,A,B,Op), | |
| 861 | valid_literal(A,Env,LA), number(LA), | |
| 862 | valid_literal(B,Env,LB), number(LB), | |
| 863 | Call =.. [Op,LA,LB], Nr is Call. | |
| 864 | valid_literal(div(A,B),Env,Nr) :- % TODO: also modulo; but be careful with negative nrs! | |
| 865 | valid_literal(B,Env,LB), integer(LB), LB \= 0, | |
| 866 | valid_literal(A,Env,LA), integer(LA), | |
| 867 | Nr is LA//LB. | |
| 868 | valid_literal(couple(A,B),Env,(LA,LB)) :- !, | |
| 869 | valid_literal(A,Env,LA), valid_literal(B,Env,LB). % Clingo accepts pairs as literals | |
| 870 | valid_literal((A,B),Env,(LA,LB)) :- !, | |
| 871 | valid_literal(A,Env,LA), valid_literal(B,Env,LB). % the same for pair valuesvariable which has been set-up | |
| 872 | ||
| 873 | % binary operator that can be pre-computed | |
| 874 | binary_arith_op(add(A,B),A,B,+). | |
| 875 | binary_arith_op(minus(A,B),A,B,-). | |
| 876 | binary_arith_op(multiplication(A,B),A,B,*). | |
| 877 | binary_arith_op(power_of(A,B),A,B,'^'). | |
| 878 | ||
| 879 | ||
| 880 | % clingo does not seem to allow to use set aggregates withing arithmetic operations | |
| 881 | valid_top_level_literal(b(Lit,_,_),Env,Res) :- !, valid_top_level_literal(Lit,Env,Res). | |
| 882 | valid_top_level_literal(Aggr,Env,Res) :- set_aggregate(Aggr,Set,ClingoAggr,_), | |
| 883 | trans_set(Set,Env,P1), | |
| 884 | gen_clingo_count_aggregate(ClingoAggr,P1,Env,Res). % treat aggregates as literals, to enable more efficient encoding by clingo, e.g., for things like #card(...) = 1 | |
| 885 | % TODO: reals, enumerated set elements, ... | |
| 886 | ||
| 887 | ||
| 888 | % ------------------------------ | |
| 889 | ||
| 890 | % LOCAL Environment manipulation | |
| 891 | ||
| 892 | % environment contains list of universally quantified local variables and bounds info for existential ones | |
| 893 | create_new_local_id_env(env(LocalIds,ExistsBoundsInfo)) :- LocalIds = [], ExistsBoundsInfo=[]. | |
| 894 | ||
| 895 | clingo_local_id(ID,env(Env,_),BaseType,Var) :- member(local_id(ID,_,BaseType,Var),Env). | |
| 896 | add_new_local_id(ID,Type,FiniteBaseType,Var,env(Env,LB),env(NewEnv,LB)) :- | |
| 897 | %format(user_output,'Adding local id ~w to ~w~n',[ID,Env]), | |
| 898 | NewEnv = [local_id(ID,Type,FiniteBaseType,Var)|Env]. % TODO: proper update | |
| 899 | ||
| 900 | add_new_local_id_bounds(BI,env(Local,B),env(Local,NewB)) :- | |
| 901 | append(BI,B,NewB). | |
| 902 | ||
| 903 | infer_bounds_within_env(Paras,Pred,Env,BoundsInfo) :- | |
| 904 | start_ms_timer(T1), | |
| 905 | get_full_bounds_information(Env,OB), | |
| 906 | infer_bounds(Paras,Pred,[outer_bounds(OB)],BoundsInfo), | |
| 907 | get_elapsed_walltime(T1,WT1),add_to_profile_stats(b2asp_bounds_analysis_time,WT1). | |
| 908 | ||
| 909 | get_full_bounds_information(env(TypedIds,LocalBounds),FullLocalBounds) :- | |
| 910 | findall(bound_id_info(ID,Type,Bound), | |
| 911 | member(local_id(ID,Type,Bound,_Var),TypedIds), FullLocalBounds, LocalBounds). | |
| 912 | ||
| 913 | find_bounds_info(ID,Type,env(_,BI),Res) :- | |
| 914 | (member(bound_id_info(ID,Type,Bounds),BI) -> Res = Bounds | |
| 915 | ; Res=Type, format(user_output,'No bounds for ~w~n',[ID])). | |
| 916 | ||
| 917 | get_var(local_id(_,_,_,VAR),VAR). | |
| 918 | ||
| 919 | % add environment local variables at end of argument list of a Clingo Predicate | |
| 920 | % these local quantified variables need to be passed as extra parameters (e.g., inside forall) | |
| 921 | :- mode add_env_local_ids_to_arg_list(+ClingoPred,+Args,+Env,-NewArgList). | |
| 922 | add_env_local_ids_to_arg_list(Pred,A,_,R) :- | |
| 923 | nonvar(Pred), top_level_or_auxiliary_clingo_pred(Pred), !, | |
| 924 | R=A. % At the moment we do not support exists inside forall,...: do not add anything | |
| 925 | add_env_local_ids_to_arg_list(_,ArgList,env(Env,_),NewArgList) :- | |
| 926 | maplist(get_var,Env,EnvVars),!, % TODO: filter out local variables that are not needed by Pred! | |
| 927 | append(ArgList,EnvVars,NewArgList). | |
| 928 | add_env_local_ids_to_arg_list(_,_,Env,_) :- | |
| 929 | add_b2asp_error('Illegal environment: ',Env),fail. | |
| 930 | ||
| 931 | top_level_or_auxiliary_clingo_pred(Pred) :- clingo_generated_id(Pred,_,_,_ID). | |
| 932 | top_level_or_auxiliary_clingo_pred(Pred) :- auxiliary_clingo_pred(Pred,_). | |
| 933 | ||
| 934 | % code to setup bounded possible values for local ids in environment | |
| 935 | % required to make Clingo clauses safe | |
| 936 | env_setup_code(env(Local,_),Pred,Code) :- env_setup_code2(Local,Pred,Code). | |
| 937 | env_setup_code2([],_,true). | |
| 938 | env_setup_code2([local_id(_ID,_Type,BaseType,Var)|T],Pred,(CodeToSetupID,RestCode)) :- | |
| 939 | % todo: filter out local variables that are not needed by Pred | |
| 940 | gen_base_type_constraint(BaseType,Var,CodeToSetupID), | |
| 941 | env_setup_code2(T,Pred,RestCode). | |
| 942 | ||
| 943 | % creates base-type constraints that can be used in body of a clause to constrain the possible values of a local id | |
| 944 | % see also gen_clingo_base_set | |
| 945 | gen_base_type_constraint(integer,Var, Constraint) :- !, | |
| 946 | get_min_int(MinInt), get_max_int(MaxInt), | |
| 947 | add_b2asp_warning('Restricting infinite integer base type of local id to:',(MinInt,MaxInt)), | |
| 948 | gen_base_type_constraint(integer_in_range(MinInt,MaxInt,integer),Var,Constraint). | |
| 949 | gen_base_type_constraint(integer_in_range(From,To,_),Var, Constraint) :- !, | |
| 950 | make_interval_finite(From,To,'?',From2,To2),Constraint = (Var = '..'(From2,To2)). | |
| 951 | gen_base_type_constraint(string,Var, Constraint) :- !, | |
| 952 | add_b2asp_warning('Restricting infinite string base type to:',(0,Nr)), | |
| 953 | get_nr_of_registered_strings(Nr), Constraint = (Var = '..'(0,Nr)). | |
| 954 | gen_base_type_constraint(string_in_list(List),Var, Constraint) :- !, | |
| 955 | (List=[] -> Constraint = (1=2) ; list_to_disj(List,Disj), Constraint = (Var=Disj)). | |
| 956 | gen_base_type_constraint(boolean,Var, Constraint) :- !, Constraint = (Var=(pred_true ; pred_false)). | |
| 957 | gen_base_type_constraint(global(GS),Var, Constraint) :- | |
| 958 | b_get_fd_type_bounds(GS,Low,Up), !, | |
| 959 | gen_base_type_constraint(integer_in_range(Low,Up,integer),Var,Constraint). | |
| 960 | %TODO: couples | |
| 961 | gen_base_type_constraint(empty_set,_Var, Constraint) :- !, Constraint = (1=2). | |
| 962 | gen_base_type_constraint(couple(TA,TB),Var,Constraint) :- !, | |
| 963 | Constraint = ('='(Var,(VarA,VarB)), CA, CB), | |
| 964 | gen_base_type_constraint(TA,VarA,CA), gen_base_type_constraint(TB,VarB,CB). | |
| 965 | %gen_base_type_constraint(set(integer_in_range(From,To)),Var, Constraint) :- !, | |
| 966 | % gen_base_type_constraint(integer_in_range(From,To),Var, Constraint) | |
| 967 | gen_base_type_constraint(set(BaseType),_Var,true) :- !, | |
| 968 | add_b2asp_error('Set base type not supported for local ids: ',set(BaseType)). | |
| 969 | gen_base_type_constraint(BaseType,_Var,true) :- | |
| 970 | add_b2asp_error('Unknown or unsupported base type for local id: ',BaseType). | |
| 971 | ||
| 972 | list_to_disj([X],R) :- !, R=X. | |
| 973 | list_to_disj([X,Y|T],';'(X,R)) :- list_to_disj([Y|T],R). | |
| 974 | ||
| 975 | % ------------------------------ | |
| 976 | % generating CLINGO clauses,... | |
| 977 | ||
| 978 | :- dynamic generated_id/2, auxiliary_clingo_pred/2, deterministic_id_value/2. | |
| 979 | ||
| 980 | :- mode gen_clingo_scalar_identifier(+ID,+BaseType,+LocalID_Env,-ClingoPred). | |
| 981 | % generate a Clingo predicate to represent a B identifier whose value is a scalar | |
| 982 | gen_clingo_scalar_identifier(IDB,BaseType,Env,PredB) :- | |
| 983 | gen_clingo_scalar_identifier(IDB,BaseType,Env,PredB,top_level). | |
| 984 | ||
| 985 | gen_clingo_scalar_identifier(ID,_,_,Pred,_) :- nonvar(Pred), | |
| 986 | add_b2asp_warning('Identifier Clingo Result should be unbound: ',ID:Pred),fail. | |
| 987 | gen_clingo_scalar_identifier(ID,_,_,Pred,_) :- % check if we have already created a Clingo predicate for ID | |
| 988 | generated_id(ID,P),!, Pred=P. % TODO: pass as environment and check bounds unchanged | |
| 989 | gen_clingo_scalar_identifier(ID,couple(A,B),Env,Pred,TopLevel) :- !, | |
| 990 | % improved translation of pairs, instead of 1 { id_pair_scalar_0((-127..128,-127..128))} 1. we generate: | |
| 991 | % id_pair_scalar_0((A,B)) :- id_A(A), id_B(B). | |
| 992 | % 1{id_A(-127..128)}1. 1{id_B(-127..128)}1. | |
| 993 | gensym(ID,IDA), | |
| 994 | gen_clingo_scalar_identifier(IDA,A,Env,PredA,left_pair), | |
| 995 | gensym(ID,IDB), | |
| 996 | gen_clingo_scalar_identifier(IDB,B,Env,PredB,right_pair), | |
| 997 | gensym_if_necessary(pair,Pred), | |
| 998 | assert_gen_id(ID,Pred,scalar,couple(A,B),TopLevel), | |
| 999 | clingo_format_comment('~n% clingo encoding of scalar identifier ~w of type ~w:~n',[ID,couple(A,B)]), | |
| 1000 | gen_clingo_clause(Pred,[(XA,XB)],Env, (ecall(PredA,[XA],Env), | |
| 1001 | ecall(PredB,[XB],Env)) ). | |
| 1002 | % create clause Pred((XA,XB)) :- PredA(XA), PredB(XB)). | |
| 1003 | gen_clingo_scalar_identifier(ID,BaseType,_Env,Pred,TL) :- % generate: 1{Pred(Low..Up)}1. | |
| 1004 | gen_clingo_base_set(BaseType,ID,ClingoType,_MaxCard,Prefix), | |
| 1005 | atom_concat(Prefix,'_scalar',Prefix2), | |
| 1006 | gensym_if_necessary(Prefix2,Pred), | |
| 1007 | clingo_format_comment('~n% clingo encoding of scalar identifier ~w of type ~w:~n',[ID,BaseType]), | |
| 1008 | format('1 { ~w(~w)} 1.~n',[Pred,ClingoType]), % TODO: add ENV !! | |
| 1009 | assert_gen_id(ID,Pred,scalar,BaseType,TL), | |
| 1010 | register_clause_head(Pred,[ClingoType]). % at the moment these identifiers all have arity of 1 (TODO: enable nesting) | |
| 1011 | ||
| 1012 | assert_gen_id(ID,Pred,Kind,BaseType,TL) :- | |
| 1013 | (deterministic_value(BaseType,Value) -> assert(deterministic_id_value(ID,Value)) ; true), | |
| 1014 | (TL=top_level | |
| 1015 | -> assert(generated_id(ID,Pred)), | |
| 1016 | register_clingo_generated_id(Pred,Kind,BaseType,ID), % for back-translating models from clingo | |
| 1017 | debug_format(19,'Generating clingo pred. ~w for B ~w id ~w (type ~w)~n',[Pred,Kind,ID,BaseType]) | |
| 1018 | ; assert(auxiliary_clingo_pred(Pred,TL)) % only register; no need to back-translate in model | |
| 1019 | % these are intermediate ids, e.g., generated for pair left/right hand sides | |
| 1020 | % TODO: check that we do not need to add other arguments; pass environment to asser_gen_id | |
| 1021 | ). | |
| 1022 | ||
| 1023 | % detect deterministic values, so that we can inline their values | |
| 1024 | % this can be important for #count cardinality constraints for clingo performance | |
| 1025 | deterministic_value(integer_in_range(Low,Up,_),Low) :- number(Low), Low=Up. | |
| 1026 | ||
| 1027 | ||
| 1028 | :- mode gen_clingo_set_identifier(+ID,+BaseType,-ClingoPred). | |
| 1029 | % generate a Clingo predicate to represent a B identifier whose value is a set | |
| 1030 | gen_clingo_set_identifier(IDB,BaseType,PredB) :- | |
| 1031 | gen_clingo_set_identifier(IDB,BaseType,PredB,top_level). | |
| 1032 | ||
| 1033 | gen_clingo_set_identifier(ID,_,Pred,_) :- % check if we have already created a Clingo predicate for ID | |
| 1034 | generated_id(ID,P),!, | |
| 1035 | % TODO: pass as environment and check bounds unchanged | |
| 1036 | (Pred=P -> true ; add_b2asp_error('Identifier already instantiated: ',ID:Pred),fail). | |
| 1037 | % Note: we cannot use similar code as for scalars for pairs (the relation is not necessarily tuple-distributive) | |
| 1038 | gen_clingo_set_identifier(ID,BaseType,Pred,TL) :- % generate: 1{Pred(Low..Up)}1. | |
| 1039 | gen_clingo_base_set(BaseType,ID,ClingoType,MaxCard,Prefix), | |
| 1040 | atom_concat(Prefix,'_set',Prefix2), | |
| 1041 | gensym_if_necessary(Prefix2,Pred), | |
| 1042 | clingo_format_comment('~n% clingo encoding of set identifier ~w of type ~w:~n',[ID,BaseType]), | |
| 1043 | format('0 { ~w(~w)} ~w.~n',[Pred,ClingoType,MaxCard]), | |
| 1044 | assert_gen_id(ID,Pred,set,BaseType,TL), | |
| 1045 | register_clause_head(Pred,[ClingoType]). % at the moment these ids all have arity of 1 (TODO: enable nesting). | |
| 1046 | ||
| 1047 | :- use_module(probsrc(tools), [ajoin_with_sep/3]). | |
| 1048 | ||
| 1049 | % convert base type into a Clingo expression that can be put into the head of a fact, | |
| 1050 | % together with information about the maximal cardinality of the base type and a prefix for generated identifiers | |
| 1051 | gen_clingo_base_set(integer,ID,Atom,MaxCard,Prefix) :- !, | |
| 1052 | gen_clingo_base_set(integer_in_range(inf,sup,integer),ID,Atom,MaxCard,Prefix). | |
| 1053 | gen_clingo_base_set(string,ID,Atom,MaxCard,Prefix) :- !, | |
| 1054 | add_b2asp_warning('Restricting infinite string base type: ',ID), | |
| 1055 | gen_clingo_base_set(string_in_list(['dummy_string']),ID,Atom,MaxCard,Prefix). | |
| 1056 | %gen_clingo_base_set(integer_set_in_range(Low,Up),ID,Atom,MaxCard,Prefix) :- !, | |
| 1057 | % gen_clingo_base_set(integer_in_range(Low,Up),ID,Atom,MaxCard,Prefix). | |
| 1058 | gen_clingo_base_set(integer_in_range(Low0,Up0,_),ID,Atom,MaxCard,Prefix) :- !, | |
| 1059 | atom_concat(id_int_,ID,Prefix), | |
| 1060 | make_interval_finite(Low0,Up0,ID,Low,Up), | |
| 1061 | (Up >= Low -> MaxCard is 1+Up-Low ; MaxCard=0), | |
| 1062 | format_to_codes('~w..~w',[Low,Up],Codes), | |
| 1063 | atom_codes(Atom,Codes). | |
| 1064 | gen_clingo_base_set(string_in_list(List),ID,Atom,MaxCard,Prefix) :- !, atom_concat(id_string_,ID,Prefix), | |
| 1065 | length(List,MaxCard), | |
| 1066 | ajoin_with_sep(List,';',Atom). | |
| 1067 | gen_clingo_base_set(boolean,ID,Atom,2,Prefix) :- !, atom_concat(id_bool_,ID,Prefix), | |
| 1068 | Atom = 'pred_true;pred_false'. | |
| 1069 | gen_clingo_base_set(global(GS),ID,Atom,MaxCard,Prefix) :- % user-defined enumerated sets or deferred sets | |
| 1070 | b_get_fd_type_bounds(GS,Low,Up), !, atom_concat(id_glob_,ID,Prefix), | |
| 1071 | gen_clingo_base_set(integer_in_range(Low,Up,integer),ID,Atom,MaxCard,_). % we translate those sets as integers | |
| 1072 | gen_clingo_base_set(couple(A,B),ID,Atom,MaxCard,Prefix) :- !, atom_concat(id_pair_,ID,Prefix), | |
| 1073 | gen_clingo_base_set(A,ID,AAtom,CardA,_), | |
| 1074 | gen_clingo_base_set(B,ID,BAtom,CardB,_), | |
| 1075 | MaxCard is CardA*CardB, | |
| 1076 | format_to_codes('((~w),(~w))',[AAtom,BAtom],Codes), % TODO: this is not very efficient for scalars, but necessary for sets; there seems to be a parsing problem when we use booleans below | |
| 1077 | atom_codes(Atom,Codes). | |
| 1078 | gen_clingo_base_set(empty_set,ID,Atom,0,Prefix) :- !, atom_concat(no_solution_,ID,Prefix), | |
| 1079 | Atom = '2..1'. | |
| 1080 | gen_clingo_base_set(set(BaseType),ID,error,1,id_error) :- !, | |
| 1081 | add_b2asp_error('Expecting scalar base type: ',ID:set(BaseType)). | |
| 1082 | gen_clingo_base_set(seq(BaseType),ID,error,1,id_error) :- !, | |
| 1083 | add_b2asp_error('Expecting scalar base type: ',ID:seq(BaseType)). | |
| 1084 | gen_clingo_base_set(BaseType,ID,error,1,id_error) :- add_b2asp_error('Unknown or unsupported base type: ',ID:BaseType). | |
| 1085 | ||
| 1086 | make_finite(integer,ID,FiniteType) :- !, make_finite(integer_in_range(inf,sup,integer),ID,FiniteType). | |
| 1087 | make_finite(string,ID,FiniteType) :- !, | |
| 1088 | add_b2asp_warning('Restricting infinite string base type: ',ID), | |
| 1089 | make_finite(integer_in_range(0,sup,string),ID,FiniteType). | |
| 1090 | make_finite(integer_in_range(Low0,Up0,Type),ID,integer_in_range(Low,Up,Type)) :- !, | |
| 1091 | make_interval_finite(Low0,Up0,ID,Low,Up). | |
| 1092 | make_finite(couple(A,B),ID,couple(FA,FB)) :- !, make_finite(A,ID,FA), make_finite(B,ID,FB). | |
| 1093 | make_finite(Type,_ID,Type). | |
| 1094 | ||
| 1095 | make_interval_finite(inf,sup,ID,X,Y) :- !, | |
| 1096 | get_min_int(X), | |
| 1097 | get_max_int(Y), | |
| 1098 | add_b2asp_warning('Restricting bounds of integer base type to: ',ID:(X,Y)). | |
| 1099 | make_interval_finite(inf,Y,ID,X,Y) :- !, | |
| 1100 | get_min_int(Min), (Min =< Y -> X=Min ; X=Y), | |
| 1101 | add_b2asp_warning('Restricting lower-bound of integer base type to: ',ID:(X,Y)). | |
| 1102 | make_interval_finite(X,sup,ID,X,Y) :- !, | |
| 1103 | get_max_int(Mx), (Mx>= X -> Y=Mx ; Y=X), | |
| 1104 | add_b2asp_warning('Restricting upper-bound of integer base type to: ',ID:(X,Y)). | |
| 1105 | make_interval_finite(A,B,ID,X,Y) :- (\+ integer(A) ; \+ integer(B)), !, | |
| 1106 | add_b2asp_error('Illegal integer base type:',ID:(A,B)), | |
| 1107 | make_interval_finite(inf,sup,ID,X,Y). | |
| 1108 | make_interval_finite(X,Y,_,X,Y). | |
| 1109 | ||
| 1110 | % ----------- | |
| 1111 | ||
| 1112 | ||
| 1113 | ||
| 1114 | % generate a Clingo clause and predicate name if necessary, at the moment we just print it onto user_output | |
| 1115 | gen_clingo_pred_clause(Source,Pred,ArgList,Env,Body) :- | |
| 1116 | add_env_local_ids_to_arg_list(Pred,ArgList,Env,NewArgList), | |
| 1117 | env_setup_code(Env,Pred,SetupCode), | |
| 1118 | gen_clingo_pred_clause4(Source,Pred,NewArgList,(SetupCode,Body)). | |
| 1119 | gen_clingo_pred_clause4(Source,Pred,ArgList,Body) :- | |
| 1120 | gensym_if_necessary(Source,Pred), | |
| 1121 | %nl, | |
| 1122 | gen_clingo_clause3(Pred,ArgList,Body). | |
| 1123 | ||
| 1124 | % generate a Clingo clause for a predicate that has already been generated | |
| 1125 | gen_clingo_clause(Pred,ArgList,Env,Body) :- | |
| 1126 | add_env_local_ids_to_arg_list(Pred,ArgList,Env,NewArgList), | |
| 1127 | env_setup_code(Env,Pred,SetupCode), | |
| 1128 | gen_clingo_clause3(Pred,NewArgList,(SetupCode,Body)). | |
| 1129 | gen_clingo_clause3(Pred,ArgList,Body) :- | |
| 1130 | Head =.. [Pred|ArgList], | |
| 1131 | register_clause_head(Pred,ArgList), | |
| 1132 | simplify_body(Body, SimplifiedBody), | |
| 1133 | my_portray_clause( Head , SimplifiedBody ). | |
| 1134 | ||
| 1135 | gen_clingo_ic_constraint(Body) :- | |
| 1136 | simplify_body(Body, SimplifiedBody), | |
| 1137 | nl, | |
| 1138 | my_portray_clause( ( :- SimplifiedBody ) ). | |
| 1139 | ||
| 1140 | % ----------- | |
| 1141 | ||
| 1142 | % filter out true literals and rewrite call/2 and call/3 literals | |
| 1143 | simplify_body(X,R) :- var(X),!,R=X. | |
| 1144 | simplify_body((A,B),Res) :- !, | |
| 1145 | ( A=true -> simplify_body(B,Res) | |
| 1146 | ; B=true -> simplify_body(A,Res) | |
| 1147 | ; simplify_body(A,SA), simplify_body(B,SB), conj(SA,SB,Res)). | |
| 1148 | simplify_body(call(Pred,Arg),Call) :- !, Call =.. [Pred,Arg]. | |
| 1149 | simplify_body(call(Pred,Arg1,Arg2),Call) :- !, Call =.. [Pred,Arg1,Arg2]. | |
| 1150 | simplify_body(not(B),not(SB)) :- !, simplify_body(B,SB). % TODO: remove double not ? | |
| 1151 | simplify_body(ecall(Pred,ArgList,Env),Call) :- !, | |
| 1152 | (var(Pred) -> add_internal_error('Unknown ecall predicate: ',simplify_body(ecall(Pred,ArgList,Env),Call)) ; true), | |
| 1153 | % ecall are calls where we add the local variables from the environment | |
| 1154 | add_env_local_ids_to_arg_list(Pred,ArgList,Env,NewArgList), | |
| 1155 | Call =.. [Pred|NewArgList]. | |
| 1156 | simplify_body(ecall(Pred,Env),Call) :- !, add_env_local_ids_to_arg_list(Pred,[],Env,NewArgList), | |
| 1157 | Call =.. [Pred|NewArgList]. | |
| 1158 | simplify_body('='(A,B),'='(SA,SB)) :- !, simplify_expr(A,SA), simplify_expr(B,SB). | |
| 1159 | simplify_body('=='(A,B),'=='(SA,SB)) :- !, simplify_expr(A,SA), simplify_expr(B,SB). | |
| 1160 | simplify_body('!='(A,B),'!='(SA,SB)) :- !, simplify_expr(A,SA), simplify_expr(B,SB). | |
| 1161 | simplify_body(B,B). | |
| 1162 | ||
| 1163 | % we need to flatten conjunctions, clingo can not deal with goals with arbitrary use of ( , ) | |
| 1164 | conj(true,B,Res) :- !, Res=B. | |
| 1165 | conj((A,B),C,Res) :- !, Res=(A,BC), conj(B,C,BC). | |
| 1166 | conj(A,true,Res) :- !, Res=A. | |
| 1167 | conj(A,B,(A,B)). | |
| 1168 | ||
| 1169 | simplify_expr(X,R) :- var(X),!,R=X. | |
| 1170 | simplify_expr(call(Pred,Arg),Call) :- !, Call =.. [Pred,Arg]. | |
| 1171 | simplify_expr(call(Pred,Arg1,Arg2),Call) :- !, Call =.. [Pred,Arg1,Arg2]. | |
| 1172 | simplify_expr(B,B). | |
| 1173 | ||
| 1174 | % generate a Clingo fact | |
| 1175 | gen_clingo_fact(Pred,ArgList,Env) :- | |
| 1176 | add_env_local_ids_to_arg_list(Pred,ArgList,Env,NewArgList), | |
| 1177 | env_setup_code(Env,Pred,Code), simplify_body(Code,SCode), | |
| 1178 | Head =.. [Pred|NewArgList], | |
| 1179 | register_clause_head(Pred,NewArgList), | |
| 1180 | my_portray_clause( Head, SCode ). | |
| 1181 | ||
| 1182 | %clingo_comment(Comment) :- format('%~w~n',[Comment]). | |
| 1183 | clingo_format_comment(FormatStr,Args) :- format(FormatStr,Args). | |
| 1184 | ||
| 1185 | :- dynamic user:portray/2. | |
| 1186 | :- assertz( ( user:portray(X) :- b2asp_portray(X))). | |
| 1187 | ||
| 1188 | :- public b2asp_portray/1. | |
| 1189 | % TODO: implement a proper pretty_printing for clingo; rather than using portray/2 hook | |
| 1190 | b2asp_portray('#clingo_range'(Low,Call,Up)) :- format('~w{~w}~w',[Low,Call,Up]). | |
| 1191 | %b2asp_portray('#count'(Pred)) :- format('#count{Var : ~w(Var)}',[Pred]). | |
| 1192 | b2asp_portray('#aggregate'(ClingoAggr,Pred,Env)) :- | |
| 1193 | add_env_local_ids_to_arg_list(Pred,['Var'],Env,NewArgList), | |
| 1194 | Call =.. [Pred|NewArgList], | |
| 1195 | format('~w{Var : ~w}',[ClingoAggr,Call]). | |
| 1196 | b2asp_portray('#string'(S)) :- format('"~w"',[S]). | |
| 1197 | b2asp_portray(not(P)) :- write(' not '), print(P). | |
| 1198 | b2asp_portray(BOP) :- clingo_bin_op(BOP,A,B,COP),print_clingo_val(A), format(' ~w ',[COP]), print_clingo_val(B). | |
| 1199 | clingo_bin_op('<='(A,B),A,B,'<='). | |
| 1200 | clingo_bin_op('!='(A,B),A,B,'!='). | |
| 1201 | clingo_bin_op(':='(A,B),A,B,':='). | |
| 1202 | clingo_bin_op('..'(A,B),A,B,'..'). | |
| 1203 | print_clingo_val((A,B)) :- !, write('('), print(A), write(','), print(B), write(')'). % we need to print parentheses | |
| 1204 | print_clingo_val(A) :- print(A). | |
| 1205 | ||
| 1206 | my_portray_clause(Head,true) :- !, my_portray_clause(Head). | |
| 1207 | my_portray_clause(Head,Body) :- my_portray_clause((Head :- Body)). | |
| 1208 | ||
| 1209 | my_portray_clause(C) :- numbervars(C,0,_),print(C), write('.'),nl,fail. | |
| 1210 | my_portray_clause(_). | |
| 1211 | ||
| 1212 | % generate #count{Var : P(Var)} for a predicate P (also works for sum,...) | |
| 1213 | gen_clingo_count_aggregate(Aggr,Pred,Env,'#aggregate'(Aggr,Pred,Env)). | |
| 1214 | ||
| 1215 | % ------------------- | |
| 1216 | % gensym: generate a fresh symbol (used for Clingo predicates for intermediate values) | |
| 1217 | ||
| 1218 | :- dynamic counter/1. | |
| 1219 | counter(0). | |
| 1220 | gensym(Prefix,Symbol) :- retract(counter(N)), N1 is N+1, | |
| 1221 | assert(counter(N1)), | |
| 1222 | atom_codes(Prefix,PC), | |
| 1223 | number_codes(N,NC), | |
| 1224 | append(PC,[0'_|NC],PCNC), | |
| 1225 | atom_codes(Symbol,PCNC). | |
| 1226 | ||
| 1227 | gensym_if_necessary(Prefix,Symbol) :- var(Symbol), !, gensym(Prefix,Symbol). | |
| 1228 | gensym_if_necessary(_,_). | |
| 1229 | ||
| 1230 | ||
| 1231 | reset_b2asp :- | |
| 1232 | retractall(counter(_)), assert(counter(0)), | |
| 1233 | retractall(generated_id(_,_)), | |
| 1234 | retractall(deterministic_id_value(_,_)), | |
| 1235 | retractall(auxiliary_clingo_pred(_,_)), | |
| 1236 | reset_clingo_interface. | |
| 1237 | ||
| 1238 | % ------------------- | |
| 1239 | ||
| 1240 | % interface predicate to solve a B predicate with Clingo | |
| 1241 | % TODO: take LocalState into account | |
| 1242 | % if Exhaustive=exhaustive then contradiction found or all solutions will be generated upon backtracking | |
| 1243 | solve_pred_with_clingo(BPred,MaxNrSols,_LocalState,Res,Exhaustive) :- | |
| 1244 | run_clingo_on_formula(BPred,MaxNrSols,Res,Exhaustive). | |
| 1245 | ||
| 1246 | :- use_module(probsrc(bsyntaxtree), [find_typed_identifier_uses/2,create_exists/3]). | |
| 1247 | ||
| 1248 | pre_process_formula(Pred,QPred) :- is_predicate(Pred), | |
| 1249 | find_typed_identifier_uses(Pred,Ids),!, | |
| 1250 | create_exists(Ids,Pred,QPred). % create exists for open ids, so that we can annotate them with bounds | |
| 1251 | pre_process_formula(F,F). | |
| 1252 | ||
| 1253 | :- use_module(probsrc(tools),[start_ms_timer/1, stop_ms_timer_with_msg/2, get_elapsed_walltime/2]). | |
| 1254 | :- use_module(covsrc(hit_profiler),[add_to_profile_stats/2]). | |
| 1255 | ||
| 1256 | run_clingo_on_formula(Formula) :- run_clingo_on_formula(Formula,1,_,_). | |
| 1257 | run_clingo_on_formula(Formula,MaxNrModels,Result,Exhaustive) :- | |
| 1258 | % write(user_output,Formula),nl(user_output), | |
| 1259 | reset_b2asp, | |
| 1260 | pre_process_formula(Formula,AnnFormula), | |
| 1261 | get_clingo_out_file(OutFile), | |
| 1262 | catch(tell(OutFile), % TODO: use streams and pass in environment | |
| 1263 | error(existence_error(_,_),_), | |
| 1264 | (add_b2asp_error('Path does not exist, be sure to set tmpdir preference correctly: ',OutFile), | |
| 1265 | fail)), | |
| 1266 | start_ms_timer(T1), | |
| 1267 | call_cleanup(top_level_trans(AnnFormula),told), | |
| 1268 | get_elapsed_walltime(T1,WT1),add_to_profile_stats(b2asp_translation_time,WT1), | |
| 1269 | stop_ms_timer_with_msg(T1,'translating formula for clingo'), | |
| 1270 | !, | |
| 1271 | (debug_mode(on) -> show_file(OutFile) ; true), | |
| 1272 | get_preference(time_out,Timeout), TimeoutSec is (Timeout+999) // 1000, | |
| 1273 | run_clingo(OutFile,MaxNrModels,TimeoutSec,_,Result,Exhaustive). | |
| 1274 | run_clingo_on_formula(_,_,Result,non_exhaustive) :- | |
| 1275 | Result=no_solution_found(translation_failed). | |
| 1276 | ||
| 1277 | ||
| 1278 | show_file(File) :- | |
| 1279 | format('Contents of file ~w:~n',[File]), | |
| 1280 | format('% --------------~n',[]), | |
| 1281 | open(File,read,Stream), | |
| 1282 | call_cleanup(show_stream(Stream),close(Stream)), | |
| 1283 | format('% --------------~n',[]). | |
| 1284 | ||
| 1285 | show_stream(Stream) :- | |
| 1286 | read_line(Stream,Line), | |
| 1287 | Line \= end_of_file,!, | |
| 1288 | format('~s~n',[Line]), | |
| 1289 | show_stream(Stream). | |
| 1290 | show_stream(_). | |
| 1291 | ||
| 1292 | top_level_trans(Formula) :- | |
| 1293 | version_str(V),format('% Clingo encoding of B formula created by ProB ~w~n',[V]), | |
| 1294 | translate_bexpression_with_limit(Formula,200,FS), | |
| 1295 | % we could call datime(datime(Yr,Mon,Day,Hr,Min,_Sec)), | |
| 1296 | format('% :clingo ~w~n',[FS]), | |
| 1297 | (is_predicate(Formula) -> top_level_translate_predicate(Formula) | |
| 1298 | ; create_new_local_id_env(Env), trans_set(Formula,Env,main)),!, | |
| 1299 | write_clingo_show_directive. % to only transmit back relevant atoms in the model | |
| 1300 | top_level_trans(Formula) :- add_b2asp_error('Could not translate: ',Formula). | |
| 1301 | ||
| 1302 | ||
| 1303 | % ------------------- | |
| 1304 | % some tests/examples: | |
| 1305 | ||
| 1306 | test(0) :-trans_set(union(empty_set, intersection(set_extension([1,2]), set_extension([2,3]))), [], main). | |
| 1307 | test(1) :-trans_set(union(empty_set, set_subtraction(set_extension([1,2]), set_extension([2,3]))), [], main). | |
| 1308 | ||
| 1309 | test(2) :- tell('out2.lp'), | |
| 1310 | trans_set(union(set_extension([4]), intersection(set_extension([1,2]), set_extension([2,3]))), [], main), | |
| 1311 | told. | |
| 1312 | test(3) :- run_clingo_on_formula( set_subtraction(set_extension([1,2+2,5 mod 2]), set_extension([2,4])) ). | |
| 1313 | test(4) :- run_clingo_on_formula( set_subtraction(set_extension([1,2+2,2+4]), interval(2,4)) ). | |
| 1314 | test(5) :- run_clingo_on_formula( set_subtraction(interval(1,100), interval(3,98)) ). | |
| 1315 | test(6) :- run_clingo_on_formula( set_extension([card(set_subtraction(interval(1,100), interval(3,98)))]) ). | |
| 1316 | test(7) :- run_clingo_on_formula( equal(add(identifier(x,interval(1,10)),integer(5)), integer(11))). | |
| 1317 | test(8) :- run_clingo_on_formula( subset(interval(1,5), | |
| 1318 | union(identifier(x,interval(2,6)),set_extension([1])))). | |
| 1319 | test(9) :- run_clingo_on_formula( set_equal(interval(1,5), | |
| 1320 | union(identifier(x,interval(2,6)),set_extension([1])))). | |
| 1321 | test(10) :- run_clingo_on_formula( not_set_equal(interval(1,5), | |
| 1322 | union(identifier(x,interval(2,6)),interval(1,5)))). | |
| 1323 | test(11) :- run_clingo_on_formula( conjunct( subset(interval(1,5),identifier(x,interval(0,6))), | |
| 1324 | subset(identifier(x,interval(0,6)), interval(1,6)))). | |
| 1325 | test(12) :- run_clingo_on_formula( conjunct( conjunct( member(3,identifier(x,interval(0,4))), | |
| 1326 | member(4,identifier(x,interval(0,4)))), | |
| 1327 | not_member(1,identifier(x,interval(0,4))))). | |
| 1328 | test(13) :- run_clingo_on_formula( conjunct( equivalence( member(3,identifier(x,interval(0,4))), | |
| 1329 | member(4,identifier(x,interval(0,4)))), | |
| 1330 | member(4,identifier(x,interval(0,4))))). | |
| 1331 | test(14) :- run_clingo_on_formula( set_equal( union(interval(1,100),set_extension([identifier(x,interval(0,200))])), | |
| 1332 | interval(1,101))). % small performance test | |
| 1333 | test(15) :- run_clingo_on_formula( set_equal( union(identifier(s,boolean),set_extension([identifier(x,boolean)])), | |
| 1334 | set_extension([pred_true,pred_false]))). | |
| 1335 | test(16) :- run_clingo_on_formula( conjunct( less(integer(3),identifier(x,interval(0,6))), | |
| 1336 | greater(integer(5),identifier(x,interval(0,6))))). | |
| 1337 | test(17) :- run_clingo_on_formula( conjunct( less(integer(1),card(identifier(x,interval(0,6)))), | |
| 1338 | greater(integer(3),card(identifier(x,interval(0,6)))))). | |
| 1339 | test(18) :- run_clingo_on_formula( b(equal(b(card(b(identifier(x),set(boolean),'.'(nodeid(p4(-1,1,6,7)),[]))), | |
| 1340 | integer,'.'(nodeid(p4(-1,1,1,8)),[])),b(integer(2),integer,'.'(nodeid(p4(-1,1,9,10)),[]))), | |
| 1341 | pred,'.'(removed_typing,'.'(nodeid(p4(-1,1,1,10)),[])))). % ProB AST example | |
| 1342 | test(19) :- run_clingo_on_formula( conjunct(equal(max(identifier(x,interval(1,10))),integer(3)), | |
| 1343 | equal(card(identifier(x,interval(1,10))),integer(2)))). | |
| 1344 | test(20) :- run_clingo_on_formula(set_extension([string(test1),string(test2)])). | |
| 1345 | test(21) :- run_clingo_on_formula(set_extension([(1,2)])). | |
| 1346 | test(22) :- run_clingo_on_formula(reverse(set_extension([(1,2)]))). | |
| 1347 | test(23) :- run_clingo_on_formula(b(exists('.'(b(identifier(f),set(couple(boolean,boolean)),[]),[]),b(conjunct(b(member(b(identifier(f),set(couple(boolean,boolean)),'.'(nodeid(p4(-1,1,1,2)),[])),b(partial_function(b(bool_set,set(boolean),'.'(nodeid(p4(-1,1,3,7)),[])),b(bool_set,set(boolean),'.'(nodeid(p4(-1,1,10,14)),[]))),set(set(couple(boolean,boolean))),'.'(nodeid(p4(-1,1,3,14)),[]))),pred,'.'(nodeid(p4(-1,1,1,14)),[])),b(equal(b(card(b(identifier(f),set(couple(boolean,boolean)),'.'(nodeid(p4(-1,1,22,23)),[]))),integer,'.'(nodeid(p4(-1,1,17,24)),[])),b(integer(2),integer,'.'(nodeid(p4(-1,1,25,26)),[]))),pred,'.'(nodeid(p4(-1,1,17,26)),[]))),pred,'.'(nodeid(p4(-1,1,1,26)),[]))),pred,'.'(used_ids([]),'.'(nodeid(p4(-1,1,1,26)),[])))). | |
| 1348 | test(24) :- run_clingo_on_formula(b(exists('.'(b(identifier(f),set(couple(boolean,boolean)),[]),[]),b(conjunct(b(member(b(identifier(f),set(couple(boolean,boolean)),'.'(nodeid(p4(-1,1,1,2)),[])),b(total_function(b(bool_set,set(boolean),'.'(nodeid(p4(-1,1,3,7)),[])),b(bool_set,set(boolean),'.'(nodeid(p4(-1,1,10,14)),[]))),set(set(couple(boolean,boolean))),'.'(nodeid(p4(-1,1,3,14)),[]))),pred,'.'(nodeid(p4(-1,1,1,14)),[])),b(equal(b(card(b(identifier(f),set(couple(boolean,boolean)),'.'(nodeid(p4(-1,1,22,23)),[]))),integer,'.'(nodeid(p4(-1,1,17,24)),[])),b(integer(2),integer,'.'(nodeid(p4(-1,1,25,26)),[]))),pred,'.'(nodeid(p4(-1,1,17,26)),[]))),pred,'.'(nodeid(p4(-1,1,1,26)),[]))),pred,'.'(used_ids([]),'.'(nodeid(p4(-1,1,1,26)),[])))). | |
| 1349 | /* | |
| 1350 | ||
| 1351 | $ more out.lp | |
| 1352 | main(4). | |
| 1353 | ||
| 1354 | unleft0(1). | |
| 1355 | ||
| 1356 | unleft0(2). | |
| 1357 | ||
| 1358 | unright1(2). | |
| 1359 | ||
| 1360 | unright1(3). | |
| 1361 | ||
| 1362 | main(A) :- | |
| 1363 | unleft0(A), | |
| 1364 | unright1(A). | |
| 1365 | ||
| 1366 | $ clingo out.lp | |
| 1367 | clingo version 5.8.0 | |
| 1368 | Reading from out.lp | |
| 1369 | Solving... | |
| 1370 | Answer: 1 (Time: 0.000s) | |
| 1371 | unright1(2) unright1(3) unleft0(1) unleft0(2) main(4) main(2) | |
| 1372 | SATISFIABLE | |
| 1373 | ||
| 1374 | Models : 1 | |
| 1375 | Calls : 1 | |
| 1376 | Time : 0.000s (Solving: 0.00s 1st Model: 0.00s Unsat: 0.00s) | |
| 1377 | CPU Time : 0.000s | |
| 1378 | ||
| 1379 | some queries in probcli -repl that work | |
| 1380 | ||
| 1381 | :clingo x+1=4 | |
| 1382 | :clingo x+1=y & y+x=11 | |
| 1383 | :clingo x <: 1..3 & x /= {} & card(x)=3 | |
| 1384 | :clingo (x=2 => y=3) & (y=3 => x>0) & x>2 | |
| 1385 | :clingo x<:BOOL & card(x)=2 | |
| 1386 | :clingo (1,2)=(x,y-1) | |
| 1387 | :clingo x <: BOOL*BOOL & x/= {} & x<<:y | |
| 1388 | :clingo x : BOOL*BOOL & x=(TRUE,FALSE) | |
| 1389 | :clingo x : (1..2)*(1..2) & x=(1,2) | |
| 1390 | :clingo x <: (1..2)*(1..2) & x /= {} | |
| 1391 | :clingo x <: (1..2)*(1..2) & dom(x)=1..2 & ran(x)=1..1 | |
| 1392 | :clingo x = {TRUE|->FALSE, FALSE|->TRUE} | |
| 1393 | :clingo x = {TRUE|->FALSE, FALSE|->TRUE} & res=closure1(x) | |
| 1394 | :clingo SIGMA(x).(x:1..3|x) = r | |
| 1395 | ||
| 1396 | with prob_examples/public_examples/B/Benchmarks/phonebook7.mch: | |
| 1397 | :clingo-double-check x<:Code & card(x)=2 & x \/ y = Code & c1:x & c1:y | |
| 1398 | :clingo-double-check x<:Code*Code & dom(x)=Code & closure1(x)=Code*Code | |
| 1399 | with card(Name) = 10: | |
| 1400 | :clingo x<:Name*Name & dom(x)=Name & closure1(x)=Name*Name & card(x)<11 | |
| 1401 | ||
| 1402 | is now fast when encoding #card aggregate as literal (i.e., inlining it) | |
| 1403 | :clingo x <: (1..2)*(1..2) & x /= {} & card(x)=1 | |
| 1404 | ||
| 1405 | still too slow with minint=-128, maxint=127 (21 seconds): | |
| 1406 | :clingo x = {1|->2} & r=closure1(x) | |
| 1407 | ||
| 1408 | with card(Name)=10 | |
| 1409 | :clingo x<:Name*Name & dom(x)=Name & closure1(x)=Name*Name& card(x) < 10 | |
| 1410 | % ProB finds contradiction immediately; Kodkod is also quite fast | |
| 1411 | ||
| 1412 | ||
| 1413 | future tests: | |
| 1414 | :clingo z<:1..3 & !x.(x:1..2 => x:z) -> now works | |
| 1415 | :clingo z<: 1..5 & !x.(x:0..5 => {y|y:1..x & y<7} /= z) | |
| 1416 | :clingo {S,E,N,D, M,O,R, Y} <: 0..9 & S >0 & M >0 & card({S,E,N,D, M,O,R, Y}) = n & S*1000 + E*100 + N*10 + D + M*1000 + O*100 + R*10 + E =M*10000 + O*1000 + N*100 + E*10 + Y | |
| 1417 | */ |