1:- lib(fd).    2:- lib(chr).    3:- chr2pl(fluent_ecl),  [fluent_ecl].    4:- local plus/3.
    5
    6holds(F, [F|_]).
    7holds(F, Z) :- nonvar(Z), Z=[F1|Z1], \+ F==F1, holds(F, Z1).
    8
    9holds(F, [F|Z], Z).
   10holds(F, Z, [F1|Zp]) :- nonvar(Z), Z=[F1|Z1], \+ F==F1, holds(F, Z1, Zp).
   11
   12minus(Z, [], Z).
   13minus(Z, [F|Fs], Zp) :-
   14   ( \+ not_holds(F, Z) -> holds(F, Z, Z1) ;
   15     \+ holds(F, Z)     -> Z1 = Z
   16                         ; cancel(F, Z, Z1), not_holds(F, Z1) ),
   17   minus(Z1, Fs, Zp).
   18
   19plus(Z, [], Z).
   20plus(Z, [F|Fs], Zp) :-
   21   ( \+ holds(F, Z)     -> Z1=[F|Z] ;
   22     \+ not_holds(F, Z) -> Z1=Z
   23                         ; cancel(F, Z, Z2), not_holds(F, Z2), Z1=[F|Z2] ),
   24   plus(Z1, Fs, Zp).
   25
   26update(Z1, ThetaP, ThetaN, Z2) :-
   27   minus(Z1, ThetaN, Z), plus(Z, ThetaP, Z2).
   28
   29knows(F, Z) :- \+ not_holds(F, Z).
   30
   31knows_not(F, Z) :- \+ holds(F, Z).
   32
   33knows_val(X, F, Z) :- holds(F, Z), \+ nonground(X).
   34
   35execute(E, Z1, Z2) :-
   36   E = [] -> Z2 = Z1
   37   ;
   38   E = [A|P] -> execute(P, Z1, Z), execute(A, Z, Z2)
   39   ;
   40   elementary_action(E) -> perform(E, SV), state_update(Z1, E, Z2, SV)
   41   ;
   42   execute_compound_action(E, Z1, Z2).
   43
   44:- op(950, xfy, #).   45:- dynamic(plan_search_best/2).   46
   47plan(Proc, Plan, Z0) :-
   48   write('Planning ...'), nl,
   49   assert(plan_search_best(void,0)),
   50   plan_search(Proc, Z0),
   51   plan_search_best(Plan,_),
   52   retract(plan_search_best(Plan,_)),
   53   Plan \= void.
   54
   55plan_search(Proc, Z0) :-
   56   do(Proc, [], Plan, Z0),
   57   plan_cost(Proc, Plan, Cost),
   58   plan_search_best(BestPlan,BestCost),
   59   ( BestPlan \= void -> Cost < BestCost
   60                       ; true ),
   61   retract(plan_search_best(BestPlan,BestCost)),
   62   assert(plan_search_best(Plan,Cost)),
   63   fail
   64   ;
   65   true.
   66
   67do(E, S0, S, Z0) :-
   68   E = [] -> S=S0
   69   ;
   70   E = [E1|L] -> do(E1, S0, S1, Z0),
   71                 do(L, S1, S, Z0)
   72   ;
   73   E = (E1#E2) -> ( do(E1, S0, S, Z0) ; do(E2, S0, S, Z0) )
   74   ;
   75   plan_proc(E, E1) -> do(E1, S0, S, Z0)
   76   ;
   77   E = ?(P) -> P =.. [Pred|Args],
   78               append(Args, [S0,Z0], ExtArgs),
   79               P1 =.. [Pred|ExtArgs],
   80               call(P1),
   81	       S = S0
   82   ;
   83   elementary_action(E) -> S = [E|S0]
   84   ;
   85   compound_action(E) -> S = [E|S0].
   86
   87res([], Z, Z).
   88res([A|S], Z0, Z) :-
   89   res(S, Z0, Z1),
   90   state_update(Z1, A, Z, _).
   91
   92knows(F, S, Z0) :- \+ ( res(S, Z0, Z), not_holds(F,Z) ).
   93
   94knows_not(F, S, Z0) :- \+ ( res(S, Z0, Z), holds(F,Z) ).
   95
   96:- dynamic(knowledge_value_sit/1).   97
   98knows_val(X, F, S, Z0) :-
   99   res(S, Z0, Z) ->
  100     knows_val(X, F, Z),
  101     assert(knowledge_value_sit(X)),
  102     fail.
  103knows_val(X, F, S, Z0) :-
  104   knowledge_value_sit(X),
  105   retract(knowledge_value_sit(X)),
  106   \+ ( res(S, Z0, Z), not_holds(F, Z) )