1% BEGIN LICENSE BLOCK 2% Version: CMPL 1.1 3% 4% The contents of this file are subject to the Cisco-style Mozilla Public 5% License Version 1.1 (the "License"); you may not use this file except 6% in compliance with the License. You may obtain a copy of the License 7% at www.eclipse-clp.org/license. 8% 9% Software distributed under the License is distributed on an "AS IS" 10% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 11% the License for the specific language governing rights and limitations 12% under the License. 13% 14% The Original Code is The ECLiPSe Constraint Logic Programming System. 15% The Initial Developer of the Original Code is Cisco Systems, Inc. 16% Portions created by the Initial Developer are 17% Copyright (C) 2006 Cisco Systems, Inc. All Rights Reserved. 18% 19% Contributor(s): Joachim Schimpf. 20% 21% END LICENSE BLOCK 22% ---------------------------------------------------------------------- 23% System: ECLiPSe Constraint Logic Programming System 24% Component: ECLiPSe III compiler 25% Version: $Id: compiler_analysis.ecl,v 1.9 2010/03/12 10:22:46 jschimpf Exp $ 26%---------------------------------------------------------------------- 27 28:- module(compiler_analysis). 29 30:- comment(summary, "ECLiPSe III compiler - dataflow analysis"). 31:- comment(copyright, "Cisco Technology Inc"). 32:- comment(author, "Joachim Schimpf"). 33:- comment(date, "$Date: 2010/03/12 10:22:46 $"). 34 35:- use_module(compiler_common). 36:- use_module(compiler_map). 37 38:- local op(200, fx, [--,++,?]). 39 40%---------------------------------------------------------------------- 41 42:- comment(binding_analysis/1, [ 43 summary:"Analyse data flow in one predicate and annotate accordingly", 44 amode:binding_analysis(+), 45 args:[ 46 "Body":"Normalised source of the predicate" 47 ], 48 see_also:[print_goal_state/3], 49 desc:ascii(" 50 This takes the normalised source of a predicate and analyses its 51 determinism and dataflow. The result of the analysis is stored in 52 the normalised source data structure itself (the state-fields of 53 every subgoal's struct(goal)). 54 55 We do conservative analysis, we can only record information that 56 cannot change during subsequent (forward) execution, like 57 aliasing and instantiation. 58 We do not track uninstantiatedness, for example. This could change 59 due to wakeups, for example. (we could do uninitialisedness, though) 60 ") 61]). 62 63:- export binding_analysis/1. 64 65 66binding_analysis(Body) :- 67 initial_state(StartingState), 68 binding_analysis(Body, StartingState, _EndState). 69 70 initial_state(state{determinism:det,bindings:Map0}) :- 71 compiler_map:init(Map0). 72 73 74% binding_analysis(+Goals, +State, -State) 75% Traverse the goals and collect binding information 76 77binding_analysis([], State, State). 78binding_analysis([Goal|Goals], State0, State) :- 79 binding_analysis(Goal, State0, State1), 80 binding_analysis(Goals, State1, State). 81binding_analysis(disjunction{branches:Branches,state:State0}, State0, State) :- 82 ( 83 foreach(Branch,Branches), 84 foreach(EndState,EndStates), 85 param(State0) 86 do 87 binding_analysis(Branch, State0, EndState) 88 ), 89 merge_alternative_states(State0, EndStates, State). 90binding_analysis(goal{kind:head,functor:Pred,args:Args,state:State,definition_module:Mod}, State0, State) :- !, 91 ( get_flag(Pred, mode, Modes)@Mod -> 92 ( 93 foreacharg(Mode,Modes), 94 foreach(Arg,Args), 95 fromto(State0,State1,State2,State) 96 do 97 use_mode(Mode, Arg, State1, State2) 98 ) 99 ; 100 mark_args_as(?univ, Args, State0, State) 101 ). 102binding_analysis(goal{functor:F/A,args:Args,state:State0,path:File,line:Line,callpos:Pos}, State0, State) :- 103 ( goal_effect(F, A, Args, Pos, State0, State) -> 104 true 105 ; 106 update_struct(state, [determinism:failure], State0, State), 107 ( expected_failure(F, A) -> 108 true 109 ; 110 ( File == '' -> true ; 111 local_file_name(File, LocalFile), 112 printf(warning_output, "File %w, line %d:%n ", [LocalFile,Line]) 113 ), 114 printf(warning_output, "WARNING: calling %Kw will always fail%n", [F/A]) 115 ) 116 ). 117 118 119% Analyse the effect of an individual goal 120% Fail if the goal would certainly fail at runtime 121 122goal_effect((=), 2, [A1,A2], _, State0, State) :- !, 123 unify_effect(A1, A2, State0, State). 124goal_effect(atom, 1, [A1], _, State0, State) :- !, 125 constrain_type(A1, ++atom, State0, State). 126goal_effect(atomic, 1, [A1], _, State0, State) :- !, 127 constrain_type(A1, ++atomic, State0, State). 128goal_effect(breal, 1, [A1], _, State0, State) :- !, 129 constrain_type(A1, ++breal, State0, State). 130goal_effect(compound, 1, [A1], _, State0, State) :- !, 131 constrain_type(A1, +compound, State0, State). 132goal_effect(float, 1, [A1], _, State0, State) :- !, 133 constrain_type(A1, ++float, State0, State). 134goal_effect(free, 1, [A1], _, State0, State) :- !, 135 constrain_type(A1, ?univ, State0, State). 136goal_effect(get_cut, 1, [A1], Pos, State0, State) :- !, 137 constrain_type(A1, ++cutpoint(Pos), State0, State). 138goal_effect(ground, 1, [A1], _, State0, State) :- !, 139 constrain_type(A1, ++univ, State0, State). 140goal_effect(integer, 1, [A1], _, State0, State) :- !, 141 constrain_type(A1, ++integer, State0, State). 142goal_effect(is_handle, 1, [A1], _, State0, State) :- !, 143 constrain_type(A1, ++handle, State0, State). 144goal_effect(meta, 1, [A1], _, State0, State) :- !, 145 constrain_type(A1, ?univ, State0, State). 146goal_effect(nonvar, 1, [A1], _, State0, State) :- !, 147 constrain_type(A1, +univ, State0, State). 148goal_effect(number, 1, [A1], _, State0, State) :- !, 149 constrain_type(A1, ++number, State0, State). 150goal_effect(rational, 1, [A1], _, State0, State) :- !, 151 constrain_type(A1, ++rational, State0, State). 152goal_effect(real, 1, [A1], _, State0, State) :- !, 153 constrain_type(A1, ++number, State0, State). 154goal_effect(string, 1, [A1], _, State0, State) :- !, 155 constrain_type(A1, ++string, State0, State). 156goal_effect(var, 1, [A1], _, State0, State) :- !, 157 constrain_type(A1, ?univ, State0, State). 158goal_effect(_, _, Args, _, State0, State) :- 159 mark_args_as(?univ, Args, State0, State). 160 161expected_failure(fail, 0). 162expected_failure(false, 0). 163 164mark_args_as(_, [], State, State). 165mark_args_as(Domain, [Arg|Args], State0, State) :- 166 mark_arg_as(Domain, Arg, State0, State1), 167 mark_args_as(Domain, Args, State1, State). 168 169 mark_arg_as(Domain, variable{varid:VarId}, State0, State) :- !, 170 enter_binding(VarId, Domain, State0, State). 171 mark_arg_as(Domain, [Arg1|Arg2], State0, State) :- !, 172 mark_arg_as(Domain, Arg1, State0, State1), 173 mark_arg_as(Domain, Arg2, State1, State). 174 mark_arg_as(Domain, structure{args:Args}, State0, State) :- !, 175 mark_args_as(Domain, Args, State0, State). 176 mark_arg_as(_, _, State, State). 177 178 179%use_mode(--, _Arg, State, State). % i.e. mark_arg_as(--univ,...) 180%use_mode(-, Arg, State0, State) :- 181% mark_arg_as(-univ, Arg, State0, State). 182use_mode(-, _Arg, State, State). % i.e. mark_arg_as(--univ,...) 183use_mode(?, Arg, State0, State) :- 184 mark_arg_as(?univ, Arg, State0, State). 185use_mode(+, Arg, State0, State) :- 186 mark_arg_as(+univ, Arg, State0, State). 187use_mode(++, Arg, State0, State) :- 188 mark_arg_as(++univ, Arg, State0, State). 189 190 191/* 192Further candidates for exploiting type information: 193 194functor(_, value(N), value(A)) 195functor(N/A, _, _) 196 -> functor(N/A, value(N), value(A)) 197 198functor(_, _, _) 199 -> functor(univ, atom, integer) 200 201_ =.. _ 202 -> univ =.. ./2 203 204N/A =.. [_|_] 205 N/A =.. [value(N)|_] 206 207+(integer, integer, _) 208 -> +(integer, integer, integer) 209 210*/ 211 212% constrain_type(+Term, +Type, +State0, -State) 213 214constrain_type(variable{varid:VarId}, Domain, State0, State) :- !, 215 enter_binding(VarId, Domain, State0, State). 216constrain_type(X, Domain, State, State) :- 217 term_abstract(X, State, XDomain), 218 abstract_unify(XDomain, Domain, _). % may fail 219 220 221%---------------------------------------------------------------------- 222% Compute the effect of the unification. 223% Fails if unification will surely fail at runtime. 224%---------------------------------------------------------------------- 225 226unify_effect(variable{varid:VarId1}, variable{varid:VarId2}, State0, State) :- !, 227 alias_effect(VarId1, VarId2, State0, State). 228unify_effect(variable{varid:VarId}, NonVar, State0, State) :- !, 229 binding_effect(VarId, NonVar, State0, State). 230unify_effect(NonVar, variable{varid:VarId}, State0, State) :- !, 231 binding_effect(VarId, NonVar, State0, State). 232unify_effect(_, _, _State0, _State) :- 233 unreachable("unify_effect/4: unexpected unnormalised unification"). 234%unify_effect([Arg1|Args1], [Arg2|Args2], State0, State) :- 235% unify_effect(Arg1, Arg2, State1, State2), 236% unify_effect(Args1, Args2, State1, State2). 237%unify_effect(structure{name:N,arity:A,args:Args1}, 238% structure{name:N,arity:A,args:Args2}, State0, State) :- 239% unify_effect(Args1, Args2, State0, State). 240 241 242% binding_effect(+VarId, +NonVar, +State, -State) 243 244binding_effect(VarId, structure{name:F,arity:A,args:Args}, State0, State) :- !, 245 % TODO: propagate groundness to Args if VarId is ground 246 enter_binding(VarId, +(F/A), State0, State1), 247 mark_args_as(?univ, Args, State1, State). 248binding_effect(VarId, [Arg1|Arg2], State0, State) :- !, 249 enter_binding(VarId, +((.)/2), State0, State1), 250 mark_arg_as(?univ, Arg1, State1, State2), 251 mark_arg_as(?univ, Arg2, State2, State). 252binding_effect(VarId, Constant, State0, State) :- !, 253 enter_binding(VarId, ++value(Constant), State0, State). 254 255 enter_binding(VarId, NewBinding, State0, State) :- 256 State0 = state{bindings:Map0}, 257 update_struct(state, [bindings:Map1], State0, State), 258 ( lookup_binding(Map0, VarId, OldBinding, AliasVarId) -> 259 abstract_unify(OldBinding, NewBinding, Binding), % may fail 260 compiler_map:det_update(Map0, AliasVarId, Binding, Map1) 261 ; 262 compiler_map:det_insert(Map0, VarId, NewBinding, Map1) 263 ). 264 265% lookup with dereferencing kown aliases 266lookup_binding(Map, VarId, Binding) :- 267 lookup_binding(Map, VarId, Binding, _AliasVarId). 268 269lookup_binding(Map, VarId, Binding, AliasVarId) :- 270 compiler_map:search(Map, VarId, Binding1), % may fail 271 ( Binding1 = alias(NextVarId) -> 272 lookup_binding(Map, NextVarId, Binding, AliasVarId) 273 ; 274 AliasVarId = VarId, 275 Binding = Binding1 276 ). 277 278 279% alias_effect(+VarId1, +VarId2, +State, -State) 280 281alias_effect(VarId, VarId, State0, State) ?- 282 State = State0. 283alias_effect(VarId1, VarId2, State0, State) :- 284 State0 = state{bindings:Map0}, 285 update_struct(state, [bindings:Map1], State0, State), 286 enter_alias(VarId1, VarId2, Map0, Map1). 287 288 enter_alias(VarId1, VarId2, Map0, Map) :- 289 ( lookup_binding(Map0, VarId1, Binding1, AliasVarId1) -> 290 ( lookup_binding(Map0, VarId2, Binding2, AliasVarId2) -> 291 ( abstract_unify(Binding1, Binding2, Binding) -> 292 true 293 ; 294% printf(warning_output, 295% "WARNING: unification of %w with %w will always fail%n", 296% [Binding1, Binding2]), 297 fail 298 ), 299 compiler_map:det_update(Map0, AliasVarId1, alias(AliasVarId2), Map1), 300 compiler_map:det_update(Map1, AliasVarId2, Binding, Map) 301 ; 302 compiler_map:det_insert(Map0, VarId2, alias(AliasVarId1), Map1), 303 ( abstract_alias(Binding1, Binding) -> 304 compiler_map:det_update(Map1, AliasVarId1, Binding, Map) 305 ; 306 Map = Map1 307 ) 308 ) 309 ; lookup_binding(Map0, VarId2, Binding2, AliasVarId2) -> 310 compiler_map:det_insert(Map0, VarId1, alias(AliasVarId2), Map1), 311 ( abstract_alias(Binding2, Binding) -> 312 compiler_map:det_update(Map1, AliasVarId2, Binding, Map) 313 ; 314 Map = Map1 315 ) 316 ; 317 compiler_map:det_insert(Map0, VarId1, alias(VarId2), Map1), 318 compiler_map:det_insert(Map1, VarId2, ?univ, Map) 319 ). 320 321 322 323%---------------------------------------------------------------------- 324% Primitive operations on the representation of variable bindings 325% 326% The type tree: 327% 328% univ 329% +---------------------------------------------------------------+ 330% atomic compound 331% +-------------------------------+-------+-------+-------+ | 332% number string atom handle cutpoint N/A 333% +-------+-------+--------+ | | 334% integer float rational breal value() value() 335% | | | | 336% value() value() value() value() 337% 338% 339% Instantiations: 340% 341% ? any 342% / \ 343% nonvar + - var (possibly aliased) 344% | | 345% ground ++ -- uninit 346% 347% No binding information is equivalent to --univ (uninitialised). 348% 349% Currently, '--' only occurs together with univ. 350% 351% We do not track '-' currently, because a variable 352% 1. may be instantiated as a side effect of instantiating another 353% variable to which it is aliased. 354% 2. may be instantiated as a side effect of waking a delayed goal in 355% which it (or a variable to which it may be aliased) appears. 356% Only '--' variables do neither suffer nor cause these effects. 357% Note that we traditionally treat mode(-) as meaning '--', because 358% otherwise it's not much use. 359 360% Get the abstract representation of a (variable or nonvariable) term 361:- mode term_abstract(+,+,-). 362term_abstract(variable{varid:VarId}, State, Domain) :- 363 State = state{bindings:Map}, 364 ( lookup_binding(Map, VarId, Domain) -> 365 true 366 ; 367 Domain = --univ 368 ). 369term_abstract(structure{name:N,arity:A}, _State, +(N/A)). % TODO: groundness 370term_abstract([_|_], _State, +((.)/2)). 371term_abstract(X, _State, ++(value(X))) :- atomic(X). 372 373 374abstract_union(D1, D2, D) :- 375 functor(D1, I1, 1), arg(1, D1, T1), 376 functor(D2, I2, 1), arg(1, D2, T2), 377 inst_union(I1, I2, I), 378 type_union(T1, T2, T), 379 functor(D, I, 1), arg(1, D, T). 380 381 382abstract_unify(D1, D2, D) :- 383 functor(D1, I1, 1), arg(1, D1, T1), 384 functor(D2, I2, 1), arg(1, D2, T2), 385 inst_unify(I1, I2, I), 386 type_unify(T1, T2, T), 387 functor(D, I, 1), arg(1, D, T). 388 389 390% The effect of unifying something with --univ. If no effect, fail. 391% Same as abstract_unify(T1,--univ,T), T1\==T 392%abstract_alias(--T, -T). 393abstract_alias(--T, ?T). 394 395 396% supertype(++Type, -Level, -SuperType) 397 398supertype(value(X), 8, integer) :- integer(X), !. 399supertype(value(X), 8, float) :- float(X), !. 400supertype(value(X), 8, rational) :- rational(X), !. 401supertype(value(X), 8, breal) :- breal(X), !. 402supertype(value(X), 7, atom) :- atom(X), !. 403supertype(value(X), 7, string) :- string(X), !. 404supertype(integer, 7, number). 405supertype(float, 7, number). 406supertype(rational, 7, number). 407supertype(breal, 7, number). 408supertype(_/_, 6, compound). 409supertype(number, 6, atomic). 410supertype(handle, 6, atomic). 411supertype(cutpoint(_), 6, atomic). 412supertype(string, 6, atomic). 413supertype(atom, 6, atomic). 414supertype(compound, 5, univ). 415supertype(atomic, 5, univ). 416supertype(univ, 1, top). 417 418 419type_union(T1, T2, T) :- 420 supertype(T1, L1, P1), 421 supertype(T2, L2, P2), 422 ( L1 < L2 -> 423 type_union(T1, P2, T) 424 ; L1 > L2 -> 425 type_union(P1, T2, T) 426 ; T1 == T2 -> 427 T = T1 428 ; 429 type_union(P1, P2, T) 430 ). 431 432 433type_unify(T1, T2, T) :- 434 supertype(T1, L1, P1), 435 supertype(T2, L2, P2), 436 ( L1 < L2 -> 437 upto(L1, P2, T1), 438 T = T2 439 ; L1 > L2 -> 440 upto(L2, P1, T2), 441 T = T1 442 ; 443 T1 == T2, 444 T=T1 445 ). 446 447 upto(L, T, A) :- 448 supertype(T, LT, P), 449 ( L < LT -> 450 upto(L, P, A) 451 ; 452 A = T 453 ). 454 455 456inst_unify(Inst1, Inst2, Inst) :- 457 N is max(inst_order(Inst1), inst_order(Inst2)), 458 once inst_order(Inst, N). 459 460 inst_order( -, 1). % this clause first! 461 inst_order(--, 1). % -- = -- gives - 462 inst_order( ?, 2). 463 inst_order( +, 3). 464 inst_order(++, 4). 465 466 467inst_union(--, Y, LUB) :- 'lub--'(Y, LUB). 468inst_union( -, Y, LUB) :- 'lub-'(Y, LUB). 469inst_union( ?, _, ?). 470inst_union( +, Y, LUB) :- 'lub+'(Y, LUB). 471inst_union(++, Y, LUB) :- 'lub++'(Y, LUB). 472 473 'lub--'(--, LUB) :- !, LUB = (--). 474 'lub--'( -, LUB) :- !, LUB = (-). 475 'lub--'( _, ?). 476 'lub-'(--, LUB) :- !, LUB = (-). 477 'lub-'( -, LUB) :- !, LUB = (-). 478 'lub-'( _, ?). 479 'lub+'(++, LUB) :- !, LUB = (+). 480 'lub+'( +, LUB) :- !, LUB = (+). 481 'lub+'( _, ?). 482 'lub++'(++, LUB) :- !, LUB = (++). 483 'lub++'( +, LUB) :- !, LUB = (+). 484 'lub++'( _, ?). 485 486 487%---------------------------------------------------------------------- 488% Merging the final analysis states of disjunctions: 489% Only if something nontrivial has been derived about a variable 490% in _every_ disjunctive branch, we can merge this information and 491% proceed with it. 492% Aliasing: with the current alias-chain representation it is difficult 493% to extract the information common to alternative branches (we would 494% have to intersect sets of aliased variables). For the time being, 495% we simply lose any aliasing information collected within the branches. 496%---------------------------------------------------------------------- 497 498merge_alternative_states(State, [], State). 499merge_alternative_states(State0, EndStates, State) :- 500 State0 = state{bindings:Map0}, 501 EndStates = [state{bindings:FirstEndMap}|_], 502 compiler_map:keys(FirstEndMap, VarIds), 503 ( 504 foreach(VarId, VarIds), 505 fromto(State0, State1, State2, State), 506 param(Map0,EndStates) 507 do 508 % get what was known about this variable before the disjunction 509 ( lookup_binding(Map0, VarId, InitialBinding, AliasVarId) -> 510 true 511 ; 512 InitialBinding = --univ, AliasVarId = VarId 513 ), 514 % if all branches derived something, then merge and use it 515 ( 516 merge_end_bindings(InitialBinding, VarId, EndStates, EndBinding), 517 enter_binding(AliasVarId, EndBinding, State1, State2) 518 -> 519 true 520 ; 521 State2 = State1 522 ) 523 ). 524 525 % Merge the binding information from all the disjunctive branches. 526 % There are several occasions where we stop early and fail: 527 % When a branch has no information, or when the merged information 528 % is the same as the initial one before the disjunction. 529 530 merge_end_bindings(InitialBinding, VarId, EndStates, EndBinding) :- 531 EndStates = [state{bindings:Map0}|MoreEndStates], 532 certainly_once lookup_binding(Map0, VarId, FirstEndBinding), 533 FirstEndBinding \= InitialBinding, % may fail 534 ( 535 foreach(state{bindings:MapI}, MoreEndStates), 536 fromto(FirstEndBinding,MergedBinding1,MergedBinding2,EndBinding), 537 param(InitialBinding,VarId) 538 do 539 lookup_binding(MapI, VarId, EndBindingI), % may fail 540 abstract_union(MergedBinding1, EndBindingI, MergedBinding2), 541 MergedBinding2 \= InitialBinding % may fail 542 ). 543 544 545%---------------------------------------------------------------------- 546% Print the analysis result 547%---------------------------------------------------------------------- 548 549:- export print_goal_state/3. 550 551print_goal_state(_Stream, _Indent, State) :- 552 var(State), !. % no analysis results yet 553print_goal_state(Stream, Indent0, state{determinism:Det,bindings:Map}) :- 554 Indent is Indent0+1, 555 indent(Stream, Indent), 556 printf("DETERMINISM: %w%n", [Det]), 557 compiler_map:to_sorted_assoc_list(Map, Bindings), 558 ( Bindings = [_|_] -> 559 indent(Stream, Indent), 560 printf("BINDING INFO:%n", []), 561 ( foreach(Binding,Bindings), param(Stream,Indent,Map) do 562 indent(Stream, Indent), 563 ( Binding = VarId - alias(_Alias) -> 564 lookup_binding(Map, VarId, FinalBinding), 565 writeln(Binding -> FinalBinding) 566 ; 567 writeln(Binding) 568 ) 569 ) 570 ; 571 true 572 ). 573 574 575:- export state_lookup_binding/3. 576state_lookup_binding(state{bindings:Map}, VarId, Binding) :- 577 lookup_binding(Map, VarId, Binding). 578