1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2% FILE    : Interpreters/transfinal.pl
    3%
    4%       IndiGolog TRANS & FINAL Implementation (Version 5)
    5%
    6%  AUTHOR : Sebastian Sardina 
    7%           based on the definitions for ConGolog by 
    8%			Giuseppe De Giaccomo, Yves Lesperance, and Hector Levesque
    9%  EMAIL  : ssardina@cs.toronto.edu
   10%  WWW    : www.cs.toronto.edu/~ssardina www.cs.toronto.edu/cogrobo
   11%  TYPE   : system independent code
   12%  TESTED : SWI Prolog 5.0.10 http://www.swi-prolog.org
   13%           ECLIPSE 5.4 http://www.icparc.ic.ac.uk/eclipse/
   14%
   15%    This file contains the definition of TRANS and FINAL for all the 
   16%	constructs in the language
   17%
   18%           For more information on Golog and some of its variants, see:
   19%               http://www.cs.toronto.edu/~cogrobo/
   20%
   21%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   22%
   23%  This file provides:
   24%
   25% -- mfinal(E,H)		 : meta-version of final/2
   26% -- mtrans(E,H,E2,H2)	 : meta-version of trans/4
   27% -- trans(P,H,P2,H2)    : configuration (P,H) can perform a single step
   28%                          to configuration (P2,H2)
   29% -- final(P,H)          : configuration (P,H) is terminating
   30%
   31% -- do(P,H,H')          : Golog Do/3 using search(E)
   32%
   33%  The following special features are also provided:
   34% 
   35% -- A special action `wait' that is always possible. It can be used to state 
   36%         that the program will be waiting for an exogenous action.
   37% -- A special action `abort' that is always possible. It can be used to state 
   38%         that the program should fail.
   39% -- A special action `sim(E)' for each exogenous action E. The action is
   40%         always possible and it is used to assume the occurrence of E
   41% -- A special action `stop_interrupts' that is used to set the fluent
   42%         interrupts_running to false
   43% -- A special fluent `interrupts_running' that is always true unless stopped
   44%
   45%
   46%  The following is required for this file:
   47%
   48% FROM SYSTEM CODE DEPENDING ON WHERE IT IS USED (hookvir.pl or hookrxc.pl)
   49% -- unknown(P,H): TRANS or FINAL for (P,H) is unknown 
   50%                  (some condition is unknown to be true or false)
   51% -- report_message(T, M) : report message M of type T
   52%
   53% FROM TEMPORAL PROJECTOR:
   54% -- eval(+C, +H, -B) 
   55%           B is the truth value of C at history H
   56% -- calc_arg(+A, -A2, +H) 
   57%           calculate the arguments of action A at history H
   58% -- domain(-V, +D)       
   59% -- rdomain(-V, +D)       
   60%           object V is an element of domain D (random)
   61% -- getdomain(+D, -L) 
   62%           L is the list of elements in domain D
   63% -- sensed(+A, ?V, ?H) 
   64%           action A got sensing result V w.r.t. history H
   65% -- inconsistent(H) 
   66%           last action make history H inconsistent, i.e. impossible 
   67% -- assume(F, V, H1, H2) 
   68%           H2 is the history resulting from assuming fluent F
   69%           to have value V at history H1
   70% -- before(+H1, +H2)
   71%           history H1 is a prefix of H2
   72%
   73% FROM DOMAIN SPECIFIC CODE:
   74% -- prim_action(action) : for each primitive action 
   75% -- exog_action(action) : for each exogenous action 
   76% -- poss(action,cond)   : precondition axioms
   77%
   78%  Code for describing the high-level program:
   79% -- proc(name,P)           : for each procedure P 
   80% -- simulator(Id,C,A)      : Under simulator Id, exog action A must happens if C holds
   81%
   82% OTHERS (PROLOG SPECIFIC):
   83% -- false
   84%            equivalent to fail
   85% -- random(+L,+U,-R) 
   86%            randomly returns a number R between L and U
   87% -- subv(+X1,+X2,+T1,-T2) 
   88%            T2 is T1 with X1 replaced by X2
   89% -- catch/3 and throw/1 for handling exceptions 
   90%            (provide empty implementations of both if there is no support 
   91%            for exceptions available)
   92% -- shuffle/2 : shuffle a list into another list in a random way
   93%
   94% -- call_with_time_limit(+Sec, +Goal): True if Goal completes within Time. 
   95%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   96
   97
   98%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   99% mfinal/2 and mtrans/4: meta-versions of final/2 and trans/4
  100%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  101mfinal(E,H) :- final(E,H).
  102mtrans(E,H,E2,H2) :-
  103	trans(E,H,E3,H3),
  104	(H3 = [atomic(EA)|H2] ->
  105		append(EA,E3,E2)
  106	;
  107		E2=E3,
  108		H2=H3
  109	).
  110
  111
  112%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  113%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  114%%                            TRANS and FINAL                           
  115%% Trans(E,H,E1,H1) ->  One execution step of program E from history H  
  116%%			 leads to program E1 with history H1.           
  117%% Final(E,H)       ->  Program E at history H is final.                
  118%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  119%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  120
  121:- multifile(trans/4),
  122   multifile(final/2).  123
  124:- ensure_loaded('transfinal-ext').  % Load extended constructs
  125:- ensure_loaded('transfinal-search').  % Load search constructs (IndiGolog)
  126:- ensure_loaded('transfinal-bdi').  % Load BDI extensions (Yves Lesperance)
  127:- ensure_loaded('transfinal-congolog').  % Load basic ConGolog language (must be last)
  128
  129
  130
  131
  132%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  133%% isTrue(P,H) : interface with the projector used. Is P true at H?
  134%%
  135%% Currently hooked to eval/3, which should be provided by the projector
  136%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  137
  138% SPECIAL PROJECTOR CASES FOR SYSTEM-WIDE FLUENTS
  139isTrue(interrupts_running,H)      :- !, \+ (H=[stop_interrupts|_]).
  140isTrue(neg(interrupts_running),H) :- !, \+ isTrue(interrupts_running,H).
  141%isTrue(last(A),S) 	:- !, S=[A|_]. % true if the last executed action was A
  142isTrue(haveExecuted(A),S) 	:- !, member(A,S). % true if the A has been executed
  143isTrue(neg(haveExecuted(A)),S)	:- !, \+ isTrue(haveExecuted(A),S).
  144
  145% GENERAL PROJECTOR
  146isTrue(C,H):- eval(C,H,true).
  147
  148%isTrue(C,H):- eval(C,H,B),          % Base case, use the temporal projector
  149%	      (B=true    -> true ;
  150%	       B=false   -> fail ; 
  151%              B=unknown -> unknown(C,H)).
  152
  153
  154
  155%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  156%% OTHER TOOLS
  157%%
  158%% do(E,H,H3) : Golog and ConGolog Do/3 macro 
  159%% ttrans/4: transitive clousure of trans/4
  160%% ttransn/5: n steps of trans/4
  161%% tfinal/2: transitive clousure of trans/4 and final/2 combined
  162%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  163% Added for KR course....
  164do(E,H,H3) :- 
  165	trans(search(E),H,E2,H2), 
  166	ttrans(E2,H2,E3,H3),
  167	final(E3,H3).
  168	
  169% Transitive clousure of trans/4
  170transstar(E,H,E1,H1) :- ttrans(E,H,E1,H1).
  171ttrans(E,H,E,H).
  172ttrans(E,H,E1,H1) :- 
  173	trans(E,H,E2,H2), 
  174	(var(H1) -> 
  175		true 			% always succ if var(H1) 
  176	; 
  177		once(before(H2, H1))	% If H1 is given, H2 is a subhistory of H1
  178	), 				% Avoid infinite ttrans steps
  179    ttrans(E2,H2,E1,H1).
  180
  181% transitive version of trans/4 and final/2 combined
  182tfinal(E,H) :- final(E,H).
  183tfinal(E,H) :- ttrans(E,H,E2,H), E2\=E, tfinal(E2,H).
  184
  185% transn/5 performs a defined number N of consequitives trans steps
  186transn(E,H,E,H,0) :- !.
  187transn(E,H,E1,H1,N) :- 
  188	N2 is N-1,
  189	transn(E,H,E2,H2,N2),
  190	trans(E2,H2,E1,H1).
  191
  192
  193% Stores a node/4 entry in DB with Id and program E and history H
  194store_node(Id, E, H) :-
  195	(retract(counter(N)) -> N2 is N+1 ; N2=1),
  196	assert(node(Id,N2,E,H)),
  197	assert(counter(N2)).
  198
  199% Evolve (E,H) as much as possible until (E2,H2)
  200tttrans(E,H,E2,H2) :- ttrans(E,H,E2,H2), \+ trans(E2,H2,_,_).
  201
  202
  203
  204%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  205% EOF: Interpreters/transfinal.pl
  206%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%