| 1 | | % (c) 2009-2024 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 | | :- module(bvisual, |
| 5 | | [ |
| 6 | | get_tree_from_expr/4, |
| 7 | | %get_tree_from_expr2/4, |
| 8 | | write_dot_graph_to_file/2, |
| 9 | | %print_dot_graph/1, |
| 10 | | get_any/5 |
| 11 | | %get_any_most_satisfier/5, |
| 12 | | |
| 13 | | ] |
| 14 | | ). |
| 15 | | |
| 16 | | :- meta_predicate visit_tree(5,3,-,-,-). |
| 17 | | |
| 18 | | :- use_module(probsrc(module_information),[module_info/2]). |
| 19 | | :- module_info(group,dot). |
| 20 | | :- module_info(description,'Generate a dot visualization of B predicates and expressions.'). |
| 21 | | |
| 22 | | :- use_module(library(lists), [maplist/3, scanlist/4]). |
| 23 | | %:- use_module(library(terms)). |
| 24 | | |
| 25 | | :- use_module(probsrc(bsyntaxtree)). |
| 26 | | :- use_module(probsrc(translate), [translate_bvalue_with_limit/3, |
| 27 | | translate_bexpression_with_limit/3]). |
| 28 | | :- use_module(probsrc(kernel_waitflags), [ |
| 29 | | init_wait_flags/2, |
| 30 | | ground_wait_flags/1]). |
| 31 | | |
| 32 | | :- use_module(dotsrc(bvisual_any_maxsolver)). |
| 33 | | :- use_module(probsrc(error_manager)). |
| 34 | | |
| 35 | | |
| 36 | | %:- use_module(probsrc(self_check)). |
| 37 | | |
| 38 | | |
| 39 | | |
| 40 | | % PARAMETERS |
| 41 | | |
| 42 | | max_chars_per_line(40). |
| 43 | | max_lines(10). |
| 44 | | max_chars_total(400). % :- max_chars_per_line(X), max_lines(ML), T is X*ML. |
| 45 | | |
| 46 | | %% |
| 47 | | % Tree format: |
| 48 | | % Trees used by write_dot_graph_to_file/2 are modelled by the bind/3 |
| 49 | | % predicate: |
| 50 | | % bind(Children, NewLocalState, Metas). |
| 51 | | % Children is a list of subexpressions, whose numbers may be greater than two. |
| 52 | | % NewLocalState is a new local state for the subexpressions. |
| 53 | | % Metas are informations about the expression, like value, label etc. |
| 54 | | % |
| 55 | | % Important: Avoid access bind directly since it's structure may |
| 56 | | % be changed. Use accessors defined below. |
| 57 | | % They provide a convenient way to access the meta informations. |
| 58 | | % |
| 59 | | % Use get_tree_from_expr(Tree, Expr, LocalStale, State) to gain |
| 60 | | % a bind based tree from a predicate or expression evaluated in LocalState |
| 61 | | % and State. |
| 62 | | % |
| 63 | | % Use get_tree_from_expr2(State, LocalState, TExpr, Tree) to inspect the |
| 64 | | % predicate or expression only without walking down the children recursively. |
| 65 | | % |
| 66 | | |
| 67 | | %% |
| 68 | | % accessors & shortcuts |
| 69 | | % |
| 70 | | |
| 71 | | create_long_tree_node(bind(Children, Label, Type, Value, LongDesc), |
| 72 | | Children, Label, Type, Value, LongDesc). |
| 73 | | get_tree_node_info(NODE, Children, NewLocalState, Metas) :- |
| 74 | | (create_tree_node(NODE, C,N,M) -> Children=C, NewLocalState=N, Metas=M |
| 75 | | ; add_error(bvisual,'Illegal node: ',NODE)). |
| 76 | | create_tree_node(bind(Children, NewLocalState, Metas), |
| 77 | | Children, NewLocalState, Metas). |
| 78 | | |
| 79 | | |
| 80 | | % bind([],cv_o,nonboolean,137,b(identifier(cv_o),integer,[nodeid(pos(139677,56,192,18,192,21))])) |
| 81 | | |
| 82 | | has_no_children(Node) :- child_nodes(Node,[]). |
| 83 | | |
| 84 | | child_nodes(bind(ChildNodes,_,_,_,_), ChildNodes). |
| 85 | | child_nodes(bind(ChildNodes,_,_), ChildNodes). |
| 86 | | |
| 87 | | label(bind(_,Label,_,_,_), Label). |
| 88 | ? | label(bind(_,_, Metas), Val) :- member(label(Val), Metas),!. |
| 89 | | |
| 90 | | value(bind(_,_,_,Val,_), Val). |
| 91 | ? | value(bind(_,_, Metas), Val) :- member(value(Val), Metas),!. |
| 92 | | |
| 93 | | long_desc(bind(_,_,_,_,Val), Val). |
| 94 | | long_desc(bind(_,_, Metas), Val):- member(long_desc(Val), Metas),!. |
| 95 | | |
| 96 | | is_boolean(bind(_,_,boolean,_,_)). |
| 97 | ? | is_boolean(bind(_,_, Metas)):- member(type(boolean), Metas),!. |
| 98 | | |
| 99 | | %type(bind(_,_, Metas), Val):- member(type(Val), Metas),!. |
| 100 | | |
| 101 | | is_explicit_value_node(Node) :- long_desc(Node,Val), is_explicit_value(Val). |
| 102 | | |
| 103 | | %% |
| 104 | | % Evaluate an expression and it's subexpressions and |
| 105 | | % gain their values as a tree. |
| 106 | | % |
| 107 | | :- use_module(probsrc(tools),[catch_call/1]). |
| 108 | | :- use_module(probsrc(b_global_sets),[add_prob_deferred_set_elements_to_store/3]). |
| 109 | | get_tree_from_expr(Tree, Expr, LocalState, State) :- |
| 110 | | (get_preference(dot_use_unicode,true) -> translate:set_unicode_mode ; true), |
| 111 | | add_prob_deferred_set_elements_to_store(State,State1,visible), |
| 112 | | call_cleanup(catch_call(get_tree_from_expr3(State1, LocalState, Expr, Tree)), |
| 113 | | (get_preference(dot_use_unicode,true) -> translate:unset_unicode_mode ; true)). |
| 114 | | % catch: as this can sometimes generate resource_error(memory) error exceptions |
| 115 | | |
| 116 | | |
| 117 | | % whole tree at once |
| 118 | | get_tree_from_expr3(State, LocalState, TExpr, Tree) :- rewrite_expression(TExpr,NewTExpr),!, |
| 119 | | get_tree_from_expr3(State, LocalState, NewTExpr, Tree). |
| 120 | | get_tree_from_expr3(State, LocalState, Expr, Tree) :- |
| 121 | | get_tree_from_expr2(State, LocalState, Expr, NewTree), |
| 122 | | get_tree_node_info(NewTree, SubExprs, NewLocalState, _), |
| 123 | | label(NewTree, Label), |
| 124 | | value(NewTree, Value), |
| 125 | | create_long_tree_node(Tree, Children, Label, Type, Value, Expr), |
| 126 | | % print(value(Value)),nl, |
| 127 | | ( is_boolean(NewTree) -> Type = boolean ; Type = nonboolean ), |
| 128 | | maplist(get_tree_from_expr3(State, NewLocalState), SubExprs, Children). |
| 129 | | |
| 130 | | |
| 131 | | |
| 132 | | |
| 133 | | % only one layer |
| 134 | | %get_tree_from_expr2(State, LocalState, b(B,T,_), Tree) :- functor(B,F,N), print(visit(F,N,T)),nl,fail. |
| 135 | | get_tree_from_expr2(State, LocalState, TExpr, Tree) :- |
| 136 | | get_texpr_expr(TExpr, Expr), |
| 137 | | functor(Expr, Op, _Arity), |
| 138 | ? | x_is_quantifier_like(Op),!, |
| 139 | | x_get_metas(State, LocalState, TExpr, Metas), |
| 140 | ? | member(value(Value), Metas), |
| 141 | | (create_new_local_state(TExpr, Value, State, LocalState, NewLocalState) -> |
| 142 | | x_get_sub_expressions(TExpr, State, LocalState, Children), |
| 143 | | create_tree_node(Tree, Children, NewLocalState, Metas) |
| 144 | | ; |
| 145 | | create_tree_node(Tree, [], LocalState, Metas) |
| 146 | | ),!. |
| 147 | | get_tree_from_expr2(State, LocalState, TExpr, Tree):- |
| 148 | | x_get_metas(State, LocalState, TExpr, Metas), |
| 149 | | x_get_sub_expressions(TExpr, State, LocalState, Children), |
| 150 | | create_tree_node(Tree, Children, LocalState, Metas),!. |
| 151 | | |
| 152 | | |
| 153 | | |
| 154 | | %% |
| 155 | | % Get all meta information for an expression/predicate |
| 156 | | % |
| 157 | | x_get_metas(State, LocalState, TExpr, Metas):- |
| 158 | | findall(MetaValue, x_get_meta(State, LocalState, TExpr, MetaValue), Metas). |
| 159 | | |
| 160 | | |
| 161 | | :- use_module(probsrc(eval_interface),[get_value_string_of_formula/5, b_compute_expression_no_wd/4]). |
| 162 | | %% |
| 163 | | % Helpers, each single meta info. |
| 164 | | % There are value/1, type/1, label/1 and long_desc/1 |
| 165 | | % |
| 166 | | % compute the various attributes of a node: |
| 167 | | x_get_meta(State, LocalState, Expr, value(Value)):- |
| 168 | | max_chars_total(Lim), |
| 169 | | get_value_string_of_formula(State, LocalState, Expr, Lim, Value). |
| 170 | | x_get_meta(_State, _LocalState, Expr, type(Type)):- |
| 171 | | ( check_if_typed_predicate(Expr) -> |
| 172 | | Type = boolean |
| 173 | | ; |
| 174 | | Type = nonboolean |
| 175 | | ). |
| 176 | | x_get_meta(_State, _LocalState, Expr, label(Label)):- |
| 177 | ? | once(x_get_label(Expr, Label)). |
| 178 | | x_get_meta(_State, _LocalState, TExpr, long_desc(Expr)):- |
| 179 | | get_texpr_expr(TExpr, Expr). |
| 180 | | x_get_meta(_State, _LocalState, TExpr, rodin_label(Label)):- |
| 181 | ? | once(get_texpr_label(TExpr,Label)). |
| 182 | | |
| 183 | | |
| 184 | | |
| 185 | | %% |
| 186 | | % Generate a new local state for subexpressions if necessary, like a forall |
| 187 | | % predicate. called for x_is_quantifier/1 predicate. |
| 188 | | % |
| 189 | | |
| 190 | | create_new_local_state(TExpr, Value, State, LocalState, NewLocalState):- |
| 191 | | get_texpr_expr(TExpr, Expr), |
| 192 | ? | (create_new_local_state2(Expr, Value, State, LocalState, NewLocalState) |
| 193 | | -> true |
| 194 | | ; %trace, create_new_local_state2(Expr, Value, State, LocalState, NewLocalState), |
| 195 | | fail). |
| 196 | | |
| 197 | | :- use_module(probsrc(bsyntaxtree),[create_typed_id/3]). |
| 198 | | create_new_local_state2(forall(IDs, LHS, _), true, State, LocalState, NewLocalState) :- !, |
| 199 | | (get_any(IDs, LHS, State, LocalState, NewLocalState) |
| 200 | | -> true /* there is a solution for LHS */ |
| 201 | | ; /* Forall true because no solution for LHS */ |
| 202 | | get_any(IDs, b(truth,pred,[]), State, LocalState, NewLocalState) |
| 203 | | ). |
| 204 | | create_new_local_state2(forall(IDs, LHS, RHS), false,State, LocalState, NewLocalState) :- !, |
| 205 | | safe_create_texpr(negation(RHS), pred, NotRHS), |
| 206 | | conjunct_predicates([LHS, NotRHS], Condition), |
| 207 | | get_any(IDs, Condition, State, LocalState, NewLocalState). |
| 208 | | create_new_local_state2(let_expression(Ids,AssignmentExprs,Expr), Value, State, LocalState, NewLocalState) :- !, |
| 209 | | create_typed_id('$VALUE',EType,TID), get_texpr_type(Expr,EType), |
| 210 | | construct_pred([TID],[Expr],[],Preds0), |
| 211 | | construct_pred(Ids,AssignmentExprs,Preds0,Preds), |
| 212 | | conjunct_predicates(Preds,NewPred), |
| 213 | | EXISTS = exists([TID|Ids],NewPred), %translate:print_bexpr(b(EXISTS,pred,[])),nl, |
| 214 | | (Value=unknown -> ExValue = undefined ; ExValue=true), |
| 215 | | create_new_local_state2(EXISTS, ExValue, State, LocalState, NewLocalState). |
| 216 | | create_new_local_state2(let_predicate(Ids,AssignmentExprs,Pred), Value, State, LocalState, NewLocalState) :- |
| 217 | | construct_pred(Ids,AssignmentExprs,[Pred],Preds), |
| 218 | | conjunct_predicates(Preds,NewPred), |
| 219 | | EXISTS = exists(Ids,NewPred), |
| 220 | | create_new_local_state2(EXISTS, Value, State, LocalState, NewLocalState). |
| 221 | | create_new_local_state2(exists(IDs, LHS), true, State, LocalState, NewLocalState) :- !, |
| 222 | ? | get_any(IDs, LHS, State, LocalState, NewLocalState). |
| 223 | | create_new_local_state2(exists(IDs, LHS), Status, State, LocalState, NewLocalState) :- |
| 224 | | (Status=false ; Status=undefined),!, % for Status=undefined get_any can fail but get_any_most_satisfier should always succeed |
| 225 | | get_any_most_satisfier(IDs, LHS, State, LocalState, NewLocalState). |
| 226 | | create_new_local_state2(X, undefined, State, LocalState, NewLocalState) :- !, |
| 227 | | create_new_local_state2(X, true, State, LocalState, NewLocalState). |
| 228 | | create_new_local_state2(X, x_both_true_and_not_true, State, LocalState, NewLocalState) :- |
| 229 | | %print(x_both_true_and_not_true(X)),nl, % probably means a PROB BUG ! |
| 230 | | (X = forall(_,_,_) -> VAL=false ; VAL=true), |
| 231 | | create_new_local_state2(X, VAL, State, LocalState, NewLocalState). |
| 232 | | create_new_local_state2(comprehension_set(IDs, Body), Val, State, LocalState, NewLocalState) :- !, |
| 233 | | % TODO: we could extract values from the context; e.g., if we have x:{y|Pred} we could use value assigned to x for y |
| 234 | | % format(user_output,'Comprehension set ~w, Val=~w~n~n',[IDs,Val]), |
| 235 | | (is_empty_set_value(Val) -> |
| 236 | | get_any_most_satisfier(IDs, Body, State, LocalState, NewLocalState) |
| 237 | | % we could have a symbolic value; which we do not know if it is empty or not; Body could also have a WD error |
| 238 | ? | ; get_any_if_possible(IDs, Body, State, LocalState, NewLocalState)). |
| 239 | | create_new_local_state2(general_sum(IDs, CondPred, _Expr), _Val, State, LocalState, NewLocalState) :- !, |
| 240 | | get_any_if_possible(IDs, CondPred, State, LocalState, NewLocalState). |
| 241 | | create_new_local_state2(general_product(IDs, CondPred, _Expr), _Val, State, LocalState, NewLocalState) :- !, |
| 242 | | get_any_if_possible(IDs, CondPred, State, LocalState, NewLocalState). |
| 243 | | create_new_local_state2(quantified_union(IDs, CondPred, _Expr), _Val, State, LocalState, NewLocalState) :- !, |
| 244 | | get_any_if_possible(IDs, CondPred, State, LocalState, NewLocalState). |
| 245 | | create_new_local_state2(quantified_intersection(IDs, CondPred, _Expr), _Val, State, LocalState, NewLocalState) :- !, |
| 246 | | get_any_if_possible(IDs, CondPred, State, LocalState, NewLocalState). |
| 247 | | %create_new_local_state2(value(StoredVal), Val, State, LocalState, NewLocalState) :- nonvar(StoredVal), |
| 248 | | % StoredVal = closure(P,T,Body), |
| 249 | | % !, |
| 250 | | % maplist(bsyntaxtree:create_typed_id,P,T,IDs), |
| 251 | | % create_new_local_state2(comprehension_set(IDs, Body), Val, State, LocalState, NewLocalState). |
| 252 | | create_new_local_state2(Expr, Value, _State, _LocalState, _NewLocalState) :- |
| 253 | | add_error(bvisual,'Uncovered Expr in create_new_local_state: ',Expr:Value), |
| 254 | | fail. |
| 255 | | |
| 256 | | % a bit of a hack; it would be better to look at the Prolog version of the value |
| 257 | | is_empty_set_value('{}'). |
| 258 | | is_empty_set_value('[]'). |
| 259 | | is_empty_set_value(X) :- translate:unicode_translation(empty_set,X). |
| 260 | | |
| 261 | | % construct predicate from list of typed ids and expressions |
| 262 | | construct_pred([],[],TailPreds,TailPreds). |
| 263 | | construct_pred([ID|T],[EXPR|ET],TailPreds,[b(equal(ID,EXPR),pred,[])|TR]) :- |
| 264 | | construct_pred(T,ET,TailPreds,TR). |
| 265 | | |
| 266 | | |
| 267 | | :- use_module(probsrc(custom_explicit_sets),[is_interval_closure/3]). |
| 268 | | % rewrite rules to transform some values into a formula tree |
| 269 | | rewrite_expression(b(value(StoredVal),Type,I),b(comprehension_set(IDs, Body),Type,[compiled_closure|I])) :- |
| 270 | | nonvar(StoredVal), |
| 271 | | StoredVal = closure(P,T,Body), |
| 272 | | \+ is_interval_closure(StoredVal,_,_), |
| 273 | | maplist(bsyntaxtree:create_typed_id,P,T,IDs). |
| 274 | | |
| 275 | | |
| 276 | | %% |
| 277 | | % Get subexpressions, merge sub expressions with associative operators, like |
| 278 | | % 'and'. For example the predicate and(A,and(B,C)) has three sub expressions: |
| 279 | | % A, B and C. This behaviour is controlled by x_associative_operator/1. |
| 280 | | % |
| 281 | | |
| 282 | | x_get_sub_expressions(TExpr, Children) :- |
| 283 | | x_get_sub_expressions(TExpr, [], [], Children). |
| 284 | | |
| 285 | | x_get_sub_expressions(TExpr, _, _, Children) :- nonvar(TExpr), |
| 286 | | do_not_expand(TExpr), !, |
| 287 | | Children=[]. |
| 288 | | x_get_sub_expressions(TExpr, State, LocalState, Children) :- |
| 289 | | syntaxtraversion(TExpr,Expr,_,_,Children0,_), |
| 290 | | % add custom explanation rules for certain nodes: |
| 291 | | x_get_custom_explanation_subexpressions(Expr,State, LocalState, Children0,Children). |
| 292 | | |
| 293 | | :- use_module(probsrc(preferences),[get_preference/2]). |
| 294 | | do_not_expand(b(equal(A,B),pred,_)) :- get_preference(pp_propositional_logic_mode,true), |
| 295 | | A = b(identifier(_),boolean,_), % do not expand such nodes |
| 296 | | is_explicit_value(B). |
| 297 | | |
| 298 | | :- use_module(library(lists)). |
| 299 | | % is a value which does not need to be further decomposed |
| 300 | | is_explicit_value(b(Val,_,_)) :- is_explicit_value2(Val). |
| 301 | | is_explicit_value2(integer(_N)). |
| 302 | | is_explicit_value2(string(_S)). |
| 303 | | is_explicit_value2(boolean_true). |
| 304 | | is_explicit_value2(boolean_false). |
| 305 | | is_explicit_value2(identifier(N)) :- b_global_sets:lookup_global_constant(N,_). |
| 306 | | is_explicit_value2(couple(A,B)) :- is_explicit_value(A), is_explicit_value(B). |
| 307 | | is_explicit_value2(value(_)). |
| 308 | | % to do: add further cases |
| 309 | | |
| 310 | | |
| 311 | | :- use_module(library(timeout),[time_out/3]). |
| 312 | | x_get_custom_explanation_subexpressions(function(Fun,Value),State,LocalState,_C0,Children) :- |
| 313 | | % a custom rule for function application of closures |
| 314 | | % print(function(Fun)),nl, print(value(Value)),nl,print(C0),nl, |
| 315 | | simple_value(Fun), |
| 316 | | get_preference(formula_tree_minimal_timeout,TOVAL), |
| 317 | | time_out(b_compute_expression_no_wd(Fun, LocalState, State, FunValue),TOVAL,TRes), TRes \== time_out, |
| 318 | | FunValue = closure(P,T,Pred), |
| 319 | | P = [X,_Res], % TO DO: extend to functions with multiple arguments |
| 320 | | closures:is_lambda_closure(P,T,Pred, _OtherIDs,_OtherTypes, DomainPred, Expr),!, |
| 321 | | bsyntaxtree:replace_id_by_expr(Expr,X,Value,NewExpr), |
| 322 | | bsyntaxtree:replace_id_by_expr(DomainPred,X,Value,NewDomainPred), |
| 323 | | Children = [Fun,Value, NewDomainPred,NewExpr]. |
| 324 | | % we could do similar treatment for member(Tuple,Fun) |
| 325 | | x_get_custom_explanation_subexpressions(Expr,_State,_LocalState, Children0,Children) :- |
| 326 | | x_get_custom_explanation_subexpressions(Expr, Children0,Children). |
| 327 | | |
| 328 | | |
| 329 | | |
| 330 | | simple_value(b(V,_,_)) :- simple_value_aux(V). |
| 331 | | simple_value_aux(identifier(_)). |
| 332 | | simple_value_aux(value(_)). |
| 333 | | |
| 334 | | :- use_module(probsrc(typing_tools),[create_maximal_type_set/2]). |
| 335 | | |
| 336 | | % TO DO: add explanation rules, e.g., f:A --> B ==> f:TA +-> B & dom(f)=A ,... |
| 337 | | x_get_custom_explanation_subexpressions(Expr,_Children0, Children):- |
| 338 | | functor(Expr, Op, _), |
| 339 | | x_operator_with_local_variables(Op),!,Children=[]. |
| 340 | | x_get_custom_explanation_subexpressions(Expr,Children0, Children):- |
| 341 | | functor(Expr, Op, _), Op = set_extension, |
| 342 | | length(Children0,Len), (Len>50 ; maplist(is_explicit_value,Children0)), |
| 343 | | % can be a very large explicit node; no sense in expanding and showing every element |
| 344 | | % print(no_child(Expr)),nl, |
| 345 | | % TO DO: check if simple value |
| 346 | | !,Children=[]. |
| 347 | | x_get_custom_explanation_subexpressions(Expr,Children0, Children):- |
| 348 | | functor(Expr, Op, _), |
| 349 | | x_associative_operator(Op),!, |
| 350 | | maplist(x_collect_exprs_with_op(Op), Children0, Children1), |
| 351 | | scanlist(x_append_reverse, Children1, [], Children). |
| 352 | | x_get_custom_explanation_subexpressions(member(X,b(partial_function(Dom,Range),T,Info)),_,Children) :- |
| 353 | | T=set(set(couple(DomT,RanT))), |
| 354 | | %print(pf(Dom,Range)),nl, |
| 355 | | (\+ bsyntaxtree:is_just_type(Dom) ; \+ bsyntaxtree:is_just_type(Range)), |
| 356 | | nonmember(already_expanded,Info), |
| 357 | | % otherwise we may have an infinite recursion; maybe better to add other operator |
| 358 | | %print(not_type),nl,fail, |
| 359 | | !, |
| 360 | | Children = [A|TB], |
| 361 | | create_maximal_type_set(DomT,DomType), |
| 362 | | create_maximal_type_set(RanT,RanType), |
| 363 | | A = b(member(X,b(partial_function(DomType,RanType),T,[already_expanded|Info])),pred,[]), |
| 364 | | add_subset_check(b(domain(X),set(DomT),[]), Dom, TB,TC), |
| 365 | | add_subset_check(b(range(X),set(RanT),[]), Range, TC,[]), |
| 366 | | TB \= [],!. |
| 367 | | x_get_custom_explanation_subexpressions(member(X,b(total_function(Dom,Range),T,Info)),_,Children) :- |
| 368 | | T=set(set(couple(DomT,RanT))), !, |
| 369 | | Children = [A,B|TC], |
| 370 | | %print(total_fun_check(DomT,RanT)),nl, |
| 371 | | create_maximal_type_set(DomT,DomType), |
| 372 | | create_maximal_type_set(RanT,RanType), |
| 373 | | A = b(member(X,b(partial_function(DomType,RanType),T,Info)),pred,[]), |
| 374 | | B = b(equal(b(domain(X),set(DomT),[]), Dom),pred,[]), |
| 375 | | add_subset_check(b(range(X),set(RanT),[]), Range, TC,[]). |
| 376 | | x_get_custom_explanation_subexpressions(member(X,b(total_surjection(Dom,Range),T,Info)),_,Children) :- |
| 377 | | T=set(set(couple(DomT,RanT))), !, |
| 378 | | Children = [A,B,C], |
| 379 | | create_maximal_type_set(DomT,DomType), |
| 380 | | create_maximal_type_set(RanT,RanType), |
| 381 | | A = b(member(X,b(partial_function(DomType,RanType),T,Info)),pred,[]), |
| 382 | | B = b(equal(b(domain(X),set(DomT),[]), Dom),pred,[]), |
| 383 | | C = b(equal(b(range(X),set(RanT),[]), Range),pred,[]). |
| 384 | | x_get_custom_explanation_subexpressions(member(X,b(partial_surjection(Dom,Range),T,Info)),_,Children) :- |
| 385 | | T=set(set(couple(DomT,RanT))), !, |
| 386 | | Children = [A|TB], |
| 387 | | create_maximal_type_set(DomT,DomType), |
| 388 | | create_maximal_type_set(RanT,RanType), |
| 389 | | A = b(member(X,b(partial_function(DomType,RanType),T,Info)),pred,[]), |
| 390 | | add_subset_check(b(domain(X),set(DomT),[]), Dom, TB,[C]), |
| 391 | | C = b(equal(b(range(X),set(RanT),[]), Range),pred,[]). |
| 392 | | x_get_custom_explanation_subexpressions(Expr,Children, Res) :- |
| 393 | | functor(Expr,Functor,_), |
| 394 | | (filter_trivial_children_for(Functor) -> exclude(is_explicit_value,Children,Res) ; Res=Children). |
| 395 | | |
| 396 | | filter_trivial_children_for(let_predicate). % avoid we see trivial values twice |
| 397 | | |
| 398 | | |
| 399 | | |
| 400 | | add_subset_check(LHS,RHS,Result,EndOfList) :- |
| 401 | | % add subset check, unless "obvious" |
| 402 | | (bsyntaxtree:is_just_type(RHS) -> Result=EndOfList |
| 403 | | ; Result = [b(subset(LHS, RHS),pred,[])|EndOfList] |
| 404 | | ). |
| 405 | | |
| 406 | | x_collect_exprs_with_op(Op, TExpr, Children):- |
| 407 | | syntaxtraversion(TExpr,Expr,_,_,_,_), |
| 408 | | ( functor(Expr, Op, _), |
| 409 | | \+ get_texpr_label(TExpr,_) % do not expand out if there is a separate label for the sub-conjunct/disjunct |
| 410 | | -> x_get_sub_expressions(TExpr, Children) |
| 411 | | ; Children = [TExpr] |
| 412 | | ). |
| 413 | | |
| 414 | | x_append_reverse(X,Y,L):- append(Y,X,L). |
| 415 | | |
| 416 | | |
| 417 | | |
| 418 | | %% |
| 419 | | % Get label for an expression |
| 420 | | % |
| 421 | | |
| 422 | | x_get_label(b(Expr,_,Infos), Label) :- |
| 423 | ? | x_get_label_aux(Expr,Infos,Label). |
| 424 | | x_get_label_aux(comprehension_set(_,_),[compiled_closure|_],Label) :- !, % generated by rewrite_expression |
| 425 | | Label= 'comprehension_set (compiled closure)'. |
| 426 | | x_get_label_aux(value(V), _, Label) :- !, get_value_label(V,Label). |
| 427 | | x_get_label_aux(external_function_call(Name,_),_Infos,Label) :- !, |
| 428 | | Label=Name. |
| 429 | | x_get_label_aux(external_pred_call(Name,_),_Infos,Label) :- !, |
| 430 | | Label=Name. |
| 431 | | x_get_label_aux(Expr, _, Label) :- |
| 432 | | %Expr =.. [Op, Label], |
| 433 | | functor(Expr,Op,1), arg(1,Expr,Label), |
| 434 | | x_literal_value_operator(Op). |
| 435 | | x_get_label_aux(Expr, _ , Label):- |
| 436 | | functor(Expr, Fkt, _), |
| 437 | | x_functor_to_label(Fkt, Label). |
| 438 | | |
| 439 | | get_value_label(V,Label) :- var(V),!, Label='VAR-VALUE'. |
| 440 | | %get_value_label(global_set(GS),Label) :- !, Label=GS. % should we pretty print the value |
| 441 | | %get_value_label(V,stored_value(F)) :- functor(V,F,_N). |
| 442 | | get_value_label(V,Label) :- translate_bvalue_with_limit(V,40,Label). |
| 443 | | %% |
| 444 | | % Helpers |
| 445 | | % |
| 446 | | |
| 447 | | %% |
| 448 | | % Maps functor of prolog term to correct label |
| 449 | | % |
| 450 | | :- use_module(probsrc(translate),[translate_prolog_constructor_in_mode/2]). |
| 451 | | x_functor_to_label(F,R) :- translate_prolog_constructor_in_mode(F,PPVersion), !, R=PPVersion. |
| 452 | | %x_functor_to_label(conjunct, conjunction):-!. |
| 453 | | %x_functor_to_label(disjunct, disjunction):-!. |
| 454 | | x_functor_to_label(function, R):-!, R='func.applic.'. |
| 455 | | x_functor_to_label(X, X). |
| 456 | | |
| 457 | | %% |
| 458 | | % List of operators which may generate a new local state, |
| 459 | | % like a forall predicate. |
| 460 | | % |
| 461 | | x_is_quantifier_like(comprehension_set). |
| 462 | | x_is_quantifier_like(general_sum). |
| 463 | | x_is_quantifier_like(general_product). |
| 464 | | x_is_quantifier_like(quantified_union). |
| 465 | | x_is_quantifier_like(quantified_intersection). |
| 466 | | x_is_quantifier_like(X) :- x_is_quantifier(X). |
| 467 | | |
| 468 | | x_is_quantifier(forall). |
| 469 | | x_is_quantifier(exists). |
| 470 | | x_is_quantifier(let_predicate). |
| 471 | | x_is_quantifier(let_expression). |
| 472 | | |
| 473 | | x_is_quantifier(true_guard). |
| 474 | | |
| 475 | | %% |
| 476 | | % List of associative operators |
| 477 | | % |
| 478 | | |
| 479 | | x_associative_operator(conjunct). |
| 480 | | x_associative_operator(disjunct). |
| 481 | | x_associative_operator(add). |
| 482 | | x_associative_operator(mul). |
| 483 | | |
| 484 | | |
| 485 | | %% |
| 486 | | % List of operators with local variables |
| 487 | | % |
| 488 | | |
| 489 | | % x_operator_with_local_variables(comprehension_set). is now supported in create_new_local_state2 |
| 490 | | % x_operator_with_local_variables(let_predicate). ditto, and for let_expression |
| 491 | | %x_operator_with_local_variables(general_sum). |
| 492 | | %x_operator_with_local_variables(general_product). |
| 493 | | %x_operator_with_local_variables(quantified_union). |
| 494 | | %x_operator_with_local_variables(quantified_intersection). |
| 495 | | x_operator_with_local_variables(lambda). |
| 496 | | x_operator_with_local_variables(lazy_let_expr). |
| 497 | | x_operator_with_local_variables(lazy_let_pred). |
| 498 | | x_operator_with_local_variables(lazy_let_subst). |
| 499 | | |
| 500 | | |
| 501 | | %% |
| 502 | | % List of literal values |
| 503 | | % |
| 504 | | x_literal_value_operator(identifier). |
| 505 | | x_literal_value_operator(value). |
| 506 | | x_literal_value_operator(integer). |
| 507 | | x_literal_value_operator(string). |
| 508 | | |
| 509 | | |
| 510 | | |
| 511 | | |
| 512 | | |
| 513 | | |
| 514 | | %% |
| 515 | | % Try to execute an 'Any' statement on LocalState and State. |
| 516 | | % New state with the values is returned by NewLocalState. |
| 517 | | % Compare to b_interpreter:b_execute_statement2(any(Parameters,PreCond,Body),...) |
| 518 | | % |
| 519 | | |
| 520 | | :- use_module(probsrc(b_enumerate), [b_tighter_enumerate_values_in_ctxt/3]). |
| 521 | | :- use_module(probsrc(b_interpreter), [set_up_typed_localstate/6]). |
| 522 | | |
| 523 | | |
| 524 | | get_any(IDs, Condition, State, LocalState, NewLocalState) :- |
| 525 | ? | catch(get_any1(IDs, Condition, State, LocalState, NewLocalState), E, |
| 526 | | (add_warning(bvisual,'Exception in bvisual while treating quantfier predicate: ',E),fail)). |
| 527 | | get_any1(IDs, C, S, LS, NewLS) :- |
| 528 | | % used to be: on_enumeration_warning(bvisual:get_any2(IDs, C, S, LS, NewLS), fail). |
| 529 | | % call below does not force throwing enum warnings, which is ok as we just want one solution: |
| 530 | ? | catch_enumeration_warning_exceptions(bvisual:get_any2(IDs, C, S, LS, NewLS), fail, false, C). |
| 531 | | get_any2(IDs, Condition, State, LocalState, NewLocalState) :- |
| 532 | | set_up_typed_localstate(IDs, _FreshVars, TypedVals, LocalState, NewLocalState,positive), |
| 533 | | init_wait_flags(WF,[get_any2]), |
| 534 | | b_interpreter:b_test_boolean_expression(Condition,NewLocalState, State, WF), /* check WHERE */ |
| 535 | | b_tighter_enumerate_values_in_ctxt(TypedVals,Condition,WF), |
| 536 | ? | ground_wait_flags(WF). |
| 537 | | |
| 538 | | |
| 539 | | get_any_most_satisfier(IDs, Condition, State, LocalState, NewLocalState):- |
| 540 | | ( any_maxsolver(IDs, Condition, State, LocalState, NewLocalState) -> |
| 541 | | true |
| 542 | | ; get_typing_solution(IDs, State, LocalState, NewLocalState) |
| 543 | | ). |
| 544 | | |
| 545 | | % just get a solution for truth: i.e., find any value for the types |
| 546 | | get_typing_solution(IDs, State, LocalState, NewLocalState) :- |
| 547 | | conjunct_predicates([], Truth), |
| 548 | | get_any(IDs, Truth, State, LocalState, NewLocalState). |
| 549 | | |
| 550 | | % get some successful solution; or if this does not work: just call get_any_most_satisfier |
| 551 | | get_any_if_possible(IDs, Condition, State, LocalState, NewLocalState) :- |
| 552 | ? | if(get_any(IDs, Condition, State, LocalState, NewLocalState),true, |
| 553 | | get_any_most_satisfier(IDs, Condition, State, LocalState, NewLocalState)). |
| 554 | | |
| 555 | | |
| 556 | | |
| 557 | | %% |
| 558 | | % Main predicate for writing dot graph |
| 559 | | % Use it to start. |
| 560 | | % |
| 561 | | % FileSpec is used by tell/1 to open a stream. |
| 562 | | % The graph is printed by print_dot_graph_for_tree/1. |
| 563 | | % |
| 564 | | |
| 565 | | :- use_module(probsrc(tools),[catch_call/1]). |
| 566 | | :- use_module(probsrc(tools_io),[safe_intelligent_open_file/3]). |
| 567 | | |
| 568 | | write_dot_graph_to_file(Tree, FileSpec) :- |
| 569 | | catch_call(write_dot_graph_to_file_aux(Tree, FileSpec)). |
| 570 | | write_dot_graph_to_file_aux(Tree, FileSpec) :- |
| 571 | | (get_preference(dot_use_unicode,true) -> translate:set_unicode_mode ; true), |
| 572 | | safe_intelligent_open_file(FileSpec,write,Stream), |
| 573 | | call_cleanup(print_dot_graph(Stream,Tree), |
| 574 | | (close(Stream),(get_preference(dot_use_unicode,true) -> translate:unset_unicode_mode ; true))). |
| 575 | | |
| 576 | | print_dot_graph(Stream,Tree):- |
| 577 | | format(Stream,'digraph g {~nrankdir=RL;~n',[]), |
| 578 | | visit_tree(x_print_dot_graph_visitor(Stream), x_print_dot_graph_node(Stream), Tree, [],_), |
| 579 | | format(Stream,'}~n',[]). |
| 580 | | |
| 581 | | |
| 582 | | %% |
| 583 | | % Helpers |
| 584 | | % |
| 585 | | :- public x_print_dot_graph_visitor/6. |
| 586 | | x_print_dot_graph_visitor(Stream,enter, Node, _Children, [], [1,root]) :- |
| 587 | ? | x_print_dot_graph_node_only(Stream,Node, root),!. |
| 588 | | x_print_dot_graph_visitor(Stream,enter, Node, _Children, In, [NewID|In]):- |
| 589 | | x_print_dot_graph_node(Stream,Node, In, [NewID|_]). |
| 590 | | x_print_dot_graph_visitor(_Stream,leave, _Node, _Children, [NewID,_ID|Out], [NewID|Out]). |
| 591 | | |
| 592 | | /* for 3 args : */ |
| 593 | | x_print_dot_graph_node(Stream,Node, [], []) :- |
| 594 | | x_print_dot_graph_node_only(Stream,Node, root), |
| 595 | | !. |
| 596 | | x_print_dot_graph_node(Stream,Node, [ID|Rest], [NewID|Rest]) :- |
| 597 | | Rest = [PID|_], |
| 598 | | NewID is ID + 1, |
| 599 | ? | x_print_dot_graph_node_only(Stream,Node, ID), |
| 600 | | format(Stream,'~8|Node~p -> Node~p;~N', [ID, PID]), |
| 601 | | !. |
| 602 | | |
| 603 | | |
| 604 | | |
| 605 | | |
| 606 | | shorten_atom(MaxLengthPerLine, Atom, NewAtom) :- |
| 607 | | max_lines(MaxLines), |
| 608 | ? | shorten_atom(MaxLengthPerLine, Atom, NewAtom,MaxLines). |
| 609 | | shorten_atom(MaxLengthPerLine, Atom, NewAtom,MaxLines) :- |
| 610 | | ( atom(Atom) -> |
| 611 | | atom_chars(Atom, AtomChars), |
| 612 | ? | shorten_atom_list(MaxLengthPerLine, AtomChars, NewAtom,MaxLines) |
| 613 | | ; |
| 614 | | NewAtom = Atom |
| 615 | | ). |
| 616 | | |
| 617 | | shorten_atom_list(MaxLengthPerLine, Chars, Atom,MaxLines):- |
| 618 | | %length(Chars, Length), |
| 619 | ? | split_chars(Chars,MaxLengthPerLine, Prefix,Suffix), |
| 620 | | ( Suffix=[] -> |
| 621 | | atom_chars(Atom, Chars) |
| 622 | | ; |
| 623 | | %lists:append_length(Prefix, Suffix, Chars, MaxLengthPerLine), |
| 624 | | %print( split_chars(Chars,MaxLengthPerLine, Prefix,Suffix) ),nl, |
| 625 | | (MaxLines>1 -> ML1 is MaxLines-1, |
| 626 | ? | shorten_atom_list(MaxLengthPerLine, Suffix, SuffixAtom,ML1) |
| 627 | | ; SuffixAtom = '...'), |
| 628 | | atom_chars(PrefixAtom, Prefix), |
| 629 | | atom_concat(PrefixAtom, '\\n', PrefixAtomNewLine), |
| 630 | | atom_concat(PrefixAtomNewLine, SuffixAtom, Atom) |
| 631 | | ). |
| 632 | | |
| 633 | | % bvisual:split_chars([a,b,d,e,f],2,P,S), P==[a,b], S==[d,e,f] |
| 634 | | |
| 635 | | % a predicate to split List if it is longer than MaxLen, but only outside of single and double quotes |
| 636 | | % List is suppoed to be already encoded using string_escape |
| 637 | | split_chars(List,MaxLen,Prefix,Suffix) :- |
| 638 | ? | split_chars(List,MaxLen,Prefix,Suffix,q(outside,outside)). |
| 639 | | |
| 640 | | split_chars(List,MaxL,R,Suffix,Q) :- MaxL < 1, Q=q(outside,outside), !, |
| 641 | | % only add newline if we are outside of quotes |
| 642 | | R=[], Suffix=List. |
| 643 | | split_chars([],_MaxL,[],[],_). |
| 644 | | split_chars(L,MaxL,LR,LeftOver,Q) :- |
| 645 | | is_a_unit(L,T,LR,TR),!, |
| 646 | ? | M1 is MaxL-1, split_chars(T,M1,TR,LeftOver,Q). |
| 647 | | split_chars([Slash,Quote|T],MaxL,[Slash,Quote|TR],LeftOver,Q) :- Slash = ('\\'), |
| 648 | | !, %(Quote=34;Quote=39), !, % \" or \' |
| 649 | | toggle_quotes(Quote,Q,TQ), |
| 650 | ? | M1 is MaxL-1, split_chars(T,M1,TR,LeftOver,TQ). |
| 651 | | split_chars([H|T],MaxL,[H|TR],LeftOver,Q) :- |
| 652 | ? | M1 is MaxL-1, split_chars(T,M1,TR,LeftOver,Q). |
| 653 | | |
| 654 | | toggle_quotes('\'',q(outside,Q2),q(inside,Q2)) :- !. |
| 655 | | toggle_quotes('\'',q(inside,Q2),q(outside,Q2)) :- !. |
| 656 | | toggle_quotes('\"',q(Q1,outside),q(Q1,inside)) :- !. |
| 657 | | toggle_quotes('\"',q(Q1,inside),q(Q1,outside)) :- !. |
| 658 | | toggle_quotes(_,Q,Q). |
| 659 | | |
| 660 | | % check for HTML encodings like à Ë α ... |
| 661 | | % these should be counted as a single character and not be split |
| 662 | | is_a_unit(['&'|T1],T,['&'|T1R],TR) :- get_lexeme(T1,10,LexUnit,T), |
| 663 | | append(LexUnit,TR,T1R). |
| 664 | | |
| 665 | | get_lexeme([';'|T],_,[';'],TRes) :- !, TRes=T. |
| 666 | | get_lexeme([H|T],L,[H|LexT],TRes) :- L>1, L1 is L-1, get_lexeme(T,L1,LexT,TRes). |
| 667 | | |
| 668 | | :- use_module(probsrc(tools_strings),[ajoin/2]). |
| 669 | | get_long_label(Node,MaxPerLine,LongLabel) :- |
| 670 | | long_desc(Node, LongDesc), |
| 671 | | %tools:print_wtime(start_translate(ID)), |
| 672 | | LongDesc = b(P,T,Infos), |
| 673 | ? | (select_info_labels(Labels,Infos,I2) -> true ; Labels=[],I2=Infos), |
| 674 | | translate_bexpression_with_limit(b(P,T,I2), 250, Pretty0), |
| 675 | | %tools:print_wtime(translated(ID)), |
| 676 | | string_escape(Pretty0, Pretty1), |
| 677 | ? | shorten_atom(MaxPerLine, Pretty1, Pretty1h), % maximally 10 lines with 40 chars |
| 678 | | gen_labels(Labels,[Pretty1h],Atoms), % print labels separately one per line |
| 679 | | ajoin(Atoms,LongLabel). |
| 680 | | |
| 681 | | gen_labels([],Res,Res). |
| 682 | | gen_labels([Label|T],Tail,['/*@ ',Label,' */\\n' | Res]) :- gen_labels(T,Tail,Res). |
| 683 | | |
| 684 | | :- use_module(probsrc(tools),[string_escape/2]). |
| 685 | | x_print_dot_graph_node_only(Stream,Node, ID) :- %tools:print_wtime(node(ID,Node)), |
| 686 | | label(Node, Label0), |
| 687 | | max_chars_per_line(MaxPerLine), |
| 688 | | string_escape(Label0, Label1), %tools:print_wtime(escaped(ID)), |
| 689 | | ( ID \= root, is_boolean(Node) |
| 690 | | -> |
| 691 | | Label=Label1, |
| 692 | ? | get_long_label(Node,MaxPerLine,Pretty1h), |
| 693 | | value(Node, TruthValue), |
| 694 | | string_escape(TruthValue, TVEsc), |
| 695 | | get_predicate_field_seperator(Sep), |
| 696 | | atom_concat(TVEsc, Sep, Pretty4), |
| 697 | | atom_concat(Pretty4, Pretty1h, Pretty) |
| 698 | | ; |
| 699 | | value(Node, Val), |
| 700 | | string_escape(Val, Pretty1), % TO DO: check that we also escape | in case of records! |
| 701 | | (is_boolean(Node) -> get_predicate_field_seperator(Sep) |
| 702 | ? | ; get_expression_field_seperator(Sep)), |
| 703 | | ((Pretty1=Label1 ; is_explicit_value_node(Node)) |
| 704 | | -> Pretty='', Label=Pretty1 % we have a simple value node like integer(1),... |
| 705 | | ; has_no_children(Node) |
| 706 | ? | -> get_long_label(Node,MaxPerLine,Label), |
| 707 | ? | shorten_atom(MaxPerLine, Pretty1, Pretty) |
| 708 | | ; Label=Label1, |
| 709 | ? | shorten_atom(MaxPerLine, Pretty1, Pretty) |
| 710 | | ) |
| 711 | | ), |
| 712 | | %tools:print_wtime(node_style(ID)), |
| 713 | | x_print_dot_graph_node_style(Node, Shape, Color,Style), |
| 714 | | %tools:print_wtime(printing(ID)), |
| 715 | | (Pretty='' |
| 716 | | -> format(Stream,'~4|Node~p [label="~p", shape="~p", fillcolor="~p", style="~p"]~N', |
| 717 | | [ID, Label, Shape, Color,Style]) |
| 718 | | ; format(Stream,'~4|Node~p [label="~p~p~p", shape="~p", fillcolor="~p", style="~p"]~N', |
| 719 | | [ID, Label, Sep, Pretty, Shape, Color,Style])). % ,tools:print_wtime(finished(ID)). |
| 720 | | |
| 721 | | |
| 722 | | x_print_dot_graph_node_style(Node, Shape, 'tomato','filled,rounded') :- |
| 723 | | is_boolean(Node), value(Node, false),!, boolean_shape(Shape). |
| 724 | | x_print_dot_graph_node_style(Node, Shape, 'olivedrab2','filled,rounded') :- |
| 725 | | is_boolean(Node), value(Node, true),!, boolean_shape(Shape). |
| 726 | | x_print_dot_graph_node_style(Node, Shape, 'orange','filled,rounded') :- % styles could be dashed,dotted, rounded, ... |
| 727 | | is_boolean(Node),!, boolean_shape(Shape). |
| 728 | | x_print_dot_graph_node_style(Node, Shape, 'yellow','filled') :- |
| 729 | | value(Node, unknown),!, get_preference(dot_expression_node_shape,Shape). |
| 730 | | x_print_dot_graph_node_style(_, Shape, 'white',filled) :- |
| 731 | | get_preference(dot_expression_node_shape,Shape). |
| 732 | | |
| 733 | | |
| 734 | | boolean_shape(Shape) :- get_preference(dot_predicate_node_shape,Shape). % ellipse, oval, record TO DO: other form for quantifiers |
| 735 | | |
| 736 | | % if we use a Dot record, we can use | to separate fields |
| 737 | | get_predicate_field_seperator('|') :- get_preference(dot_predicate_node_shape,record). |
| 738 | | get_predicate_field_seperator('\\n'). |
| 739 | | get_expression_field_seperator('|') :- get_preference(dot_expression_node_shape,record). |
| 740 | | get_expression_field_seperator('\\n'). |
| 741 | | |
| 742 | | |
| 743 | | |
| 744 | | %% |
| 745 | | % Hierarchical Visitor Pattern for "trees" |
| 746 | | % used to be in gtree module |
| 747 | | % |
| 748 | | % For this implementation a tree is a (root) node and a functor, which |
| 749 | | % maps a node to it's child nodes. For example a Prolog term can be |
| 750 | | % understand as a tree by the functor: |
| 751 | | % children_fkt(Term, Subterms):- Term=..[_|Subterms]. |
| 752 | | % |
| 753 | | % Important: Do not use trees with cycles. This implementation will not |
| 754 | | % detect them and will not terminate. |
| 755 | | % |
| 756 | | % The indented calling is: |
| 757 | | % visit_tree(+VisitorFkt5, +VisitorFkt3, +Node, +EnvIn, -EnvOut) |
| 758 | | % |
| 759 | | % If no functor is specified, the former mentioned one is used. |
| 760 | | % EnvIn and EnvOut are Variables for intermediate values or states, |
| 761 | | % which you might need to maintain between calls to VisitorFkt. You |
| 762 | | % might omit them, if you do not need them. |
| 763 | | % |
| 764 | | % During the visiting process the VisitorFkt functor is called for each |
| 765 | | % node starting with the "root". Calls are made in following order: |
| 766 | | % - VisitorFkt(Node, EnvIn, EnvOut), if Node is a leaf, |
| 767 | | % i.e. ChildrenFkt(Node, []). |
| 768 | | % - VisitorFkt(enter, Node, Children, EnvIn, EnvOut), before branching, |
| 769 | | % - VisitorFkt(leave, Node, Children, EnvIn, EnvOut), after branching |
| 770 | | % to Node's child nodes. |
| 771 | | % !- Only if VisitorFkt(enter, ...) succeeds, child nodes will be |
| 772 | | % visited and VisitorFkt(leave, ...) will be called. |
| 773 | | % |
| 774 | | |
| 775 | | :- use_module(library(lists), [scanlist/4, maplist/2]). |
| 776 | | |
| 777 | | %:- meta_predicate visit_tree(5,3,-,-,-). |
| 778 | | |
| 779 | | visit_tree(VisitorFkt5, VisitorFkt3, Node, EnvIn, EnvOut):- |
| 780 | | child_nodes(Node, Children), |
| 781 | | ( Children == [] -> |
| 782 | | call(VisitorFkt3, Node, EnvIn, EnvOut) |
| 783 | | ; |
| 784 | ? | ( call(VisitorFkt5, enter, Node, Children, EnvIn, Env1) -> |
| 785 | | scanlist(visit_tree(VisitorFkt5, VisitorFkt3), Children, Env1, Env2), |
| 786 | | call(VisitorFkt5, leave, Node, Children, Env2, EnvOut) |
| 787 | | ; |
| 788 | | EnvOut = EnvIn |
| 789 | | ) |
| 790 | | ), |
| 791 | | !. |
| 792 | | |
| 793 | | |
| 794 | | |
| 795 | | |